ATProto Personal Data Server storage for OCaml
Squashed 'ocaml-pds/' content from commit f027f75b git-subtree-split: f027f75b7a877d3ebc57ab9644895499023174fb
+815
+17
.gitignore
+17
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.27.0
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+102
README.md
+102
README.md
···
1
+
# pds
2
+
3
+
ATProto Personal Data Server storage for OCaml.
4
+
5
+
## Overview
6
+
7
+
A library for reading and writing ATProto PDS (Personal Data Server) storage
8
+
format. This enables:
9
+
10
+
- Local PDS-compatible repositories without running a full PDS
11
+
- Offline repository manipulation (backup, migration, inspection)
12
+
- CAR import/export for interoperability
13
+
14
+
## Storage Layout
15
+
16
+
```
17
+
<repo>/
18
+
├── pds.db # SQLite database
19
+
│ ├── blocks table # CID → DAG-CBOR bytes
20
+
│ ├── refs table # name → CID (branches)
21
+
│ └── meta table # did, version, etc.
22
+
└── blobs/ # Large binary data
23
+
├── ba/ # First 2 chars of CID
24
+
│ └── bafyrei... # Full CID as filename
25
+
└── ...
26
+
```
27
+
28
+
## Installation
29
+
30
+
```
31
+
opam install pds
32
+
```
33
+
34
+
## Usage
35
+
36
+
```ocaml
37
+
(* Create a new repository *)
38
+
let repo = Pds.create (Eio.Path.(fs / "my-repo")) ~did:(Atp.Did.of_string_exn "did:web:example.com") in
39
+
40
+
(* Store records *)
41
+
Pds.put repo ~collection:"app.bsky.feed.post" ~rkey:"abc123" record_bytes;
42
+
43
+
(* Read records *)
44
+
let data = Pds.get repo ~collection:"app.bsky.feed.post" ~rkey:"abc123" in
45
+
46
+
(* List collection *)
47
+
let records = Pds.list repo ~collection:"app.bsky.feed.post" in
48
+
49
+
(* Store blobs *)
50
+
let blob_ref = Pds.put_blob repo ~mime_type:"image/png" image_bytes in
51
+
52
+
(* Export as CAR *)
53
+
let car_data = Pds.export_car repo in
54
+
55
+
(* Import from CAR *)
56
+
let count = Pds.import_car repo car_data in
57
+
58
+
(* Close *)
59
+
Pds.close repo
60
+
```
61
+
62
+
## API
63
+
64
+
### Repository
65
+
66
+
- `Pds.create path ~did` - Create a new repository
67
+
- `Pds.open_ path` - Open an existing repository
68
+
- `Pds.did t` - Get the repository's DID
69
+
- `Pds.close t` - Close the repository
70
+
71
+
### Records
72
+
73
+
- `Pds.get t ~collection ~rkey` - Read a record
74
+
- `Pds.put t ~collection ~rkey data` - Write a record
75
+
- `Pds.delete t ~collection ~rkey` - Delete a record
76
+
- `Pds.list t ~collection` - List records in a collection
77
+
78
+
### Blobs
79
+
80
+
- `Pds.put_blob t ~mime_type data` - Store a blob
81
+
- `Pds.get_blob t cid` - Read a blob
82
+
83
+
### Commits
84
+
85
+
- `Pds.head t` - Get current commit CID
86
+
- `Pds.checkout t` - Get MST at HEAD
87
+
- `Pds.commit t ~tree ~message ~signing_key` - Create a signed commit
88
+
89
+
### Import/Export
90
+
91
+
- `Pds.import_car t data` - Import blocks from CAR
92
+
- `Pds.export_car t` - Export repository as CAR
93
+
94
+
## Related Work
95
+
96
+
- [ocaml-atp](https://tangled.org/anil.recoil.org/ocaml-atp) - ATProto primitives (MST, CID, DAG-CBOR, CAR)
97
+
- [ocaml-sqlite](https://tangled.org/gazagnaire.org/ocaml-sqlite) - SQLite key-value store (used internally)
98
+
- [Bluesky PDS](https://github.com/bluesky-social/pds) - Reference TypeScript implementation
99
+
100
+
## License
101
+
102
+
MIT License. See [LICENSE.md](LICENSE.md) for details.
+23
dune-project
+23
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name pds)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire")
9
+
(maintainers "Thomas Gazagnaire")
10
+
(source (uri https://tangled.org/gazagnaire.org/ocaml-pds))
11
+
12
+
(package
13
+
(name pds)
14
+
(synopsis "ATProto Personal Data Server storage for OCaml")
15
+
(description
16
+
"A library for reading and writing ATProto PDS (Personal Data Server) storage format. Enables local PDS-compatible repositories, offline repository manipulation, and CAR import/export.")
17
+
(depends
18
+
(ocaml (>= 5.1))
19
+
(eio (>= 1.0))
20
+
(atp (>= 0.1))
21
+
(sqlite (>= 0.1))
22
+
(alcotest :with-test)
23
+
(eio_main :with-test)))
+59
lib/blob_store.ml
+59
lib/blob_store.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Filesystem-based blob storage with CID-based paths.
7
+
8
+
Blobs are stored in a directory structure organized by CID prefix:
9
+
{[
10
+
blobs/
11
+
├── ba/
12
+
│ └── bafyrei...
13
+
└── bf/
14
+
└── bafybei...
15
+
]} *)
16
+
17
+
type t = { dir : Eio.Fs.dir_ty Eio.Path.t }
18
+
19
+
let create dir =
20
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dir with _ -> ());
21
+
{ dir }
22
+
23
+
let blob_path t cid =
24
+
let s = Atp.Cid.to_string cid in
25
+
let prefix = String.sub s 0 (min 2 (String.length s)) in
26
+
Eio.Path.(t.dir / prefix / s)
27
+
28
+
let put t ~mime_type data =
29
+
(* Create CID from raw data *)
30
+
let cid = Atp.Cid.create `Raw data in
31
+
let path = blob_path t cid in
32
+
(* Create parent directory *)
33
+
let parent = Eio.Path.split path |> Option.map fst in
34
+
Option.iter
35
+
(fun p ->
36
+
try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p with _ -> ())
37
+
parent;
38
+
(* Write blob data *)
39
+
Eio.Path.save ~create:(`Or_truncate 0o644) path data;
40
+
(* Return blob reference *)
41
+
let size = Int64.of_int (String.length data) in
42
+
{ Atp.Blob_ref.cid; mime_type; size }
43
+
44
+
let get t cid =
45
+
let path = blob_path t cid in
46
+
try Some (Eio.Path.load path)
47
+
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> None
48
+
49
+
let delete t cid =
50
+
let path = blob_path t cid in
51
+
try Eio.Path.unlink path
52
+
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> ()
53
+
54
+
let mem t cid =
55
+
let path = blob_path t cid in
56
+
match Eio.Path.kind ~follow:true path with
57
+
| `Regular_file -> true
58
+
| _ -> false
59
+
| exception Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> false
+192
lib/pds.ml
+192
lib/pds.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
path : Eio.Fs.dir_ty Eio.Path.t;
8
+
db : Sqlite.t;
9
+
blocks : Sqlite.Table.t;
10
+
refs : Sqlite.Table.t;
11
+
meta : Sqlite.Table.t;
12
+
blobs : Blob_store.t;
13
+
blockstore : Atp.Blockstore.writable;
14
+
mutable did : Atp.Did.t;
15
+
}
16
+
17
+
(* Repository layout:
18
+
<path>/
19
+
├── pds.db # SQLite database (blocks, refs, meta tables)
20
+
└── blobs/ # Filesystem blob storage
21
+
*)
22
+
23
+
let db_path path = Eio.Path.(path / "pds.db")
24
+
let blobs_path path = Eio.Path.(path / "blobs")
25
+
26
+
let create path ~did =
27
+
(* Create directory structure *)
28
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path with _ -> ());
29
+
let db = Sqlite.create (db_path path) in
30
+
let blocks = Sqlite.Table.create db ~name:"blocks" in
31
+
let refs = Sqlite.Table.create db ~name:"refs" in
32
+
let meta = Sqlite.Table.create db ~name:"meta" in
33
+
let blobs = Blob_store.create (blobs_path path) in
34
+
let blockstore = Sqlite_blockstore.create blocks in
35
+
(* Store DID in metadata *)
36
+
Sqlite.Table.put meta "did" (Atp.Did.to_string did);
37
+
Sqlite.Table.put meta "version" "1";
38
+
{ path; db; blocks; refs; meta; blobs; blockstore; did }
39
+
40
+
let open_ path =
41
+
let db_file = db_path path in
42
+
(* Check database exists *)
43
+
(match Eio.Path.kind ~follow:true db_file with
44
+
| `Regular_file -> ()
45
+
| _ -> failwith "PDS database not found"
46
+
| exception Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) ->
47
+
failwith "PDS database not found");
48
+
let db = Sqlite.create db_file in
49
+
let blocks = Sqlite.Table.create db ~name:"blocks" in
50
+
let refs = Sqlite.Table.create db ~name:"refs" in
51
+
let meta = Sqlite.Table.create db ~name:"meta" in
52
+
let blobs = Blob_store.create (blobs_path path) in
53
+
let blockstore = Sqlite_blockstore.create blocks in
54
+
(* Read DID from metadata *)
55
+
let did =
56
+
match Sqlite.Table.get meta "did" with
57
+
| Some s -> Atp.Did.of_string_exn s
58
+
| None -> failwith "PDS metadata missing DID"
59
+
in
60
+
{ path; db; blocks; refs; meta; blobs; blockstore; did }
61
+
62
+
let did t = t.did
63
+
let close t = Sqlite.close t.db
64
+
let blockstore t = t.blockstore
65
+
66
+
(* Refs *)
67
+
68
+
let get_ref t name =
69
+
Option.map Atp.Cid.of_string (Sqlite.Table.get t.refs name)
70
+
71
+
let set_ref t name cid =
72
+
Sqlite.Table.put t.refs name (Atp.Cid.to_string cid)
73
+
74
+
let delete_ref t name = Sqlite.Table.delete t.refs name
75
+
76
+
let list_refs t =
77
+
let refs = ref [] in
78
+
Sqlite.Table.iter t.refs ~f:(fun name cid_str ->
79
+
refs := (name, Atp.Cid.of_string cid_str) :: !refs);
80
+
List.rev !refs
81
+
82
+
(* HEAD is a special ref *)
83
+
84
+
let head t = get_ref t "head"
85
+
let set_head t cid = set_ref t "head" cid
86
+
87
+
(* MST operations *)
88
+
89
+
let checkout t =
90
+
match head t with
91
+
| None -> None
92
+
| Some cid -> Some (Atp.Mst.of_cid cid ~store:t.blockstore)
93
+
94
+
(* Record key format: collection/rkey *)
95
+
96
+
let record_key ~collection ~rkey = collection ^ "/" ^ rkey
97
+
98
+
let parse_record_key key =
99
+
match String.index_opt key '/' with
100
+
| None -> None
101
+
| Some i ->
102
+
let collection = String.sub key 0 i in
103
+
let rkey = String.sub key (i + 1) (String.length key - i - 1) in
104
+
Some (collection, rkey)
105
+
106
+
(* Records *)
107
+
108
+
let get t ~collection ~rkey =
109
+
match checkout t with
110
+
| None -> None
111
+
| Some mst ->
112
+
let key = record_key ~collection ~rkey in
113
+
(match Atp.Mst.get key mst ~store:t.blockstore with
114
+
| None -> None
115
+
| Some cid -> t.blockstore#get cid)
116
+
117
+
let put t ~collection ~rkey data =
118
+
let key = record_key ~collection ~rkey in
119
+
(* Create block for record data *)
120
+
let cid = Atp.Cid.create `Dag_cbor data in
121
+
t.blockstore#put cid data;
122
+
(* Update MST *)
123
+
let mst =
124
+
match checkout t with
125
+
| None -> Atp.Mst.empty
126
+
| Some mst -> mst
127
+
in
128
+
let new_mst = Atp.Mst.add key cid mst ~store:t.blockstore in
129
+
let root_cid = Atp.Mst.to_cid new_mst ~store:t.blockstore in
130
+
set_head t root_cid
131
+
132
+
let delete t ~collection ~rkey =
133
+
match checkout t with
134
+
| None -> ()
135
+
| Some mst ->
136
+
let key = record_key ~collection ~rkey in
137
+
let new_mst = Atp.Mst.remove key mst ~store:t.blockstore in
138
+
let root_cid = Atp.Mst.to_cid new_mst ~store:t.blockstore in
139
+
set_head t root_cid
140
+
141
+
let list t ~collection =
142
+
match checkout t with
143
+
| None -> []
144
+
| Some mst ->
145
+
let prefix = collection ^ "/" in
146
+
let prefix_len = String.length prefix in
147
+
Atp.Mst.leaves mst ~store:t.blockstore
148
+
|> Seq.filter_map (fun (key, cid) ->
149
+
if String.length key >= prefix_len
150
+
&& String.sub key 0 prefix_len = prefix
151
+
then
152
+
let rkey = String.sub key prefix_len (String.length key - prefix_len) in
153
+
Some (rkey, cid)
154
+
else None)
155
+
|> List.of_seq
156
+
157
+
(* Blobs *)
158
+
159
+
let put_blob t ~mime_type data = Blob_store.put t.blobs ~mime_type data
160
+
let get_blob t cid = Blob_store.get t.blobs cid
161
+
162
+
(* CAR Import/Export *)
163
+
164
+
let import_car t car_data =
165
+
let reader = Bytesrw.Bytes.Reader.of_string car_data in
166
+
let _header, blocks = Atp.Car.read ~cid_format:`Atproto reader in
167
+
let count = ref 0 in
168
+
Seq.iter
169
+
(fun (cid, data) ->
170
+
t.blockstore#put cid data;
171
+
incr count)
172
+
blocks;
173
+
!count
174
+
175
+
let export_car t =
176
+
match head t with
177
+
| None ->
178
+
(* Empty repo - return empty CAR *)
179
+
Atp.Car.to_string ~cid_format:`Atproto
180
+
{ Atp.Car.version = 1; roots = [] }
181
+
Seq.empty
182
+
| Some root_cid ->
183
+
match checkout t with
184
+
| None ->
185
+
Atp.Car.to_string ~cid_format:`Atproto
186
+
{ Atp.Car.version = 1; roots = [ root_cid ] }
187
+
Seq.empty
188
+
| Some mst ->
189
+
let blocks = Atp.Mst.to_blocks mst ~store:t.blockstore in
190
+
Atp.Car.to_string ~cid_format:`Atproto
191
+
{ Atp.Car.version = 1; roots = [ root_cid ] }
192
+
blocks
+103
lib/pds.mli
+103
lib/pds.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** ATProto Personal Data Server storage.
7
+
8
+
A library for reading and writing ATProto PDS (Personal Data Server)
9
+
storage format. Enables local PDS-compatible repositories, offline
10
+
repository manipulation, and CAR import/export. *)
11
+
12
+
(** {1 Repository} *)
13
+
14
+
type t
15
+
(** A PDS repository. *)
16
+
17
+
val create : Eio.Fs.dir_ty Eio.Path.t -> did:Atp.Did.t -> t
18
+
(** [create path ~did] creates a new repository at [path] for the given DID.
19
+
The directory will be created if it doesn't exist. *)
20
+
21
+
val open_ : Eio.Fs.dir_ty Eio.Path.t -> t
22
+
(** [open_ path] opens an existing repository at [path].
23
+
@raise Failure if the repository doesn't exist or is invalid. *)
24
+
25
+
val did : t -> Atp.Did.t
26
+
(** [did t] returns the repository's DID. *)
27
+
28
+
val close : t -> unit
29
+
(** [close t] closes the repository and releases resources. *)
30
+
31
+
(** {1 Blockstore} *)
32
+
33
+
val blockstore : t -> Atp.Blockstore.writable
34
+
(** [blockstore t] returns the underlying blockstore (SQLite-backed).
35
+
Use this for direct block operations. *)
36
+
37
+
(** {1 Commits} *)
38
+
39
+
val head : t -> Atp.Cid.t option
40
+
(** [head t] returns the current commit CID, or [None] if the repository
41
+
is empty (no commits yet). *)
42
+
43
+
val set_head : t -> Atp.Cid.t -> unit
44
+
(** [set_head t cid] sets the HEAD reference to [cid]. *)
45
+
46
+
val checkout : t -> Atp.Mst.node option
47
+
(** [checkout t] returns the MST root at HEAD, or [None] if empty. *)
48
+
49
+
(** {1 Records}
50
+
51
+
Records are stored in the MST with keys of the form
52
+
[collection/rkey], e.g., ["app.bsky.feed.post/abc123"]. *)
53
+
54
+
val get : t -> collection:string -> rkey:string -> string option
55
+
(** [get t ~collection ~rkey] reads a record's DAG-CBOR bytes. *)
56
+
57
+
val put : t -> collection:string -> rkey:string -> string -> unit
58
+
(** [put t ~collection ~rkey data] writes a record (DAG-CBOR bytes).
59
+
Creates a new block and updates the MST. *)
60
+
61
+
val delete : t -> collection:string -> rkey:string -> unit
62
+
(** [delete t ~collection ~rkey] removes a record from the MST. *)
63
+
64
+
val list : t -> collection:string -> (string * Atp.Cid.t) list
65
+
(** [list t ~collection] returns all record keys and CIDs in a collection. *)
66
+
67
+
(** {1 Blobs}
68
+
69
+
Blobs are stored in a separate filesystem directory, organized by
70
+
CID prefix for efficient access. *)
71
+
72
+
val put_blob : t -> mime_type:string -> string -> Atp.Blob_ref.t
73
+
(** [put_blob t ~mime_type data] stores a blob and returns its reference.
74
+
The blob is content-addressed by its CID. *)
75
+
76
+
val get_blob : t -> Atp.Cid.t -> string option
77
+
(** [get_blob t cid] reads blob data by CID. *)
78
+
79
+
(** {1 Import/Export} *)
80
+
81
+
val import_car : t -> string -> int
82
+
(** [import_car t car_data] imports blocks from CAR data.
83
+
Returns the number of blocks imported. Does not update HEAD. *)
84
+
85
+
val export_car : t -> string
86
+
(** [export_car t] exports the repository as CAR data.
87
+
Includes all blocks reachable from HEAD. *)
88
+
89
+
(** {1 Refs}
90
+
91
+
Named references (like git branches). The default ref is ["head"]. *)
92
+
93
+
val get_ref : t -> string -> Atp.Cid.t option
94
+
(** [get_ref t name] returns the CID for ref [name]. *)
95
+
96
+
val set_ref : t -> string -> Atp.Cid.t -> unit
97
+
(** [set_ref t name cid] sets ref [name] to [cid]. *)
98
+
99
+
val delete_ref : t -> string -> unit
100
+
(** [delete_ref t name] removes ref [name]. *)
101
+
102
+
val list_refs : t -> (string * Atp.Cid.t) list
103
+
(** [list_refs t] returns all refs. *)
+49
lib/sqlite_blockstore.ml
+49
lib/sqlite_blockstore.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** SQLite-backed blockstore implementing [Atp.Blockstore.writable]. *)
7
+
8
+
class sqlite_store (blocks : Sqlite.Table.t) =
9
+
object (self)
10
+
method get cid =
11
+
let key = Atp.Cid.to_string cid in
12
+
Sqlite.Table.get blocks key
13
+
14
+
method get_exn cid =
15
+
match self#get cid with
16
+
| Some data -> data
17
+
| None -> Atp.Blockstore.raise_error (`Block_not_found cid)
18
+
19
+
method has cid =
20
+
let key = Atp.Cid.to_string cid in
21
+
Sqlite.Table.mem blocks key
22
+
23
+
method get_many cids =
24
+
let blocks_map, missing =
25
+
List.fold_left
26
+
(fun (found, missing) cid ->
27
+
match self#get cid with
28
+
| Some data -> (Atp.Block_map.set cid data found, missing)
29
+
| None -> (found, cid :: missing))
30
+
(Atp.Block_map.empty, []) cids
31
+
in
32
+
{ Atp.Block_map.blocks = blocks_map; missing = List.rev missing }
33
+
34
+
method put cid data =
35
+
let key = Atp.Cid.to_string cid in
36
+
Sqlite.Table.put blocks key data
37
+
38
+
method put_many new_blocks =
39
+
Atp.Block_map.iter (fun cid data -> self#put cid data) new_blocks
40
+
41
+
method delete cid =
42
+
let key = Atp.Cid.to_string cid in
43
+
Sqlite.Table.delete blocks key
44
+
45
+
method delete_many cids = List.iter self#delete cids
46
+
method sync = ()
47
+
end
48
+
49
+
let create blocks = (new sqlite_store blocks :> Atp.Blockstore.writable)
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "pds" Test_pds.suite
+240
test/test_pds.ml
+240
test/test_pds.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let test_did = Atp.Did.of_string_exn "did:web:example.com"
7
+
8
+
let with_temp_repo f =
9
+
Eio_main.run @@ fun env ->
10
+
let cwd = Eio.Stdenv.cwd env in
11
+
let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds") in
12
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with _ -> ());
13
+
let path =
14
+
Eio.Path.(tmp_dir / Printf.sprintf "repo_%d" (Random.int 1_000_000))
15
+
in
16
+
let repo = Pds.create path ~did:test_did in
17
+
Fun.protect ~finally:(fun () -> Pds.close repo) (fun () -> f repo)
18
+
19
+
(* Basic repository operations *)
20
+
21
+
let test_create_open () =
22
+
Eio_main.run @@ fun env ->
23
+
let cwd = Eio.Stdenv.cwd env in
24
+
let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds") in
25
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with _ -> ());
26
+
let path =
27
+
Eio.Path.(tmp_dir / Printf.sprintf "repo_%d" (Random.int 1_000_000))
28
+
in
29
+
(* Create *)
30
+
let repo = Pds.create path ~did:test_did in
31
+
Pds.close repo;
32
+
(* Open *)
33
+
let repo2 = Pds.open_ path in
34
+
let did = Pds.did repo2 in
35
+
Pds.close repo2;
36
+
Alcotest.(check string) "DID preserved" "did:web:example.com" (Atp.Did.to_string did)
37
+
38
+
let test_did () =
39
+
with_temp_repo @@ fun repo ->
40
+
let did = Pds.did repo in
41
+
Alcotest.(check string) "DID matches" "did:web:example.com" (Atp.Did.to_string did)
42
+
43
+
let test_empty_head () =
44
+
with_temp_repo @@ fun repo ->
45
+
let head = Pds.head repo in
46
+
Alcotest.(check bool) "empty repo has no head" true (Option.is_none head)
47
+
48
+
(* Record operations *)
49
+
50
+
let test_put_get_record () =
51
+
with_temp_repo @@ fun repo ->
52
+
let data = Atp.Dagcbor.encode_string (`Map [ ("text", `String "Hello world") ]) in
53
+
Pds.put repo ~collection:"app.bsky.feed.post" ~rkey:"abc123" data;
54
+
let result = Pds.get repo ~collection:"app.bsky.feed.post" ~rkey:"abc123" in
55
+
Alcotest.(check (option string)) "record retrieved" (Some data) result
56
+
57
+
let test_get_missing_record () =
58
+
with_temp_repo @@ fun repo ->
59
+
let result = Pds.get repo ~collection:"app.bsky.feed.post" ~rkey:"nonexistent" in
60
+
Alcotest.(check (option string)) "missing record returns None" None result
61
+
62
+
let test_delete_record () =
63
+
with_temp_repo @@ fun repo ->
64
+
let data = Atp.Dagcbor.encode_string (`String "test") in
65
+
Pds.put repo ~collection:"test.collection" ~rkey:"key1" data;
66
+
Pds.delete repo ~collection:"test.collection" ~rkey:"key1";
67
+
let result = Pds.get repo ~collection:"test.collection" ~rkey:"key1" in
68
+
Alcotest.(check (option string)) "deleted record returns None" None result
69
+
70
+
let test_list_collection () =
71
+
with_temp_repo @@ fun repo ->
72
+
let data1 = Atp.Dagcbor.encode_string (`String "post1") in
73
+
let data2 = Atp.Dagcbor.encode_string (`String "post2") in
74
+
let data3 = Atp.Dagcbor.encode_string (`String "other") in
75
+
Pds.put repo ~collection:"app.bsky.feed.post" ~rkey:"a" data1;
76
+
Pds.put repo ~collection:"app.bsky.feed.post" ~rkey:"b" data2;
77
+
Pds.put repo ~collection:"app.bsky.feed.like" ~rkey:"c" data3;
78
+
let posts = Pds.list repo ~collection:"app.bsky.feed.post" in
79
+
let rkeys = List.map fst posts |> List.sort String.compare in
80
+
Alcotest.(check (list string)) "list returns collection records" [ "a"; "b" ] rkeys
81
+
82
+
let test_multiple_collections () =
83
+
with_temp_repo @@ fun repo ->
84
+
let data = Atp.Dagcbor.encode_string (`String "data") in
85
+
Pds.put repo ~collection:"col1" ~rkey:"k1" data;
86
+
Pds.put repo ~collection:"col2" ~rkey:"k2" data;
87
+
let col1 = Pds.list repo ~collection:"col1" in
88
+
let col2 = Pds.list repo ~collection:"col2" in
89
+
Alcotest.(check int) "col1 has 1 record" 1 (List.length col1);
90
+
Alcotest.(check int) "col2 has 1 record" 1 (List.length col2)
91
+
92
+
(* Blob operations *)
93
+
94
+
let test_put_get_blob () =
95
+
with_temp_repo @@ fun repo ->
96
+
let data = "PNG image data here" in
97
+
let blob_ref = Pds.put_blob repo ~mime_type:"image/png" data in
98
+
Alcotest.(check string) "mime type" "image/png" blob_ref.mime_type;
99
+
Alcotest.(check int64) "size" (Int64.of_int (String.length data)) blob_ref.size;
100
+
let result = Pds.get_blob repo blob_ref.cid in
101
+
Alcotest.(check (option string)) "blob data retrieved" (Some data) result
102
+
103
+
let test_get_missing_blob () =
104
+
with_temp_repo @@ fun repo ->
105
+
let fake_cid = Atp.Cid.create `Raw "nonexistent" in
106
+
let result = Pds.get_blob repo fake_cid in
107
+
Alcotest.(check (option string)) "missing blob returns None" None result
108
+
109
+
let test_binary_blob () =
110
+
with_temp_repo @@ fun repo ->
111
+
let data = "\x00\x01\x02\xff\xfe\xfd" in
112
+
let blob_ref = Pds.put_blob repo ~mime_type:"application/octet-stream" data in
113
+
let result = Pds.get_blob repo blob_ref.cid in
114
+
Alcotest.(check (option string)) "binary blob preserved" (Some data) result
115
+
116
+
(* Refs *)
117
+
118
+
let test_refs () =
119
+
with_temp_repo @@ fun repo ->
120
+
let cid = Atp.Cid.create `Dag_cbor "test data" in
121
+
Pds.set_ref repo "branch1" cid;
122
+
let result = Pds.get_ref repo "branch1" in
123
+
Alcotest.(check bool) "ref set and retrieved" true (Option.is_some result);
124
+
Alcotest.(check string) "ref CID matches" (Atp.Cid.to_string cid)
125
+
(Atp.Cid.to_string (Option.get result))
126
+
127
+
let test_list_refs () =
128
+
with_temp_repo @@ fun repo ->
129
+
let cid1 = Atp.Cid.create `Dag_cbor "data1" in
130
+
let cid2 = Atp.Cid.create `Dag_cbor "data2" in
131
+
Pds.set_ref repo "ref1" cid1;
132
+
Pds.set_ref repo "ref2" cid2;
133
+
let refs = Pds.list_refs repo in
134
+
let names = List.map fst refs |> List.sort String.compare in
135
+
Alcotest.(check (list string)) "refs listed" [ "ref1"; "ref2" ] names
136
+
137
+
let test_delete_ref () =
138
+
with_temp_repo @@ fun repo ->
139
+
let cid = Atp.Cid.create `Dag_cbor "test" in
140
+
Pds.set_ref repo "temp" cid;
141
+
Pds.delete_ref repo "temp";
142
+
let result = Pds.get_ref repo "temp" in
143
+
Alcotest.(check bool) "ref deleted" true (Option.is_none result)
144
+
145
+
(* CAR import/export *)
146
+
147
+
let test_car_roundtrip () =
148
+
with_temp_repo @@ fun repo ->
149
+
(* Add some data *)
150
+
let data1 = Atp.Dagcbor.encode_string (`String "post1") in
151
+
let data2 = Atp.Dagcbor.encode_string (`String "post2") in
152
+
Pds.put repo ~collection:"test" ~rkey:"a" data1;
153
+
Pds.put repo ~collection:"test" ~rkey:"b" data2;
154
+
(* Export *)
155
+
let car_data = Pds.export_car repo in
156
+
Alcotest.(check bool) "CAR data not empty" true (String.length car_data > 0)
157
+
158
+
let test_car_import () =
159
+
with_temp_repo @@ fun repo ->
160
+
(* Create CAR data from another repo *)
161
+
let car_data =
162
+
Eio_main.run @@ fun env ->
163
+
let cwd = Eio.Stdenv.cwd env in
164
+
let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds") in
165
+
let path =
166
+
Eio.Path.(tmp_dir / Printf.sprintf "export_%d" (Random.int 1_000_000))
167
+
in
168
+
let export_repo = Pds.create path ~did:test_did in
169
+
let data = Atp.Dagcbor.encode_string (`String "imported") in
170
+
Pds.put export_repo ~collection:"test" ~rkey:"x" data;
171
+
let car = Pds.export_car export_repo in
172
+
Pds.close export_repo;
173
+
car
174
+
in
175
+
(* Import *)
176
+
let count = Pds.import_car repo car_data in
177
+
Alcotest.(check bool) "imported blocks" true (count >= 0)
178
+
179
+
let test_empty_export () =
180
+
with_temp_repo @@ fun repo ->
181
+
let car_data = Pds.export_car repo in
182
+
(* Should produce valid but minimal CAR *)
183
+
Alcotest.(check bool) "empty export works" true (String.length car_data > 0)
184
+
185
+
(* Head/commit operations *)
186
+
187
+
let test_head_after_put () =
188
+
with_temp_repo @@ fun repo ->
189
+
let data = Atp.Dagcbor.encode_string (`String "test") in
190
+
Pds.put repo ~collection:"test" ~rkey:"k" data;
191
+
let head = Pds.head repo in
192
+
Alcotest.(check bool) "head set after put" true (Option.is_some head)
193
+
194
+
let test_checkout () =
195
+
with_temp_repo @@ fun repo ->
196
+
let data = Atp.Dagcbor.encode_string (`String "test") in
197
+
Pds.put repo ~collection:"test" ~rkey:"k" data;
198
+
let mst = Pds.checkout repo in
199
+
Alcotest.(check bool) "checkout returns MST" true (Option.is_some mst)
200
+
201
+
let suite =
202
+
[
203
+
( "repository",
204
+
[
205
+
Alcotest.test_case "create/open" `Quick test_create_open;
206
+
Alcotest.test_case "did" `Quick test_did;
207
+
Alcotest.test_case "empty head" `Quick test_empty_head;
208
+
] );
209
+
( "records",
210
+
[
211
+
Alcotest.test_case "put/get" `Quick test_put_get_record;
212
+
Alcotest.test_case "get missing" `Quick test_get_missing_record;
213
+
Alcotest.test_case "delete" `Quick test_delete_record;
214
+
Alcotest.test_case "list collection" `Quick test_list_collection;
215
+
Alcotest.test_case "multiple collections" `Quick test_multiple_collections;
216
+
] );
217
+
( "blobs",
218
+
[
219
+
Alcotest.test_case "put/get" `Quick test_put_get_blob;
220
+
Alcotest.test_case "missing" `Quick test_get_missing_blob;
221
+
Alcotest.test_case "binary" `Quick test_binary_blob;
222
+
] );
223
+
( "refs",
224
+
[
225
+
Alcotest.test_case "set/get" `Quick test_refs;
226
+
Alcotest.test_case "list" `Quick test_list_refs;
227
+
Alcotest.test_case "delete" `Quick test_delete_ref;
228
+
] );
229
+
( "car",
230
+
[
231
+
Alcotest.test_case "roundtrip" `Quick test_car_roundtrip;
232
+
Alcotest.test_case "import" `Quick test_car_import;
233
+
Alcotest.test_case "empty export" `Quick test_empty_export;
234
+
] );
235
+
( "commits",
236
+
[
237
+
Alcotest.test_case "head after put" `Quick test_head_after_put;
238
+
Alcotest.test_case "checkout" `Quick test_checkout;
239
+
] );
240
+
]