objective categorical abstract machine language personal data server
Improve docs
+498
-112
+59
-13
README.md
+59
-13
README.md
···
2
2
3
3
is an [atproto PDS](https://atproto.com/guides/glossary#pds-personal-data-server), along with an assortment of atproto-relevant libraries, written in OCaml.
4
4
5
+
## table of contents
6
+
7
+
- [Running It](#running-it)
8
+
- [Environment](#environment)
9
+
- [SMTP](#smtp)
10
+
- [S3](#s3)
11
+
- [Development](#development)
12
+
- [Libraries](#libraries)
13
+
- [ipld](#ipld) - IPLD implementation (CIDs, CAR, DAG-CBOR)
14
+
- [kleidos](#kleidos) - Cryptographic key management
15
+
- [mist](#mist) - Merkle Search Tree implementation
16
+
- [hermes](#hermes) - XRPC client
17
+
- [frontend](#frontend) - Web interface
18
+
- [pegasus](#pegasus-library) - PDS implementation
19
+
5
20
## running it
6
21
7
22
After cloning this repo, start by running
8
23
9
24
```
25
+
docker compose pull
26
+
```
27
+
28
+
to pull the latest image, or
29
+
30
+
```
10
31
docker compose build
11
32
```
33
+
34
+
to build from source.
12
35
13
36
Next, run
14
37
···
50
73
- `PDS_S3_ENDPOINT`, `PDS_S3_REGION`, `PDS_S3_BUCKET`, `PDS_S3_ACCESS_KEY`, `PDS_S3_SECRET_KEY` — S3 configuration.
51
74
- `PDS_S3_CDN_URL` — You may optionally set this to redirect `getBlob` requests to `{PDS_S3_CDN_URL}/blobs/{did}/{cid}`. When unset, blobs will be fetched either from local storage or from S3, depending on `PDS_S3_BLOBS_ENABLED`.
52
75
53
-
## development
76
+
## libraries
54
77
55
-
This repo contains several libraries in addition to the `pegasus` PDS:
78
+
This repo contains several libraries in addition to the `pegasus` PDS. Each library has its own README with detailed documentation.
56
79
57
-
| library | description |
58
-
| ---------- | -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- |
59
-
| frontend | The PDS frontend, containing the admin dashboard and account page. |
60
-
| ipld | A mostly [DASL-compliant](https://dasl.ing/) implementation of [CIDs](https://dasl.ing/cid.html), [CAR](https://dasl.ing/car.html), and [DAG-CBOR](https://dasl.ing/drisl.html). |
61
-
| kleidos | An atproto-valid interface for secp256k1 and secp256r1 key management, signing/verifying, and encoding/decoding. |
62
-
| mist | A [Merkle Search Tree](https://atproto.com/specs/repository#mst-structure) implementation for data repository purposes. |
63
-
| hermes | An XRPC client for atproto. |
64
-
| hermes_ppx | A preprocessor for hermes, making API calls more ergonomic. |
65
-
| hermes-cli | A CLI to generate OCaml types from atproto lexicons. |
66
-
| pegasus | The PDS implementation. |
80
+
### <a id="ipld"></a>[ipld](ipld/README.md)
81
+
82
+
A mostly [DASL-compliant](https://dasl.ing/) implementation of [CIDs](https://dasl.ing/cid.html), [CAR](https://dasl.ing/car.html), and [DAG-CBOR](https://dasl.ing/drisl.html).
83
+
84
+
Provides content addressing primitives for IPLD: Content Identifiers (CIDs), Content Addressable aRchives (CAR), and deterministic CBOR encoding.
85
+
86
+
### <a id="kleidos"></a>[kleidos](kleidos/README.md)
87
+
88
+
An atproto-valid interface for secp256k1 and secp256r1 key management, signing/verifying, and encoding/decoding.
89
+
90
+
Handles cryptographic operations for both K-256 and P-256 elliptic curves with multikey encoding and did:ket generation.
91
+
92
+
### <a id="mist"></a>[mist](mist/README.md)
93
+
94
+
A [Merkle Search Tree](https://atproto.com/specs/repository#mst-structure) implementation for data repository purposes with a swappable storage backend.
95
+
96
+
### <a id="hermes"></a>[hermes](hermes/README.md)
97
+
98
+
An XRPC client for atproto with three components:
99
+
100
+
- **hermes** - Core XRPC client library
101
+
- **hermes_ppx** - PPX extension for ergonomic API calls
102
+
- **hermes-cli** - CLI to generate OCaml types from atproto lexicons
103
+
104
+
### <a id="frontend"></a>[frontend](frontend/README.md)
105
+
106
+
The PDS frontend, containing the admin dashboard and account page.
107
+
108
+
### <a id="pegasus-library"></a>[pegasus](pegasus/README.md)
109
+
110
+
The PDS implementation.
111
+
112
+
## development
67
113
68
114
To start developing, you'll need:
69
115
···
108
154
109
155
to download the formatter and LSP services. You can run `dune fmt` to format the project.
110
156
111
-
The [frontend](frontend) is written in [MLX](https://github.com/ocaml-mlx/mlx), a JSX-ish OCaml dialect. To format it, you'll need to `opam install ocamlformat-mlx`, then `ocamlformat-mlx -i frontend/**/*.mlx`. You'll see a few errors on formatting files containing `[%browser_only]`; I'm waiting on the next release of `mlx` to fix those.
157
+
The [frontend](frontend/) is written in [MLX](https://github.com/ocaml-mlx/mlx), a JSX-ish OCaml dialect. To format it, you'll need to `opam install ocamlformat-mlx`, then `ocamlformat-mlx -i frontend/**/*.mlx`. You'll see a few errors on formatting files containing `[%browser_only]`; I'm waiting on the next release of `mlx` to fix those.
+51
frontend/README.md
+51
frontend/README.md
···
1
+
# frontend
2
+
3
+
is the web interface for pegasus, containing the admin dashboard and account management pages.
4
+
5
+
Built with [MLX](https://github.com/ocaml-mlx/mlx) (a JSX-like OCaml dialect), [server-reason-react](https://github.com/ml-in-barcelona/server-reason-react) (React SSR in OCaml) and [melange](https://melange.re) (OCaml to JavaScript compiler).
6
+
7
+
## pages
8
+
9
+
### admin
10
+
11
+
- **Login** (`/admin`) - Admin authentication
12
+
- **Users** (`/admin/users`) - View and manage PDS users
13
+
- **Invites** (`/admin/invites`) - Create and manage invite codes
14
+
- **Blobs** (`/admin/blobs`) - Monitor blob storage usage
15
+
16
+
### account
17
+
18
+
- **Account page** (`/account`) - User profile and email settings
19
+
- **Identity** (`/account/identity`) - Handle and DID management
20
+
- **Permissions** (`/account/permissions`) - OAuth app permissions and sessions
21
+
- **Login** (`/login`) - User authentication
22
+
- **Signup** (`/signup`) - New account creation
23
+
24
+
### oauth
25
+
26
+
- **Authorize** (`/oauth/authorize`) - OAuth authorization flow
27
+
28
+
## development
29
+
30
+
The frontend is built as part of the main pegasus project. When developing:
31
+
32
+
```bash
33
+
# Build the frontend
34
+
dune build
35
+
36
+
# The compiled JavaScript will be in _build/default/public/
37
+
```
38
+
39
+
### formatting
40
+
41
+
The frontend uses MLX syntax, which can't be formatted using ocamlformat:
42
+
43
+
```bash
44
+
# Install formatter
45
+
opam install ocamlformat-mlx
46
+
47
+
# Format MLX files
48
+
ocamlformat-mlx -i frontend/src/**/*.mlx
49
+
```
50
+
51
+
Note: You may see errors formatting files containing `[%browser_only]`. This is a known issue pending the next MLX release.
+116
ipld/README.md
+116
ipld/README.md
···
1
+
# ipld
2
+
3
+
is a mostly [DASL-compliant](https://dasl.ing/) implementation of [CIDs](https://dasl.ing/cid.html), [CAR](https://dasl.ing/car.html), and [DAG-CBOR](https://dasl.ing/drisl.html) for OCaml.
4
+
5
+
This library implements the core IPLD primitives needed for atproto.
6
+
7
+
## components
8
+
9
+
- **CID** - Content Identifiers (CIDv1) with SHA-256 digests
10
+
- **CAR** - Content Addressable aRchives for storing and transferring IPLD data
11
+
- **DAG-CBOR** - Deterministic CBOR encoding for content-addressed data
12
+
13
+
## installation
14
+
15
+
Add to your `dune-project`:
16
+
17
+
```lisp
18
+
(depends
19
+
ipld)
20
+
```
21
+
22
+
## usage
23
+
24
+
### working with CIDs
25
+
26
+
```ocaml
27
+
open Ipld
28
+
29
+
(* Create a CID from data *)
30
+
let cid = Cid.create Cid.Dcbor data_bytes
31
+
32
+
(* Encode CID to base32 string *)
33
+
let cid_string = Cid.to_string cid
34
+
(* => "bafyreihffx5a2e7k5uwrmmgofbvzujc5cmw5h4espouwuxt3liqoflx3ee" *)
35
+
36
+
(* Decode CID from string *)
37
+
match Cid.of_string cid_string with
38
+
| Ok cid -> (* use cid *)
39
+
| Error msg -> failwith msg
40
+
41
+
(* Convert to/from bytes *)
42
+
let bytes = Cid.to_bytes cid
43
+
match Cid.of_bytes bytes with
44
+
| Ok cid -> (* use cid *)
45
+
| Error msg -> failwith msg
46
+
```
47
+
48
+
### DAG-CBOR encoding
49
+
50
+
```ocaml
51
+
open Dag_cbor
52
+
53
+
(* Create CBOR values *)
54
+
let value = `Map (String_map.of_list [
55
+
("name", `String "Alice");
56
+
("age", `Integer 30L);
57
+
("verified", `Boolean true);
58
+
("profile_cid", `Link some_cid);
59
+
])
60
+
61
+
(* Encode to bytes *)
62
+
let encoded = Dag_cbor.encode value
63
+
64
+
(* Decode from bytes *)
65
+
let decoded = Dag_cbor.decode encoded
66
+
```
67
+
68
+
### CAR files
69
+
70
+
CAR (Content Addressable aRchive) files store multiple IPLD blocks with their CIDs.
71
+
72
+
```ocaml
73
+
open Car
74
+
75
+
(* Write blocks to a CAR file *)
76
+
let blocks = [
77
+
(cid1, data1);
78
+
(cid2, data2);
79
+
(cid3, data3);
80
+
] in
81
+
Car.write ~roots:[root_cid] blocks output_channel
82
+
83
+
(* Read blocks from a CAR file *)
84
+
let (roots, blocks) = Car.read input_channel
85
+
```
86
+
87
+
## types
88
+
89
+
### CID
90
+
91
+
```ocaml
92
+
type Cid.t = {
93
+
version: int; (* Always 1 for CIDv1 *)
94
+
codec: codec; (* Raw or Dcbor *)
95
+
digest: digest; (* SHA-256 hash *)
96
+
bytes: bytes; (* Serialized CID *)
97
+
}
98
+
99
+
type codec = Raw | Dcbor
100
+
```
101
+
102
+
### DAG-CBOR
103
+
104
+
```ocaml
105
+
type Dag_cbor.value =
106
+
| `Null
107
+
| `Boolean of bool
108
+
| `Integer of int64
109
+
| `Float of float
110
+
| `String of string
111
+
| `Bytes of bytes
112
+
| `Array of value array
113
+
| `Map of value String_map.t
114
+
| `Link of Cid.t
115
+
| `Tag of int * value
116
+
```
+77
kleidos/README.md
+77
kleidos/README.md
···
1
+
# kleidos
2
+
3
+
is an atproto-valid interface for secp256k1 and secp256r1 (P-256) key management, signing, verification, and encoding.
4
+
5
+
The library provides a unified interface for working with both elliptic curves used in atproto, with support for multikey encoding and did:key generation.
6
+
7
+
## installation
8
+
9
+
Add to your `dune-project`:
10
+
11
+
```lisp
12
+
(depends
13
+
kleidos)
14
+
```
15
+
16
+
## usage
17
+
18
+
Both K-256 and P-256 share the same interface through the `CURVE` module type.
19
+
20
+
### generating keys
21
+
22
+
```ocaml
23
+
open Kleidos
24
+
25
+
(* Generate a K-256 keypair *)
26
+
let (privkey, pubkey) = K256.generate_keypair ()
27
+
28
+
(* Generate a P-256 keypair *)
29
+
let (privkey, pubkey) = P256.generate_keypair ()
30
+
```
31
+
32
+
### signing and verifying
33
+
34
+
```ocaml
35
+
(* Sign a message *)
36
+
let msg = Bytes.of_string "Hello, atproto!" in
37
+
let signature = K256.sign ~privkey ~msg
38
+
39
+
(* Verify a signature *)
40
+
let is_valid = K256.verify ~pubkey ~msg ~signature
41
+
(* => true *)
42
+
```
43
+
44
+
### key encoding
45
+
46
+
```ocaml
47
+
(* Convert keys to multikey format *)
48
+
let privkey_multikey = K256.privkey_to_multikey privkey
49
+
(* => "z2MkApQ..." *)
50
+
51
+
let pubkey_multikey = K256.pubkey_to_multikey pubkey
52
+
(* => "zQ3sh..." *)
53
+
54
+
(* Generate a DID key *)
55
+
let did_key = K256.pubkey_to_did_key pubkey
56
+
(* => "did:key:zQ3sh..." *)
57
+
```
58
+
59
+
### deriving public keys
60
+
61
+
```ocaml
62
+
(* Derive public key from private key *)
63
+
let pubkey = K256.derive_pubkey ~privkey
64
+
```
65
+
66
+
### key validation
67
+
68
+
```ocaml
69
+
(* Check if a private key is valid *)
70
+
let is_valid = K256.is_valid_privkey privkey
71
+
```
72
+
73
+
## implementation details
74
+
75
+
- Implements [RFC 6979](https://datatracker.ietf.org/doc/html/rfc6979) for deterministic signature generation
76
+
- Implements low-S normalization to prevent signature malleability
77
+
- All signatures are deterministic given the same private key and message
+92
mist/README.md
+92
mist/README.md
···
1
+
# mist
2
+
3
+
is a [Merkle Search Tree](https://atproto.com/specs/repository#mst-structure) implementation for atproto data repositories.
4
+
5
+
## installation
6
+
7
+
Add to your `dune-project`:
8
+
9
+
```lisp
10
+
(depends
11
+
mist
12
+
ipld) ; required dependency
13
+
```
14
+
15
+
## usage
16
+
17
+
### working with TIDs
18
+
19
+
TIDs are 13-character base32-encoded identifiers that combine a microsecond timestamp with a clock ID for ordering and uniqueness.
20
+
21
+
```ocaml
22
+
open Mist
23
+
24
+
(* Generate a TID from current timestamp *)
25
+
let tid = Tid.now ()
26
+
(* => "3jzfcijpj2z23" *)
27
+
28
+
(* Create TID from timestamp *)
29
+
let tid = Tid.of_timestamp_ms 1609459200000L
30
+
~clockid:123
31
+
32
+
(* Parse TID from string *)
33
+
let tid = Tid.of_string "3jzfcijpj2z23"
34
+
35
+
(* Extract timestamp *)
36
+
let (timestamp_us, clockid) = Tid.to_timestamp_us tid
37
+
38
+
(* TIDs are comparable for ordering *)
39
+
let is_later = Tid.compare tid1 tid2 > 0
40
+
```
41
+
42
+
### working with MSTs
43
+
44
+
```ocaml
45
+
open Lwt.Syntax
46
+
47
+
(* Create a new MST with a blockstore and an empty root *)
48
+
let blockstore = Mist.Storage.Memory_blockstore.create () in
49
+
let* mst = Mst.create blockstore (Cid.of_string "")
50
+
51
+
(* Add an entry *)
52
+
let key = "app.bsky.feed.post/3jzfcijpj2z23" in
53
+
let cid = Cid.of_string "bafy2bzaceb3z2z23" in
54
+
let* mst = Mst.add mst key cid blockstore
55
+
56
+
(* Get an entry *)
57
+
let* value_opt = Mst.retrieve_node mst cid in
58
+
match value_opt with
59
+
| Some node -> (* found *)
60
+
| None -> (* not found *)
61
+
62
+
(* Delete an entry *)
63
+
let* mst = Mst.delete mst key
64
+
65
+
(* Get the root CID *)
66
+
let root_cid = Cid.to_string mst.root
67
+
```
68
+
69
+
### inductive proof
70
+
71
+
```ocaml
72
+
(* Generate a map of all blocks needed to prove a given key *)
73
+
let* proof = Mst.proof_for_key mst cid key in
74
+
```
75
+
76
+
### working with blob references
77
+
78
+
```ocaml
79
+
(* Parse blob reference from JSON *)
80
+
let blob = Blob_ref.of_yojson json
81
+
82
+
(* Access blob properties *)
83
+
let cid = blob.ref in
84
+
let mime_type = blob.mime_type in
85
+
let size = blob.size
86
+
87
+
(* Convert to IPLD representation *)
88
+
let ipld = Blob_ref.to_ipld blob
89
+
90
+
(* Convert back to JSON *)
91
+
let json = Blob_ref.to_yojson blob
92
+
```
+2
-75
mist/lib/mst.ml
+2
-75
mist/lib/mst.ml
···
96
96
97
97
type node_or_entry = Node of node | Entry of entry
98
98
99
-
type diff_add = {key: string; cid: Cid.t}
100
-
101
-
type diff_update = {key: string; prev: Cid.t; cid: Cid.t}
102
-
103
-
type diff_delete = {key: string; cid: Cid.t}
104
-
105
-
type data_diff =
106
-
{ adds: diff_add list
107
-
; updates: diff_update list
108
-
; deletes: diff_delete list
109
-
; new_mst_blocks: (Cid.t * bytes) list
110
-
; new_leaf_cids: Cid.Set.t
111
-
; removed_cids: Cid.Set.t }
112
-
113
-
let ( let*? ) lazy_opt_lwt f =
114
-
let%lwt result = Lazy.force lazy_opt_lwt in
115
-
f result
116
-
117
99
let ( >>? ) lazy_opt_lwt f =
118
100
let%lwt result = Lazy.force lazy_opt_lwt in
119
101
f result
···
345
327
let traverse t fn : unit Lwt.t =
346
328
let rec traverse node =
347
329
let%lwt () =
348
-
let*? left = node.left in
330
+
let%lwt left = Lazy.force node.left in
349
331
match left with Some l -> traverse l | None -> Lwt.return_unit
350
332
in
351
333
let%lwt () =
352
334
Lwt_list.iter_s
353
335
(fun (entry : entry) ->
354
336
fn entry.key entry.value ;
355
-
let*? right = entry.right in
337
+
let%lwt right = Lazy.force entry.right in
356
338
match right with Some r -> traverse r | None -> Lwt.return_unit )
357
339
node.entries
358
340
in
···
1634
1616
| _ ->
1635
1617
Lwt.return false
1636
1618
end
1637
-
1638
-
module Inductive (M : Intf) = struct
1639
-
module Cache_bs = Cache_blockstore (Memory_blockstore)
1640
-
module Mem_mst = Make (Cache_bs)
1641
-
1642
-
type diff =
1643
-
| Add of {key: string; cid: Cid.t}
1644
-
| Update of {key: string; prev: Cid.t option; cid: Cid.t}
1645
-
| Delete of {key: string; prev: Cid.t}
1646
-
1647
-
(* given an mst diff, returns all new blocks as well as inductive proof blocks *)
1648
-
let generate_proof (map : Cid.t String_map.t) (diff : diff list)
1649
-
~(new_root : Cid.t) ~(prev_root : Cid.t) : (Block_map.t, exn) Lwt_result.t
1650
-
=
1651
-
try%lwt
1652
-
let%lwt mem_mst =
1653
-
Mem_mst.of_assoc
1654
-
(Cache_bs.create (Memory_blockstore.create ()))
1655
-
(String_map.bindings map)
1656
-
in
1657
-
(* save this now so we can read blocks from it later *)
1658
-
let blockstore = mem_mst.blockstore in
1659
-
(* apply inverse of operations in reverse order,
1660
-
check that mst root matches prev_root *)
1661
-
let%lwt inverted_mst, added_cids =
1662
-
Lwt_list.fold_right_s
1663
-
(fun (diff : diff) (mst, added_cids) ->
1664
-
match diff with
1665
-
| Delete {key; prev} | Update {key; prev= Some prev; _} ->
1666
-
let%lwt mst = Mem_mst.add mst key prev in
1667
-
Lwt.return (mst, Cid.Set.remove prev added_cids)
1668
-
| Add {key; cid} | Update {key; prev= None; cid} ->
1669
-
let%lwt mst = Mem_mst.delete mst key in
1670
-
Lwt.return (mst, Cid.Set.add cid added_cids) )
1671
-
diff (mem_mst, Cid.Set.empty)
1672
-
in
1673
-
if not (Cid.equal inverted_mst.root prev_root) then
1674
-
failwith
1675
-
(Printf.sprintf
1676
-
"inductive proof produced invalid previous cid: expected %s, got \
1677
-
%s"
1678
-
(Cid.to_string prev_root)
1679
-
(Cid.to_string inverted_mst.root) ) ;
1680
-
let proof_cids =
1681
-
Cid.Set.union added_cids (Cache_bs.get_reads blockstore)
1682
-
|> Cid.Set.remove prev_root |> Cid.Set.add new_root
1683
-
in
1684
-
let {blocks= proof_bm; _} : Block_map.with_missing =
1685
-
Block_map.get_many
1686
-
(Cid.Set.elements proof_cids)
1687
-
(Cache_bs.get_cache blockstore)
1688
-
in
1689
-
Lwt.return_ok proof_bm
1690
-
with e -> Lwt.return_error e
1691
-
end
+21
-24
mist/test/test_mst.ml
+21
-24
mist/test/test_mst.ml
···
4
4
module Mem_mst = Mst.Make (Storage.Memory_blockstore)
5
5
module String_map = Dag_cbor.String_map
6
6
7
+
type diff_add = {key: string; cid: Cid.t}
8
+
9
+
type diff_update = {key: string; prev: Cid.t; cid: Cid.t}
10
+
11
+
type diff_delete = {key: string; cid: Cid.t}
12
+
13
+
type data_diff =
14
+
{ adds: diff_add list
15
+
; updates: diff_update list
16
+
; deletes: diff_delete list
17
+
; new_mst_blocks: (Cid.t * bytes) list
18
+
; new_leaf_cids: Cid.Set.t }
19
+
7
20
module Differ (Prev : Mst.Intf) (Curr : Mst.Intf) = struct
8
-
let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : Mst.data_diff Lwt.t =
9
-
let%lwt curr_nodes, curr_node_set, curr_leaf_set =
21
+
let diff ~(t_curr : Curr.t) ~(t_prev : Prev.t) : data_diff Lwt.t =
22
+
let%lwt curr_nodes, _, curr_leaf_set =
10
23
Curr.collect_nodes_and_leaves t_curr
11
24
in
12
25
let%lwt _, prev_node_set, prev_leaf_set =
13
26
Prev.collect_nodes_and_leaves t_prev
14
27
in
15
28
let in_prev_nodes cid = Cid.Set.mem cid prev_node_set in
16
-
let in_curr_nodes cid = Cid.Set.mem cid curr_node_set in
17
29
let in_prev_leaves cid = Cid.Set.mem cid prev_leaf_set in
18
-
let in_curr_leaves cid = Cid.Set.mem cid curr_leaf_set in
19
30
let new_mst_blocks =
20
31
List.filter (fun (cid, _) -> not (in_prev_nodes cid)) curr_nodes
21
32
in
22
-
let removed_node_cids =
23
-
Cid.Set.fold
24
-
(fun cid acc ->
25
-
if not (in_curr_nodes cid) then Cid.Set.add cid acc else acc )
26
-
prev_node_set Cid.Set.empty
27
-
in
28
-
let removed_leaf_cids =
29
-
Cid.Set.fold
30
-
(fun cid acc ->
31
-
if not (in_curr_leaves cid) then Cid.Set.add cid acc else acc )
32
-
prev_leaf_set Cid.Set.empty
33
-
in
34
-
let removed_cids = Cid.Set.union removed_node_cids removed_leaf_cids in
35
33
let new_leaf_cids =
36
34
Cid.Set.fold
37
35
(fun cid acc ->
···
41
39
let%lwt curr_leaves = Curr.leaves_of_root t_curr in
42
40
let%lwt prev_leaves = Prev.leaves_of_root t_prev in
43
41
let rec merge (pl : (string * Cid.t) list) (cl : (string * Cid.t) list)
44
-
(adds : Mst.diff_add list) (updates : Mst.diff_update list)
45
-
(deletes : Mst.diff_delete list) =
42
+
(adds : diff_add list) (updates : diff_update list)
43
+
(deletes : diff_delete list) =
46
44
match (pl, cl) with
47
45
| [], [] ->
48
46
(List.rev adds, List.rev updates, List.rev deletes)
···
64
62
updates deletes
65
63
in
66
64
let adds, updates, deletes = merge prev_leaves curr_leaves [] [] [] in
67
-
Lwt.return
68
-
{Mst.adds; updates; deletes; new_mst_blocks; new_leaf_cids; removed_cids}
65
+
Lwt.return {adds; updates; deletes; new_mst_blocks; new_leaf_cids}
69
66
end
70
67
71
68
module Mem_diff = Differ (Mem_mst) (Mem_mst)
···
487
484
(* contents: convert to maps to compare *)
488
485
let adds_map =
489
486
List.fold_left
490
-
(fun m (a : Mst.diff_add) -> String_map.add a.key a.cid m)
487
+
(fun m (a : diff_add) -> String_map.add a.key a.cid m)
491
488
String_map.empty diff.adds
492
489
in
493
490
let updates_map =
494
491
List.fold_left
495
-
(fun m (u : Mst.diff_update) -> String_map.add u.key (u.prev, u.cid) m)
492
+
(fun m (u : diff_update) -> String_map.add u.key (u.prev, u.cid) m)
496
493
String_map.empty diff.updates
497
494
in
498
495
let deletes_map =
499
496
List.fold_left
500
-
(fun m (d : Mst.diff_delete) -> String_map.add d.key d.cid m)
497
+
(fun m (d : diff_delete) -> String_map.add d.key d.cid m)
501
498
String_map.empty diff.deletes
502
499
in
503
500
(* compare adds *)
+80
pegasus/README.md
+80
pegasus/README.md
···
1
+
# pegasus
2
+
3
+
is the core library implementing the PDS functionality.
4
+
5
+
## architecture
6
+
7
+
```
8
+
pegasus/lib/
9
+
├── api/ # XRPC API endpoints
10
+
│ ├── account_/ # Account management UI
11
+
│ ├── admin/ # com.atproto.admin.* XRPC endpoints
12
+
│ ├── admin_/ # Admin UI
13
+
│ ├── identity/ # com.atproto.identity.* XRPC endpoints
14
+
│ ├── oauth_/ # OAuth flows
15
+
│ ├── repo/ # com.atproto.repo.* XRPC endpoints
16
+
│ ├── server/ # com.atproto.server.* XRPC endpoints
17
+
│ └── sync/ # com.atproto.sync.* XRPC endpoints
18
+
├── oauth/ # OAuth implementation
19
+
├── lexicons/ # Generated atproto types
20
+
├── migrations/ # Database schema migrations
21
+
├── s3/ # S3 blob storage backend
22
+
├── auth.ml # Authentication logic
23
+
├── blob_store.ml # Blob storage interface
24
+
├── data_store.ml # Database interface
25
+
├── env.ml # Environment configuration
26
+
├── id_resolver.ml # Identity resolution
27
+
├── jwt.ml # JWT token handling
28
+
├── plc.ml # PLC directory client
29
+
├── rate_limiter.ml # Rate limiting
30
+
├── repository.ml # Repository operations
31
+
├── sequencer.ml # Event sequencing
32
+
├── session.ml # Session management
33
+
└── user_store.ml # User data access
34
+
```
35
+
36
+
## storage
37
+
38
+
### database
39
+
40
+
Currently only SQLite is supported. Open to pull requests for other databases!
41
+
42
+
### blob storage
43
+
44
+
Supports two backends:
45
+
46
+
- **Local filesystem** - Stores blobs in `{PDS_DATA_DIR}/blobs/{did}/{cid}`
47
+
- **S3-compatible** - Stores blobs in S3 bucket
48
+
49
+
Configurable via environment variables (see main README).
50
+
51
+
## email notifications
52
+
53
+
Optional email support for:
54
+
55
+
- Email address verification
56
+
- Password reset
57
+
- Identity update confirmation
58
+
- Account deletion confirmation
59
+
60
+
Falls back to stdout logging if SMTP not configured.
61
+
62
+
## contributing
63
+
64
+
To add new endpoints:
65
+
66
+
1. Add handler in `./lib/api/`
67
+
2. Register route in [`bin/main.ml`](bin/main.ml)
68
+
3. If frontend, also add to [`frontend/client/Router.mlx`](frontend/client/Router.mlx)
69
+
70
+
## testing
71
+
72
+
Tests are in `pegasus/test/`:
73
+
74
+
```bash
75
+
dune test
76
+
```
77
+
78
+
## environment
79
+
80
+
Configuration is loaded from environment variables. See main README for configuration options.