-370

test/test_atproto.ml

reviewed

··· 1 1 - (** Record-level tests for [Irmin.Atproto]. 2 2 - 3 3 - This suite covers the auto-commit record API (put_record / get_record / 4 4 - delete_record / list_records / list_collections / describe_repo). The 5 5 - lower-level tree API that these build on is tested separately in 6 6 - [test_atproto_tree.ml]. *) 7 7 - 8 8 - open Irmin 9 9 - 10 10 - let test_did = "did:web:test.example.com" 11 11 - let pub_author = "tester" 12 12 - 13 13 - let with_memory_store f = 14 14 - let store = Atproto.memory () in 15 15 - f store 16 16 - 17 17 - (* ---------- put / get / delete ---------- *) 18 18 - 19 19 - let test_put_get_record () = 20 20 - with_memory_store @@ fun store -> 21 21 - let _ = 22 22 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 23 23 - ~rkey:"post1" "{\"text\":\"hi\"}" 24 24 - in 25 25 - Alcotest.(check (option string)) 26 26 - "get after put" (Some "{\"text\":\"hi\"}") 27 27 - (Atproto.get_record store ~collection:"app.bsky.feed.post" ~rkey:"post1") 28 28 - 29 29 - let test_get_nonexistent () = 30 30 - with_memory_store @@ fun store -> 31 31 - Alcotest.(check (option string)) 32 32 - "get missing" None 33 33 - (Atproto.get_record store ~collection:"c" ~rkey:"missing") 34 34 - 35 35 - let test_put_overwrites () = 36 36 - with_memory_store @@ fun store -> 37 37 - let _ = 38 38 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"k" "v1" 39 39 - in 40 40 - let _ = 41 41 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"k" "v2" 42 42 - in 43 43 - Alcotest.(check (option string)) 44 44 - "second put wins" (Some "v2") 45 45 - (Atproto.get_record store ~collection:"c" ~rkey:"k") 46 46 - 47 47 - let test_delete_record () = 48 48 - with_memory_store @@ fun store -> 49 49 - let _ = 50 50 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"keep" 51 51 - "v1" 52 52 - in 53 53 - let _ = 54 54 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"drop" 55 55 - "v2" 56 56 - in 57 57 - let _ = 58 58 - Atproto.delete_record store ~author:pub_author ~collection:"c" ~rkey:"drop" 59 59 - () 60 60 - in 61 61 - Alcotest.(check (option string)) 62 62 - "kept" (Some "v1") 63 63 - (Atproto.get_record store ~collection:"c" ~rkey:"keep"); 64 64 - Alcotest.(check (option string)) 65 65 - "deleted" None 66 66 - (Atproto.get_record store ~collection:"c" ~rkey:"drop") 67 67 - 68 68 - let test_delete_nonexistent_is_noop () = 69 69 - with_memory_store @@ fun store -> 70 70 - let _ = 71 71 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"a" "v" 72 72 - in 73 73 - let _ = 74 74 - Atproto.delete_record store ~author:pub_author ~collection:"c" 75 75 - ~rkey:"never-existed" () 76 76 - in 77 77 - Alcotest.(check (option string)) 78 78 - "unaffected" (Some "v") 79 79 - (Atproto.get_record store ~collection:"c" ~rkey:"a") 80 80 - 81 81 - (* ---------- listRecords semantics ---------- *) 82 82 - 83 83 - let seed_feed store = 84 84 - let _ = 85 85 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 86 86 - ~rkey:"3kaaa" "{\"text\":\"first\"}" 87 87 - in 88 88 - let _ = 89 89 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 90 90 - ~rkey:"3kbbb" "{\"text\":\"second\"}" 91 91 - in 92 92 - let _ = 93 93 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 94 94 - ~rkey:"3kccc" "{\"text\":\"third\"}" 95 95 - in 96 96 - let _ = 97 97 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 98 98 - ~rkey:"3kddd" "{\"text\":\"fourth\"}" 99 99 - in 100 100 - () 101 101 - 102 102 - let test_list_records_sorted () = 103 103 - with_memory_store @@ fun store -> 104 104 - seed_feed store; 105 105 - let records, _ = 106 106 - Atproto.list_records store ~collection:"app.bsky.feed.post" () 107 107 - in 108 108 - let rkeys = List.map fst records in 109 109 - Alcotest.(check (list string)) 110 110 - "records in MST key order (lex sort)" 111 111 - [ "3kaaa"; "3kbbb"; "3kccc"; "3kddd" ] 112 112 - rkeys 113 113 - 114 114 - let test_list_records_limit () = 115 115 - with_memory_store @@ fun store -> 116 116 - seed_feed store; 117 117 - let records, cursor = 118 118 - Atproto.list_records store ~collection:"app.bsky.feed.post" ~limit:2 () 119 119 - in 120 120 - Alcotest.(check int) "limit respected" 2 (List.length records); 121 121 - let rkeys = List.map fst records in 122 122 - Alcotest.(check (list string)) "first page" [ "3kaaa"; "3kbbb" ] rkeys; 123 123 - Alcotest.(check bool) "cursor present" true (Option.is_some cursor) 124 124 - 125 125 - let test_list_records_cursor_pagination () = 126 126 - with_memory_store @@ fun store -> 127 127 - seed_feed store; 128 128 - let first_page, cursor = 129 129 - Atproto.list_records store ~collection:"app.bsky.feed.post" ~limit:2 () 130 130 - in 131 131 - let cursor = 132 132 - match cursor with Some c -> c | None -> Alcotest.fail "no cursor" 133 133 - in 134 134 - let second_page, cursor2 = 135 135 - Atproto.list_records store ~collection:"app.bsky.feed.post" ~limit:10 136 136 - ~cursor () 137 137 - in 138 138 - let all = List.map fst first_page @ List.map fst second_page in 139 139 - Alcotest.(check (list string)) 140 140 - "union of pages = all records (no dup, no gap)" 141 141 - [ "3kaaa"; "3kbbb"; "3kccc"; "3kddd" ] 142 142 - all; 143 143 - Alcotest.(check bool) 144 144 - "final page has no further cursor" true (Option.is_none cursor2) 145 145 - 146 146 - let test_list_records_empty_collection () = 147 147 - with_memory_store @@ fun store -> 148 148 - let records, cursor = 149 149 - Atproto.list_records store ~collection:"empty.collection" () 150 150 - in 151 151 - Alcotest.(check int) "no records" 0 (List.length records); 152 152 - Alcotest.(check bool) "no cursor" true (Option.is_none cursor) 153 153 - 154 154 - (* ---------- collection isolation ---------- *) 155 155 - 156 156 - let test_collections_isolated () = 157 157 - with_memory_store @@ fun store -> 158 158 - let _ = 159 159 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 160 160 - ~rkey:"p" "post" 161 161 - in 162 162 - let _ = 163 163 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.like" 164 164 - ~rkey:"p" "like" 165 165 - in 166 166 - Alcotest.(check (option string)) 167 167 - "post" (Some "post") 168 168 - (Atproto.get_record store ~collection:"app.bsky.feed.post" ~rkey:"p"); 169 169 - Alcotest.(check (option string)) 170 170 - "like" (Some "like") 171 171 - (Atproto.get_record store ~collection:"app.bsky.feed.like" ~rkey:"p"); 172 172 - let post_keys = 173 173 - fst (Atproto.list_records store ~collection:"app.bsky.feed.post" ()) 174 174 - |> List.map fst 175 175 - in 176 176 - let like_keys = 177 177 - fst (Atproto.list_records store ~collection:"app.bsky.feed.like" ()) 178 178 - |> List.map fst 179 179 - in 180 180 - Alcotest.(check (list string)) "feed.post list only" [ "p" ] post_keys; 181 181 - Alcotest.(check (list string)) "feed.like list only" [ "p" ] like_keys 182 182 - 183 183 - let test_collection_prefix_isolated () = 184 184 - (* "app.bsky.feed.posts" (plural) must not match "app.bsky.feed.post/". *) 185 185 - with_memory_store @@ fun store -> 186 186 - let _ = 187 187 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 188 188 - ~rkey:"a" "1" 189 189 - in 190 190 - let _ = 191 191 - Atproto.put_record store ~author:pub_author 192 192 - ~collection:"app.bsky.feed.posts" ~rkey:"b" "2" 193 193 - in 194 194 - let posts_list, _ = 195 195 - Atproto.list_records store ~collection:"app.bsky.feed.post" () 196 196 - in 197 197 - Alcotest.(check (list string)) 198 198 - "post collection is isolated from posts collection" [ "a" ] 199 199 - (List.map fst posts_list) 200 200 - 201 201 - (* ---------- list_collections / describe_repo ---------- *) 202 202 - 203 203 - let test_list_collections () = 204 204 - with_memory_store @@ fun store -> 205 205 - let _ = 206 206 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 207 207 - ~rkey:"p" "1" 208 208 - in 209 209 - let _ = 210 210 - Atproto.put_record store ~author:pub_author 211 211 - ~collection:"app.bsky.actor.profile" ~rkey:"self" "2" 212 212 - in 213 213 - let _ = 214 214 - Atproto.put_record store ~author:pub_author 215 215 - ~collection:"app.bsky.graph.follow" ~rkey:"f1" "3" 216 216 - in 217 217 - let got = Atproto.list_collections store |> List.sort String.compare in 218 218 - Alcotest.(check (list string)) 219 219 - "distinct collections" 220 220 - [ "app.bsky.actor.profile"; "app.bsky.feed.post"; "app.bsky.graph.follow" ] 221 221 - got 222 222 - 223 223 - let test_describe_repo_shape () = 224 224 - with_memory_store @@ fun store -> 225 225 - let _ = 226 226 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 227 227 - ~rkey:"p" "1" 228 228 - in 229 229 - let info = Atproto.describe_repo store ~did:test_did in 230 230 - Alcotest.(check string) "did" test_did info.did; 231 231 - Alcotest.(check (list string)) 232 232 - "collections" [ "app.bsky.feed.post" ] info.collections 233 233 - 234 234 - let test_describe_repo_empty () = 235 235 - with_memory_store @@ fun store -> 236 236 - let info = Atproto.describe_repo store ~did:test_did in 237 237 - Alcotest.(check string) "did present" test_did info.did; 238 238 - Alcotest.(check int) "no collections yet" 0 (List.length info.collections) 239 239 - 240 240 - (* ---------- Wire compatibility with Pds.* ---------- *) 241 241 - 242 242 - let with_pds_backed_store f = 243 243 - Eio_main.run @@ fun env -> 244 244 - let cwd = Eio.Stdenv.cwd env in 245 245 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_atproto") in 246 246 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 247 247 - let name = Fmt.str "repo_%d" (Random.int 1_000_000) in 248 248 - let path = Eio.Path.(tmp_dir / name) in 249 249 - Fun.protect 250 250 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 251 251 - (fun () -> 252 252 - Eio.Switch.run @@ fun sw -> 253 253 - let did = Atp.Did.of_string_exn test_did in 254 254 - let pds = Pds.v ~sw path ~did in 255 255 - let store = Atproto.of_pds pds in 256 256 - f pds store) 257 257 - 258 258 - let test_atproto_writes_readable_pds () = 259 259 - with_pds_backed_store @@ fun pds store -> 260 260 - let _ = 261 261 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 262 262 - ~rkey:"p1" "{\"text\":\"via atproto\"}" 263 263 - in 264 264 - let _ = 265 265 - Atproto.put_record store ~author:pub_author ~collection:"app.bsky.feed.post" 266 266 - ~rkey:"p2" "{\"text\":\"via atproto 2\"}" 267 267 - in 268 268 - (* Read via Pds.find — native ATProto primitives *) 269 269 - let v1 = Pds.find pds ~collection:"app.bsky.feed.post" ~rkey:"p1" in 270 270 - Alcotest.(check (option string)) 271 271 - "Pds.find sees atproto writes" (Some "{\"text\":\"via atproto\"}") v1; 272 272 - let rkeys = 273 273 - Pds.list pds ~collection:"app.bsky.feed.post" 274 274 - |> List.map fst |> List.sort String.compare 275 275 - in 276 276 - Alcotest.(check (list string)) 277 277 - "Pds.list sees all records" [ "p1"; "p2" ] rkeys 278 278 - 279 279 - let test_pds_writes_readable_atproto () = 280 280 - with_pds_backed_store @@ fun pds store -> 281 281 - let data = 282 282 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "from-pds") 283 283 - in 284 284 - Pds.put pds ~collection:"c" ~rkey:"k" data; 285 285 - Alcotest.(check (option string)) 286 286 - "atproto reads pds-written record" (Some data) 287 287 - (Atproto.get_record store ~collection:"c" ~rkey:"k") 288 288 - 289 289 - let raw_record s = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String s) 290 290 - 291 291 - let test_interleaved_atproto_pds_writes () = 292 292 - with_pds_backed_store @@ fun pds store -> 293 293 - (* Three writes alternating between atproto's high-level API and the 294 294 - low-level Pds.put. Both surfaces must converge on the same MST so 295 295 - each can read what the other wrote. *) 296 296 - let _ = 297 297 - Atproto.put_record store ~author:pub_author ~collection:"col" ~rkey:"a" 298 298 - "via-atproto" 299 299 - in 300 300 - Pds.put pds ~collection:"col" ~rkey:"b" (raw_record "via-pds"); 301 301 - let _ = 302 302 - Atproto.put_record store ~author:pub_author ~collection:"col" ~rkey:"c" 303 303 - "via-atproto-2" 304 304 - in 305 305 - Alcotest.(check (option string)) 306 306 - "atproto sees a" (Some "via-atproto") 307 307 - (Atproto.get_record store ~collection:"col" ~rkey:"a"); 308 308 - Alcotest.(check (option string)) 309 309 - "atproto sees b" 310 310 - (Some (raw_record "via-pds")) 311 311 - (Atproto.get_record store ~collection:"col" ~rkey:"b"); 312 312 - Alcotest.(check (option string)) 313 313 - "atproto sees c" (Some "via-atproto-2") 314 314 - (Atproto.get_record store ~collection:"col" ~rkey:"c"); 315 315 - Alcotest.(check (option string)) 316 316 - "pds sees a" (Some "via-atproto") 317 317 - (Pds.find pds ~collection:"col" ~rkey:"a"); 318 318 - Alcotest.(check (option string)) 319 319 - "pds sees b" 320 320 - (Some (raw_record "via-pds")) 321 321 - (Pds.find pds ~collection:"col" ~rkey:"b"); 322 322 - Alcotest.(check (option string)) 323 323 - "pds sees c" (Some "via-atproto-2") 324 324 - (Pds.find pds ~collection:"col" ~rkey:"c") 325 325 - 326 326 - let test_atproto_delete_visible_pds () = 327 327 - with_pds_backed_store @@ fun pds store -> 328 328 - let _ = 329 329 - Atproto.put_record store ~author:pub_author ~collection:"c" ~rkey:"k" "v" 330 330 - in 331 331 - Alcotest.(check bool) 332 332 - "pds sees pre-delete" true 333 333 - (Option.is_some (Pds.find pds ~collection:"c" ~rkey:"k")); 334 334 - let _ = 335 335 - Atproto.delete_record store ~author:pub_author ~collection:"c" ~rkey:"k" () 336 336 - in 337 337 - Alcotest.(check (option string)) 338 338 - "pds sees post-delete" None 339 339 - (Pds.find pds ~collection:"c" ~rkey:"k") 340 340 - 341 341 - let suite = 342 342 - ( "atproto", 343 343 - [ 344 344 - Alcotest.test_case "put then get" `Quick test_put_get_record; 345 345 - Alcotest.test_case "get non-existent" `Quick test_get_nonexistent; 346 346 - Alcotest.test_case "put overwrites" `Quick test_put_overwrites; 347 347 - Alcotest.test_case "delete record" `Quick test_delete_record; 348 348 - Alcotest.test_case "delete nonexistent is no-op" `Quick 349 349 - test_delete_nonexistent_is_noop; 350 350 - Alcotest.test_case "list records sorted" `Quick test_list_records_sorted; 351 351 - Alcotest.test_case "list records limit" `Quick test_list_records_limit; 352 352 - Alcotest.test_case "list records cursor pagination" `Quick 353 353 - test_list_records_cursor_pagination; 354 354 - Alcotest.test_case "list empty collection" `Quick 355 355 - test_list_records_empty_collection; 356 356 - Alcotest.test_case "collections isolated" `Quick test_collections_isolated; 357 357 - Alcotest.test_case "collection prefix does not leak" `Quick 358 358 - test_collection_prefix_isolated; 359 359 - Alcotest.test_case "list collections" `Quick test_list_collections; 360 360 - Alcotest.test_case "describe repo shape" `Quick test_describe_repo_shape; 361 361 - Alcotest.test_case "describe repo empty" `Quick test_describe_repo_empty; 362 362 - Alcotest.test_case "atproto writes readable by pds" `Quick 363 363 - test_atproto_writes_readable_pds; 364 364 - Alcotest.test_case "pds writes readable by atproto" `Quick 365 365 - test_pds_writes_readable_atproto; 366 366 - Alcotest.test_case "interleaved atproto + pds writes" `Quick 367 367 - test_interleaved_atproto_pds_writes; 368 368 - Alcotest.test_case "atproto delete visible to pds" `Quick 369 369 - test_atproto_delete_visible_pds; 370 370 - ] )

-2

test/test_atproto.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** [suite] is the alcotest test suite for [test_atproto]. *)

-156

test/test_atproto_ext.ml

reviewed

··· 1 1 - (** ATProto backend-specific extension tests. 2 2 - 3 3 - These tests exercise operations that only make sense on an ATProto store. 4 4 - The phantom type [`Atproto] ensures these functions cannot be called on a 5 5 - Git store — the wrong call doesn't typecheck. *) 6 6 - 7 7 - let author = "tester" 8 8 - let with_memory f = f (Irmin_atproto.memory ()) 9 9 - 10 10 - let cleanup_path path = 11 11 - try Helpers.rm_rf path with Eio.Io _ | Sys_error _ -> () 12 12 - 13 13 - let with_pds_path ~sw path f = 14 14 - Fun.protect 15 15 - ~finally:(fun () -> cleanup_path path) 16 16 - (fun () -> f (Irmin_atproto.disk ~sw path)) 17 17 - 18 18 - let with_pds f = 19 19 - Eio_main.run @@ fun env -> 20 20 - Eio.Switch.run @@ fun sw -> 21 21 - let cwd = Eio.Stdenv.cwd env in 22 22 - let name = Fmt.str "irmin-test-atp-ext-%d" (Random.int 1_000_000) in 23 23 - let path = Eio.Path.(cwd / "_build" / name) in 24 24 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path with Eio.Io _ -> ()); 25 25 - with_pds_path ~sw path f 26 26 - 27 27 - (* Run on both memory and PDS backends. *) 28 28 - let with_each f = 29 29 - with_memory f; 30 30 - with_pds f 31 31 - 32 32 - (* {1 Record-level operations} *) 33 33 - 34 34 - let test_put_get_record () = 35 35 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 36 36 - let _ = 37 37 - Irmin_atproto.put_record s ~author ~collection:"app.bsky.feed.post" 38 38 - ~rkey:"post1" "{\"text\":\"hi\"}" 39 39 - in 40 40 - let got = 41 41 - Irmin_atproto.get_record s ~collection:"app.bsky.feed.post" ~rkey:"post1" 42 42 - in 43 43 - Alcotest.(check (option string)) 44 44 - "get after put" (Some "{\"text\":\"hi\"}") got 45 45 - 46 46 - let test_delete_record () = 47 47 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 48 48 - let _ = 49 49 - Irmin_atproto.put_record s ~author ~collection:"c" ~rkey:"keep" "v1" 50 50 - in 51 51 - let _ = 52 52 - Irmin_atproto.put_record s ~author ~collection:"c" ~rkey:"drop" "v2" 53 53 - in 54 54 - let _ = 55 55 - Irmin_atproto.delete_record s ~author ~collection:"c" ~rkey:"drop" () 56 56 - in 57 57 - Alcotest.(check (option string)) 58 58 - "kept" (Some "v1") 59 59 - (Irmin_atproto.get_record s ~collection:"c" ~rkey:"keep"); 60 60 - Alcotest.(check (option string)) 61 61 - "deleted" None 62 62 - (Irmin_atproto.get_record s ~collection:"c" ~rkey:"drop") 63 63 - 64 64 - let test_list_records () = 65 65 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 66 66 - List.iter 67 67 - (fun rkey -> 68 68 - let _ = 69 69 - Irmin_atproto.put_record s ~author ~collection:"app.bsky.feed.post" 70 70 - ~rkey ("v-" ^ rkey) 71 71 - in 72 72 - ()) 73 73 - [ "c"; "a"; "b" ]; 74 74 - let page, _ = 75 75 - Irmin_atproto.list_records s ~collection:"app.bsky.feed.post" () 76 76 - in 77 77 - let rkeys = List.map fst page in 78 78 - Alcotest.(check (list string)) "sorted" [ "a"; "b"; "c" ] rkeys 79 79 - 80 80 - let test_list_collections () = 81 81 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 82 82 - let _ = 83 83 - Irmin_atproto.put_record s ~author ~collection:"app.bsky.feed.post" 84 84 - ~rkey:"k" "v" 85 85 - in 86 86 - let _ = 87 87 - Irmin_atproto.put_record s ~author ~collection:"app.bsky.graph.follow" 88 88 - ~rkey:"k" "v" 89 89 - in 90 90 - let cols = Irmin_atproto.list_collections s in 91 91 - Alcotest.(check (list string)) 92 92 - "two collections" 93 93 - [ "app.bsky.feed.post"; "app.bsky.graph.follow" ] 94 94 - cols 95 95 - 96 96 - (* {1 Mixed generic + extension operations} 97 97 - 98 98 - The same store is used through both the generic Irmin API and the 99 99 - ATProto-specific extensions. Both surfaces must see the same data. *) 100 100 - 101 101 - let test_generic_reads_extension_writes () = 102 102 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 103 103 - (* Write via ATProto extension *) 104 104 - let _ = 105 105 - Irmin_atproto.put_record s ~author ~collection:"col" ~rkey:"a" "via-ext" 106 106 - in 107 107 - (* Read via generic API *) 108 108 - match Store.checkout s ~branch:"main" with 109 109 - | None -> Alcotest.fail "checkout returned None" 110 110 - | Some tree -> 111 111 - Alcotest.(check (option string)) 112 112 - "generic sees extension write" (Some "via-ext") 113 113 - (Tree.find tree [ "col"; "a" ]) 114 114 - 115 115 - let test_extension_reads_generic_writes () = 116 116 - with_each @@ fun (s : [ `Atproto ] Store.t) -> 117 117 - (* Write via generic API *) 118 118 - let tree = Tree.add Tree.empty [ "col"; "b" ] "via-generic" in 119 119 - let h = Store.commit s ~tree ~parents:[] ~message:"gen" ~author in 120 120 - Store.set_head s ~branch:"main" h; 121 121 - (* Read via ATProto extension *) 122 122 - Alcotest.(check (option string)) 123 123 - "extension sees generic write" (Some "via-generic") 124 124 - (Irmin_atproto.get_record s ~collection:"col" ~rkey:"b") 125 125 - 126 126 - (* {1 Wire compatibility with PDS} 127 127 - 128 128 - An ATProto store backed by PDS must be readable through the 129 129 - low-level Pds.find / Pds.list primitives too. *) 130 130 - 131 131 - let test_pds_wire_compat () = 132 132 - with_pds @@ fun (s : [ `Atproto ] Store.t) -> 133 133 - let _ = 134 134 - Irmin_atproto.put_record s ~author ~collection:"col" ~rkey:"a" 135 135 - "{\"text\":\"a\"}" 136 136 - in 137 137 - let pds = Irmin_atproto.pds_of s in 138 138 - Alcotest.(check (option string)) 139 139 - "Pds.find sees Irmin write" (Some "{\"text\":\"a\"}") 140 140 - (Pds.find pds ~collection:"col" ~rkey:"a") 141 141 - 142 142 - (* {1 Suite} *) 143 143 - 144 144 - let suite = 145 145 - ( "atproto_ext", 146 146 - [ 147 147 - Alcotest.test_case "put/get record" `Quick test_put_get_record; 148 148 - Alcotest.test_case "delete record" `Quick test_delete_record; 149 149 - Alcotest.test_case "list records sorted" `Quick test_list_records; 150 150 - Alcotest.test_case "list collections" `Quick test_list_collections; 151 151 - Alcotest.test_case "generic reads extension writes" `Quick 152 152 - test_generic_reads_extension_writes; 153 153 - Alcotest.test_case "extension reads generic writes" `Quick 154 154 - test_extension_reads_generic_writes; 155 155 - Alcotest.test_case "PDS wire compat" `Quick test_pds_wire_compat; 156 156 - ] )

-2

test/test_atproto_ext.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** [suite] is the alcotest test suite for [test_atproto_ext]. *)

-389

test/test_atproto_tree.ml

reviewed

··· 1 1 - (** Tree-level tests for [Irmin.Atproto]. 2 2 - 3 3 - The ATProto adapter exposes two layers: a tree-level API with pure [tree] 4 4 - values and explicit commits, and a record-level API with auto-commit against 5 5 - [main] (covered in [test_atproto.ml]). This suite exercises the former: tree 6 6 - mutation, sorted iteration, prefix scans, hash determinism, and the 7 7 - wire-format contract with [Pds.find] / [Pds.list]. *) 8 8 - 9 9 - open Irmin 10 10 - 11 11 - let test_did = Atp.Did.of_string_exn "did:web:test.example.com" 12 12 - 13 13 - let with_memory_store f = 14 14 - let store = Atproto.memory () in 15 15 - f store 16 16 - 17 17 - let with_pds_store f = 18 18 - Eio_main.run @@ fun env -> 19 19 - let cwd = Eio.Stdenv.cwd env in 20 20 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_atproto_tree") in 21 21 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 22 22 - let name = Fmt.str "repo_%d" (Random.int 1_000_000) in 23 23 - let path = Eio.Path.(tmp_dir / name) in 24 24 - Fun.protect 25 25 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 26 26 - (fun () -> 27 27 - Eio.Switch.run @@ fun sw -> 28 28 - let pds = Pds.v ~sw path ~did:test_did in 29 29 - let store = Atproto.of_pds pds in 30 30 - f store) 31 31 - 32 32 - let post k = ("app.bsky.feed.post", k) 33 33 - let profile k = ("app.bsky.actor.profile", k) 34 34 - 35 35 - (* ---------- Basic API shape ---------- *) 36 36 - 37 37 - let test_empty_store () = 38 38 - with_memory_store @@ fun _store -> 39 39 - let tree = Atproto.empty () in 40 40 - Alcotest.(check (option string)) 41 41 - "find in empty returns None" None 42 42 - (Atproto.find tree (post "whatever")); 43 43 - Alcotest.(check int) 44 44 - "empty leaves is 0 entries" 0 45 45 - (Seq.length (Atproto.leaves tree)) 46 46 - 47 47 - let test_add_then_find () = 48 48 - with_memory_store @@ fun _store -> 49 49 - let t = Atproto.empty () in 50 50 - let t = Atproto.add t (post "post1") "content-1" in 51 51 - Alcotest.(check (option string)) 52 52 - "find added" (Some "content-1") 53 53 - (Atproto.find t (post "post1")); 54 54 - Alcotest.(check (option string)) 55 55 - "find non-existent" None 56 56 - (Atproto.find t (post "post2")) 57 57 - 58 58 - let test_add_overwrites () = 59 59 - with_memory_store @@ fun _store -> 60 60 - let t = Atproto.empty () in 61 61 - let t = Atproto.add t (post "p") "v1" in 62 62 - let t = Atproto.add t (post "p") "v2" in 63 63 - Alcotest.(check (option string)) 64 64 - "second add wins" (Some "v2") 65 65 - (Atproto.find t (post "p")) 66 66 - 67 67 - let test_remove () = 68 68 - with_memory_store @@ fun _store -> 69 69 - let t = Atproto.empty () in 70 70 - let t = Atproto.add t (post "k1") "v1" in 71 71 - let t = Atproto.add t (post "k2") "v2" in 72 72 - let t = Atproto.remove t (post "k1") in 73 73 - Alcotest.(check (option string)) 74 74 - "removed gone" None 75 75 - (Atproto.find t (post "k1")); 76 76 - Alcotest.(check (option string)) 77 77 - "sibling still there" (Some "v2") 78 78 - (Atproto.find t (post "k2")); 79 79 - Alcotest.(check int) "one leaf remains" 1 (Seq.length (Atproto.leaves t)) 80 80 - 81 81 - let test_remove_nonexistent () = 82 82 - with_memory_store @@ fun _store -> 83 83 - let t = Atproto.empty () in 84 84 - let t = Atproto.add t (post "a") "v" in 85 85 - let t' = Atproto.remove t (post "ghost") in 86 86 - Alcotest.(check (option string)) 87 87 - "untouched" (Some "v") 88 88 - (Atproto.find t' (post "a")); 89 89 - Alcotest.(check int) "still 1 leaf" 1 (Seq.length (Atproto.leaves t')) 90 90 - 91 91 - (* ---------- leaves: ordering and completeness ---------- *) 92 92 - 93 93 - let test_leaves_sorted () = 94 94 - with_memory_store @@ fun _store -> 95 95 - let t = Atproto.empty () in 96 96 - let rkeys = [ "zzz"; "aaa"; "mmm"; "abc"; "xyz" ] in 97 97 - let t = 98 98 - List.fold_left 99 99 - (fun t rkey -> Atproto.add t (post rkey) ("v-" ^ rkey)) 100 100 - t rkeys 101 101 - in 102 102 - let got = 103 103 - Atproto.leaves t |> Seq.map (fun ((_, rkey), _) -> rkey) |> List.of_seq 104 104 - in 105 105 - Alcotest.(check (list string)) 106 106 - "leaves sorted" 107 107 - [ "aaa"; "abc"; "mmm"; "xyz"; "zzz" ] 108 108 - got 109 109 - 110 110 - let test_leaves_many_entries () = 111 111 - with_memory_store @@ fun _store -> 112 112 - let t = Atproto.empty () in 113 113 - let n = 500 in 114 114 - let t = 115 115 - List.init n (fun i -> (post (Fmt.str "k%06d" i), Fmt.str "v%d" i)) 116 116 - |> List.fold_left (fun t (k, v) -> Atproto.add t k v) t 117 117 - in 118 118 - Alcotest.(check int) "all present" n (Seq.length (Atproto.leaves t)); 119 119 - Alcotest.(check (option string)) 120 120 - "first record" (Some "v0") 121 121 - (Atproto.find t (post "k000000")); 122 122 - Alcotest.(check (option string)) 123 123 - "middle record" (Some "v250") 124 124 - (Atproto.find t (post "k000250")); 125 125 - Alcotest.(check (option string)) 126 126 - "last record" (Some "v499") 127 127 - (Atproto.find t (post "k000499")) 128 128 - 129 129 - (* ---------- list: the primitive for listRecords ---------- *) 130 130 - 131 131 - let test_list_basic () = 132 132 - with_memory_store @@ fun _store -> 133 133 - let t = Atproto.empty () in 134 134 - let t = Atproto.add t (post "p1") "v1" in 135 135 - let t = Atproto.add t (post "p2") "v2" in 136 136 - let t = Atproto.add t (post "p3") "v3" in 137 137 - let t = Atproto.add t (profile "self") "me" in 138 138 - let rkeys = 139 139 - Atproto.list t ~collection:"app.bsky.feed.post" 140 140 - |> Seq.map fst |> List.of_seq 141 141 - in 142 142 - Alcotest.(check (list string)) 143 143 - "only feed.post, sorted" [ "p1"; "p2"; "p3" ] rkeys 144 144 - 145 145 - let test_list_values () = 146 146 - with_memory_store @@ fun _store -> 147 147 - let t = Atproto.empty () in 148 148 - let t = Atproto.add t (post "a") "val-a" in 149 149 - let t = Atproto.add t (post "b") "val-b" in 150 150 - let got = Atproto.list t ~collection:"app.bsky.feed.post" |> List.of_seq in 151 151 - Alcotest.(check (list (pair string string))) 152 152 - "rkey,value pairs" 153 153 - [ ("a", "val-a"); ("b", "val-b") ] 154 154 - got 155 155 - 156 156 - let test_list_isolation () = 157 157 - (* "app.bsky.feed.post" scan must not leak into "app.bsky.feed.posts" 158 158 - (plural). That was the guarantee the old String.starts_with code got 159 159 - wrong; the split_key approach avoids it structurally. *) 160 160 - with_memory_store @@ fun _store -> 161 161 - let t = Atproto.empty () in 162 162 - let t = Atproto.add t ("app.bsky.feed.post", "a") "in" in 163 163 - let t = Atproto.add t ("app.bsky.feed.posts", "x") "out" in 164 164 - let got = 165 165 - Atproto.list t ~collection:"app.bsky.feed.post" 166 166 - |> Seq.map fst |> List.of_seq 167 167 - in 168 168 - Alcotest.(check (list string)) "isolated from posts (plural)" [ "a" ] got 169 169 - 170 170 - (* ---------- Hash determinism ---------- *) 171 171 - 172 172 - let test_hash_deterministic () = 173 173 - with_memory_store @@ fun store -> 174 174 - let build () = 175 175 - let t = Atproto.empty () in 176 176 - let t = Atproto.add t (post "p1") "v1" in 177 177 - let t = Atproto.add t (post "p2") "v2" in 178 178 - let t = Atproto.add t (post "p3") "v3" in 179 179 - Atproto.hash t ~store 180 180 - in 181 181 - Alcotest.(check bool) 182 182 - "same content → same hash" true 183 183 - (Irmin.Hash.equal (build ()) (build ())) 184 184 - 185 185 - let test_hash_order_independent () = 186 186 - with_memory_store @@ fun store -> 187 187 - let h_asc = 188 188 - let t = Atproto.empty () in 189 189 - let t = Atproto.add t (post "a") "1" in 190 190 - let t = Atproto.add t (post "b") "2" in 191 191 - let t = Atproto.add t (post "c") "3" in 192 192 - Atproto.hash t ~store 193 193 - in 194 194 - let h_desc = 195 195 - let t = Atproto.empty () in 196 196 - let t = Atproto.add t (post "c") "3" in 197 197 - let t = Atproto.add t (post "b") "2" in 198 198 - let t = Atproto.add t (post "a") "1" in 199 199 - Atproto.hash t ~store 200 200 - in 201 201 - Alcotest.(check bool) 202 202 - "insertion order does not affect hash" true 203 203 - (Irmin.Hash.equal h_asc h_desc) 204 204 - 205 205 - let test_hash_changes_with_content () = 206 206 - with_memory_store @@ fun store -> 207 207 - let h1 = 208 208 - let t = Atproto.empty () in 209 209 - let t = Atproto.add t (post "k") "v1" in 210 210 - Atproto.hash t ~store 211 211 - in 212 212 - let h2 = 213 213 - let t = Atproto.empty () in 214 214 - let t = Atproto.add t (post "k") "v2" in 215 215 - Atproto.hash t ~store 216 216 - in 217 217 - Alcotest.(check bool) 218 218 - "different content → different hash" false (Irmin.Hash.equal h1 h2) 219 219 - 220 220 - (* ---------- Commit + checkout roundtrip ---------- *) 221 221 - 222 222 - let test_commit_checkout () = 223 223 - with_memory_store @@ fun store -> 224 224 - let t = Atproto.empty () in 225 225 - let t = Atproto.add t (post "p1") "hello" in 226 226 - let h = 227 227 - Atproto.commit store ~tree:t ~parents:[] ~message:"init" ~author:"alice" 228 228 - in 229 229 - Atproto.set_head store ~branch:"main" h; 230 230 - match Atproto.checkout store ~branch:"main" with 231 231 - | None -> Alcotest.fail "checkout returned None" 232 232 - | Some t' -> 233 233 - Alcotest.(check (option string)) 234 234 - "round trip" (Some "hello") 235 235 - (Atproto.find t' (post "p1")) 236 236 - 237 237 - (* ---------- Commit metadata survives ---------- *) 238 238 - 239 239 - let test_commit_stores_metadata () = 240 240 - with_memory_store @@ fun store -> 241 241 - let t = Atproto.empty () in 242 242 - let t = Atproto.add t (post "k") "v" in 243 243 - let h = 244 244 - Atproto.commit store ~tree:t ~parents:[] ~message:"first real commit" 245 245 - ~author:"alice" 246 246 - in 247 247 - match Atproto.read_commit store h with 248 248 - | None -> Alcotest.fail "read_commit returned None" 249 249 - | Some c -> 250 250 - Alcotest.(check string) "author" "alice" c.author; 251 251 - Alcotest.(check string) "message" "first real commit" c.message; 252 252 - Alcotest.(check int) "no parents" 0 (List.length c.parents) 253 253 - 254 254 - let test_commit_message_changes_hash () = 255 255 - with_memory_store @@ fun store -> 256 256 - let t = Atproto.empty () in 257 257 - let t = Atproto.add t (post "k") "v" in 258 258 - let h1 = 259 259 - Atproto.commit store ~tree:t ~parents:[] ~message:"msg one" ~author:"a" 260 260 - in 261 261 - let h2 = 262 262 - Atproto.commit store ~tree:t ~parents:[] ~message:"msg two" ~author:"a" 263 263 - in 264 264 - Alcotest.(check bool) 265 265 - "same tree, different message → different hash" false 266 266 - (Irmin.Hash.equal h1 h2) 267 267 - 268 268 - let test_commit_parent_chain () = 269 269 - with_memory_store @@ fun store -> 270 270 - let t = Atproto.empty () in 271 271 - let t = Atproto.add t (post "k") "v1" in 272 272 - let h1 = Atproto.commit store ~tree:t ~parents:[] ~message:"c1" ~author:"a" in 273 273 - Atproto.set_head store ~branch:"main" h1; 274 274 - let t = Atproto.add t (post "k") "v2" in 275 275 - let h2 = 276 276 - Atproto.commit store ~tree:t ~parents:[ h1 ] ~message:"c2" ~author:"a" 277 277 - in 278 278 - Atproto.set_head store ~branch:"main" h2; 279 279 - let t = Atproto.add t (post "k") "v3" in 280 280 - let h3 = 281 281 - Atproto.commit store ~tree:t ~parents:[ h2 ] ~message:"c3" ~author:"a" 282 282 - in 283 283 - Atproto.set_head store ~branch:"main" h3; 284 284 - match Atproto.read_commit store h3 with 285 285 - | None -> Alcotest.fail "no h3" 286 286 - | Some c3 -> ( 287 287 - Alcotest.(check (list string)) 288 288 - "h3 parent is h2" 289 289 - [ Irmin.Hash.to_hex h2 ] 290 290 - (List.map Irmin.Hash.to_hex c3.parents); 291 291 - match Atproto.read_commit store h2 with 292 292 - | None -> Alcotest.fail "no h2" 293 293 - | Some c2 -> 294 294 - Alcotest.(check (list string)) 295 295 - "h2 parent is h1" 296 296 - [ Irmin.Hash.to_hex h1 ] 297 297 - (List.map Irmin.Hash.to_hex c2.parents)) 298 298 - 299 299 - (* ---------- PDS persistence across sessions ---------- *) 300 300 - 301 301 - let persist_session_write path = 302 302 - Eio.Switch.run @@ fun sw -> 303 303 - let pds = Pds.v ~sw path ~did:test_did in 304 304 - let store = Atproto.of_pds pds in 305 305 - let t = Atproto.empty () in 306 306 - let t = Atproto.add t (post "persist") "value" in 307 307 - let h = Atproto.commit store ~tree:t ~parents:[] ~message:"w" ~author:"a" in 308 308 - Atproto.set_head store ~branch:"main" h; 309 309 - Pds.close pds 310 310 - 311 311 - let persist_session_read path = 312 312 - Eio.Switch.run @@ fun sw -> 313 313 - let pds = Pds.open_ ~sw path in 314 314 - let store = Atproto.of_pds pds in 315 315 - match Atproto.checkout store ~branch:"main" with 316 316 - | None -> Alcotest.fail "session 2 checkout None" 317 317 - | Some t -> 318 318 - Alcotest.(check (option string)) 319 319 - "read after reopen" (Some "value") 320 320 - (Atproto.find t (post "persist")); 321 321 - Pds.close pds 322 322 - 323 323 - let test_commit_survives_reopen_pds () = 324 324 - Eio_main.run @@ fun env -> 325 325 - let cwd = Eio.Stdenv.cwd env in 326 326 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_atproto_tree") in 327 327 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 328 328 - let name = Fmt.str "persist_%d" (Random.int 1_000_000) in 329 329 - let path = Eio.Path.(tmp_dir / name) in 330 330 - Fun.protect 331 331 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 332 332 - (fun () -> 333 333 - persist_session_write path; 334 334 - persist_session_read path) 335 335 - 336 336 - (* ---------- Wire compatibility with the raw Atp.Mst + Pds layer ----- *) 337 337 - 338 338 - let test_wire_compat_with_pds () = 339 339 - (* An [Irmin.Atproto] tree committed into a PDS must be readable 340 340 - through the native [Pds.find] / [Pds.list] primitives without any 341 341 - translation layer. *) 342 342 - with_pds_store @@ fun store -> 343 343 - let t = Atproto.empty () in 344 344 - let t = Atproto.add t (post "p1") "{\"text\":\"a\"}" in 345 345 - let t = Atproto.add t (post "p2") "{\"text\":\"b\"}" in 346 346 - let t = Atproto.add t (profile "self") "{\"name\":\"x\"}" in 347 347 - let h = Atproto.commit store ~tree:t ~parents:[] ~message:"w" ~author:"a" in 348 348 - Atproto.set_head store ~branch:"main" h; 349 349 - let pds = Atproto.pds_of store in 350 350 - let rkeys = 351 351 - Pds.list pds ~collection:"app.bsky.feed.post" 352 352 - |> List.map fst |> List.sort String.compare 353 353 - in 354 354 - Alcotest.(check (list string)) 355 355 - "Pds.list sees feed.post rkeys" [ "p1"; "p2" ] rkeys; 356 356 - Alcotest.(check bool) 357 357 - "Pds.find sees profile" true 358 358 - (Option.is_some 359 359 - (Pds.find pds ~collection:"app.bsky.actor.profile" ~rkey:"self")) 360 360 - 361 361 - let suite = 362 362 - ( "atproto_tree", 363 363 - [ 364 364 - Alcotest.test_case "empty store" `Quick test_empty_store; 365 365 - Alcotest.test_case "add then find" `Quick test_add_then_find; 366 366 - Alcotest.test_case "add overwrites" `Quick test_add_overwrites; 367 367 - Alcotest.test_case "remove" `Quick test_remove; 368 368 - Alcotest.test_case "remove non-existent" `Quick test_remove_nonexistent; 369 369 - Alcotest.test_case "leaves sorted" `Quick test_leaves_sorted; 370 370 - Alcotest.test_case "leaves 500 entries" `Quick test_leaves_many_entries; 371 371 - Alcotest.test_case "prefix scan basic" `Quick test_list_basic; 372 372 - Alcotest.test_case "prefix scan values" `Quick test_list_values; 373 373 - Alcotest.test_case "prefix scan isolation" `Quick test_list_isolation; 374 374 - Alcotest.test_case "hash deterministic" `Quick test_hash_deterministic; 375 375 - Alcotest.test_case "hash order-independent" `Quick 376 376 - test_hash_order_independent; 377 377 - Alcotest.test_case "hash changes with content" `Quick 378 378 - test_hash_changes_with_content; 379 379 - Alcotest.test_case "commit then checkout" `Quick test_commit_checkout; 380 380 - Alcotest.test_case "commit stores metadata" `Quick 381 381 - test_commit_stores_metadata; 382 382 - Alcotest.test_case "commit message changes hash" `Quick 383 383 - test_commit_message_changes_hash; 384 384 - Alcotest.test_case "commit parent chain" `Quick test_commit_parent_chain; 385 385 - Alcotest.test_case "PDS persistence across sessions" `Quick 386 386 - test_commit_survives_reopen_pds; 387 387 - Alcotest.test_case "wire-compat with Pds.*" `Quick 388 388 - test_wire_compat_with_pds; 389 389 - ] )

-2

test/test_atproto_tree.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** [suite] is the alcotest test suite for [test_atproto_tree]. *)

-161

test/test_backend.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let with_temp_dir f = 5 5 - Eio_main.run @@ fun env -> 6 6 - let cwd = Eio.Stdenv.cwd env in 7 7 - Eio.Switch.run @@ fun sw -> 8 8 - let tmp_name = Fmt.str "irmin-test-%d" (Random.int 100000) in 9 9 - let tmp_path = Eio.Path.(cwd / tmp_name) in 10 10 - Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path; 11 11 - Fun.protect 12 12 - ~finally:(fun () -> Test_helpers.rm_rf tmp_path) 13 13 - (fun () -> f ~sw tmp_path) 14 14 - 15 15 - let test_memory_backend () = 16 16 - let backend = Backend.Memory.sha1 () in 17 17 - let data = "test content" in 18 18 - let hash = Hash.sha1 data in 19 19 - Backend.write backend hash data; 20 20 - Alcotest.(check (option string)) 21 21 - "read back" (Some data) 22 22 - (Backend.read backend hash) 23 23 - 24 24 - let test_backend_refs () = 25 25 - let backend = Backend.Memory.sha1 () in 26 26 - let data = "content" in 27 27 - let hash = Hash.sha1 data in 28 28 - Backend.write backend hash data; 29 29 - Backend.set_ref backend "refs/heads/main" hash; 30 30 - Alcotest.(check bool) 31 31 - "ref exists" true 32 32 - (Option.is_some (Backend.get_ref backend "refs/heads/main")); 33 33 - match Backend.get_ref backend "refs/heads/main" with 34 34 - | Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h) 35 35 - | None -> Alcotest.fail "ref not found" 36 36 - 37 37 - let test_backend_test_and_set () = 38 38 - let backend = Backend.Memory.sha1 () in 39 39 - let h1 = Hash.sha1 "content1" in 40 40 - let h2 = Hash.sha1 "content2" in 41 41 - Backend.write backend h1 "content1"; 42 42 - Backend.write backend h2 "content2"; 43 43 - Backend.set_ref backend "ref" h1; 44 44 - let result = 45 45 - Backend.test_and_set_ref backend "ref" ~test:(Some h2) ~set:(Some h2) 46 46 - in 47 47 - Alcotest.(check bool) "wrong test fails" false result; 48 48 - let result = 49 49 - Backend.test_and_set_ref backend "ref" ~test:(Some h1) ~set:(Some h2) 50 50 - in 51 51 - Alcotest.(check bool) "correct test succeeds" true result 52 52 - 53 53 - let test_disk_backend () = 54 54 - with_temp_dir @@ fun ~sw tmp_path -> 55 55 - let backend = Backend.Disk.sha1 ~sw tmp_path in 56 56 - let data = "test content" in 57 57 - let hash = Hash.sha1 data in 58 58 - Backend.write backend hash data; 59 59 - Alcotest.(check (option string)) 60 60 - "read back" (Some data) 61 61 - (Backend.read backend hash); 62 62 - Backend.close backend 63 63 - 64 64 - let test_disk_backend_persistence () = 65 65 - Eio_main.run @@ fun env -> 66 66 - let cwd = Eio.Stdenv.cwd env in 67 67 - let tmp_name = Fmt.str "irmin-test-%d" (Random.int 100000) in 68 68 - let tmp_path = Eio.Path.(cwd / tmp_name) in 69 69 - let data = "persistent content" in 70 70 - let hash = Hash.sha1 data in 71 71 - Eio.Switch.run (fun sw -> 72 72 - let backend = Backend.Disk.sha1 ~sw tmp_path in 73 73 - Backend.write backend hash data; 74 74 - Backend.set_ref backend "refs/heads/main" hash; 75 75 - Backend.flush backend; 76 76 - Backend.close backend); 77 77 - Eio.Switch.run (fun sw -> 78 78 - let backend = Backend.Disk.sha1 ~sw tmp_path in 79 79 - Alcotest.(check (option string)) 80 80 - "read after reopen" (Some data) 81 81 - (Backend.read backend hash); 82 82 - Alcotest.(check bool) 83 83 - "ref persisted" true 84 84 - (Option.is_some (Backend.get_ref backend "refs/heads/main")); 85 85 - Backend.close backend); 86 86 - Test_helpers.rm_rf tmp_path 87 87 - 88 88 - let test_disk_backend_refs () = 89 89 - with_temp_dir @@ fun ~sw tmp_path -> 90 90 - let backend = Backend.Disk.sha1 ~sw tmp_path in 91 91 - let data = "content" in 92 92 - let hash = Hash.sha1 data in 93 93 - Backend.write backend hash data; 94 94 - Backend.set_ref backend "refs/heads/main" hash; 95 95 - Alcotest.(check bool) 96 96 - "ref exists" true 97 97 - (Option.is_some (Backend.get_ref backend "refs/heads/main")); 98 98 - (match Backend.get_ref backend "refs/heads/main" with 99 99 - | Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h) 100 100 - | None -> Alcotest.fail "ref not found"); 101 101 - Backend.close backend 102 102 - 103 103 - let test_disk_backend_write_batch () = 104 104 - with_temp_dir @@ fun ~sw tmp_path -> 105 105 - let backend = Backend.Disk.sha1 ~sw tmp_path in 106 106 - let objects = 107 107 - [ 108 108 - (Hash.sha1 "data1", "data1"); 109 109 - (Hash.sha1 "data2", "data2"); 110 110 - (Hash.sha1 "data3", "data3"); 111 111 - ] 112 112 - in 113 113 - Backend.write_batch backend objects; 114 114 - List.iter 115 115 - (fun (hash, data) -> 116 116 - Alcotest.(check (option string)) 117 117 - "batch item" (Some data) 118 118 - (Backend.read backend hash)) 119 119 - objects; 120 120 - Backend.close backend 121 121 - 122 122 - let test_disk_backend_wal_recovery () = 123 123 - Eio_main.run @@ fun env -> 124 124 - let cwd = Eio.Stdenv.cwd env in 125 125 - let tmp_name = Fmt.str "irmin-wal-test-%d" (Random.int 100000) in 126 126 - let tmp_path = Eio.Path.(cwd / tmp_name) in 127 127 - let data = "wal recovery content" in 128 128 - let hash = Hash.sha1 data in 129 129 - Eio.Switch.run (fun sw -> 130 130 - let backend = Backend.Disk.sha1 ~sw tmp_path in 131 131 - Backend.write backend hash data; 132 132 - Alcotest.(check (option string)) 133 133 - "readable before crash" (Some data) 134 134 - (Backend.read backend hash); 135 135 - Backend.close backend); 136 136 - Eio.Switch.run (fun sw -> 137 137 - let backend = Backend.Disk.sha1 ~sw tmp_path in 138 138 - Alcotest.(check (option string)) 139 139 - "recovered from WAL" (Some data) 140 140 - (Backend.read backend hash); 141 141 - Alcotest.(check bool) 142 142 - "exists after recovery" true 143 143 - (Backend.exists backend hash); 144 144 - Backend.close backend); 145 145 - Test_helpers.rm_rf tmp_path 146 146 - 147 147 - let suite = 148 148 - ( "backend", 149 149 - [ 150 150 - Alcotest.test_case "memory backend" `Quick test_memory_backend; 151 151 - Alcotest.test_case "backend refs" `Quick test_backend_refs; 152 152 - Alcotest.test_case "backend test_and_set" `Quick test_backend_test_and_set; 153 153 - Alcotest.test_case "disk backend" `Quick test_disk_backend; 154 154 - Alcotest.test_case "disk backend persistence" `Quick 155 155 - test_disk_backend_persistence; 156 156 - Alcotest.test_case "disk backend refs" `Quick test_disk_backend_refs; 157 157 - Alcotest.test_case "disk backend write_batch" `Quick 158 158 - test_disk_backend_write_batch; 159 159 - Alcotest.test_case "disk backend WAL recovery" `Quick 160 160 - test_disk_backend_wal_recovery; 161 161 - ] )

-2

test/test_backend.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-32

test/test_codec.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let test_git_tree_format () = 5 5 - let node = Codec.Git.empty_node in 6 6 - Alcotest.(check bool) "empty is empty" true (Codec.Git.is_empty node); 7 7 - let h = Hash.sha1 "content" in 8 8 - let node = Codec.Git.add node "file.txt" (`Contents h) in 9 9 - Alcotest.(check bool) "not empty after add" false (Codec.Git.is_empty node); 10 10 - match Codec.Git.find node "file.txt" with 11 11 - | Some (`Contents h') -> 12 12 - Alcotest.(check bool) "find matches" true (Hash.equal h h') 13 13 - | _ -> Alcotest.fail "entry not found" 14 14 - 15 15 - let test_git_tree_serialization () = 16 16 - let h = Hash.sha1 "content" in 17 17 - let node = Codec.Git.empty_node in 18 18 - let node = Codec.Git.add node "file.txt" (`Contents h) in 19 19 - let bytes = Codec.Git.bytes_of_node node in 20 20 - match Codec.Git.node_of_bytes bytes with 21 21 - | Ok node' -> 22 22 - let entries = Codec.Git.list node' in 23 23 - Alcotest.(check int) "one entry" 1 (List.length entries) 24 24 - | Error (`Msg msg) -> Alcotest.fail msg 25 25 - 26 26 - let suite = 27 27 - ( "codec", 28 28 - [ 29 29 - Alcotest.test_case "git tree format" `Quick test_git_tree_format; 30 30 - Alcotest.test_case "git tree serialization" `Quick 31 31 - test_git_tree_serialization; 32 32 - ] )

-2

test/test_codec.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-72

test/test_commit.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let test_commit_fields () = 5 5 - let tree_hash = Hash.sha1 "tree content" in 6 6 - let c = 7 7 - Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" 8 8 - ~message:"Initial commit" () 9 9 - in 10 10 - Alcotest.(check string) "author" "Alice" (Commit.Git.author c); 11 11 - Alcotest.(check string) "message" "Initial commit" (Commit.Git.message c); 12 12 - Alcotest.(check (list (Alcotest.testable Hash.pp Hash.equal))) 13 13 - "no parents" [] (Commit.Git.parents c); 14 14 - Alcotest.(check bool) 15 15 - "tree matches" true 16 16 - (Hash.equal tree_hash (Commit.Git.tree c)) 17 17 - 18 18 - let test_commit_committer () = 19 19 - let tree_hash = Hash.sha1 "tree" in 20 20 - let c = 21 21 - Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~committer:"Bob" 22 22 - ~message:"test" () 23 23 - in 24 24 - Alcotest.(check string) "committer" "Bob" (Commit.Git.committer c) 25 25 - 26 26 - let test_commit_parents () = 27 27 - let tree_hash = Hash.sha1 "tree" in 28 28 - let parent1 = Hash.sha1 "parent1" in 29 29 - let parent2 = Hash.sha1 "parent2" in 30 30 - let c = 31 31 - Commit.Git.v ~tree:tree_hash ~parents:[ parent1; parent2 ] ~author:"test" 32 32 - ~message:"merge" () 33 33 - in 34 34 - Alcotest.(check int) "two parents" 2 (List.length (Commit.Git.parents c)) 35 35 - 36 36 - let test_commit_roundtrip () = 37 37 - let tree_hash = Hash.sha1 "tree content" in 38 38 - let c = 39 39 - Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" 40 40 - ~message:"test commit" () 41 41 - in 42 42 - let bytes = Commit.Git.to_bytes c in 43 43 - match Commit.Git.of_bytes bytes with 44 44 - | Ok c' -> 45 45 - Alcotest.(check string) "author roundtrip" "Alice" (Commit.Git.author c'); 46 46 - Alcotest.(check string) 47 47 - "message roundtrip" "test commit" (Commit.Git.message c') 48 48 - | Error (`Msg msg) -> Alcotest.fail msg 49 49 - 50 50 - let test_commit_hash () = 51 51 - let tree_hash = Hash.sha1 "tree" in 52 52 - let c1 = 53 53 - Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~message:"same" 54 54 - ~timestamp:1000L () 55 55 - in 56 56 - let c2 = 57 57 - Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~message:"same" 58 58 - ~timestamp:1000L () 59 59 - in 60 60 - Alcotest.(check bool) 61 61 - "same content same hash" true 62 62 - (Hash.equal (Commit.Git.hash c1) (Commit.Git.hash c2)) 63 63 - 64 64 - let suite = 65 65 - ( "commit", 66 66 - [ 67 67 - Alcotest.test_case "fields" `Quick test_commit_fields; 68 68 - Alcotest.test_case "committer" `Quick test_commit_committer; 69 69 - Alcotest.test_case "parents" `Quick test_commit_parents; 70 70 - Alcotest.test_case "roundtrip" `Quick test_commit_roundtrip; 71 71 - Alcotest.test_case "hash" `Quick test_commit_hash; 72 72 - ] )

-2

test/test_commit.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-104

test/test_git_interop.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let with_temp_dir f = 5 5 - Eio_main.run @@ fun env -> 6 6 - let fs = Eio.Stdenv.fs env in 7 7 - let cwd = Eio.Stdenv.cwd env in 8 8 - Eio.Switch.run @@ fun sw -> 9 9 - let tmp_name = Fmt.str "irmin-git-test-%d" (Random.int 100000) in 10 10 - let tmp_path = Eio.Path.(cwd / tmp_name) in 11 11 - Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path; 12 12 - Fun.protect 13 13 - ~finally:(fun () -> Test_helpers.rm_rf tmp_path) 14 14 - (fun () -> f ~sw ~fs tmp_path) 15 15 - 16 16 - let test_init_git () = 17 17 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 18 18 - let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in 19 19 - let _store = Git.init ~sw ~fs ~path:fpath in 20 20 - let git_dir = Eio.Path.(tmp_path / ".git") in 21 21 - Alcotest.(check bool) "git dir exists" true (Eio.Path.is_directory git_dir) 22 22 - 23 23 - let test_write_read_object () = 24 24 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 25 25 - let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in 26 26 - let _store = Git.init ~sw ~fs ~path:fpath in 27 27 - let git_dir = Fpath.(fpath / ".git") in 28 28 - let data = "hello world" in 29 29 - let hash = Git.write_object ~sw ~fs ~git_dir ~typ:"blob" data in 30 30 - match Git.read_object ~sw ~fs ~git_dir hash with 31 31 - | Ok (typ, content) -> 32 32 - Alcotest.(check string) "type" "blob" typ; 33 33 - Alcotest.(check string) "content" data content 34 34 - | Error (`Msg msg) -> Alcotest.fail msg 35 35 - 36 36 - let test_write_read_ref () = 37 37 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 38 38 - let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in 39 39 - let _store = Git.init ~sw ~fs ~path:fpath in 40 40 - let git_dir = Fpath.(fpath / ".git") in 41 41 - let hash = Git.write_object ~sw ~fs ~git_dir ~typ:"blob" "content" in 42 42 - Git.write_ref ~sw ~fs ~git_dir "refs/heads/test" hash; 43 43 - match Git.read_ref ~sw ~fs ~git_dir "refs/heads/test" with 44 44 - | Some h -> Alcotest.(check bool) "ref matches" true (Irmin.Hash.equal hash h) 45 45 - | None -> Alcotest.fail "ref not found" 46 46 - 47 47 - (* Regression: Repository.init used mkdir (non-recursive), failing when parent 48 48 - dirs don't exist. Fixed to mkdirs. *) 49 49 - let test_init_nested_path () = 50 50 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 51 51 - let nested = Eio.Path.native_exn tmp_path ^ "/a/b/repo" in 52 52 - let fpath = Fpath.v nested in 53 53 - let _store = Git.init ~sw ~fs ~path:fpath in 54 54 - let git_dir = Eio.Path.(fs / (nested ^ "/.git")) in 55 55 - Alcotest.(check bool) 56 56 - "git dir in nested path" true 57 57 - (Eio.Path.is_directory git_dir) 58 58 - 59 59 - (* Regression: git_backend.write called Repository.write unconditionally, 60 60 - failing on duplicate objects. Fixed to skip if already exists. *) 61 61 - let test_write_duplicate_object () = 62 62 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 63 63 - let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in 64 64 - let store = Irmin.Git.init ~sw ~fs ~path:fpath in 65 65 - let tree = Irmin.Tree.add Irmin.Tree.empty [ "file.txt" ] "hello world" in 66 66 - let _ = 67 67 - Irmin.commit store ~tree ~parents:[] ~message:"first" ~author:"test" 68 68 - in 69 69 - (* Committing the same tree again triggers duplicate backend writes — must not raise *) 70 70 - let _ = 71 71 - Irmin.commit store ~tree ~parents:[] ~message:"again" ~author:"test" 72 72 - in 73 73 - Alcotest.(check bool) "double commit did not raise" true true 74 74 - 75 75 - (* Integration: write commits to disk, reopen, read back. *) 76 76 - let test_store_git_roundtrip () = 77 77 - with_temp_dir @@ fun ~sw ~fs tmp_path -> 78 78 - let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in 79 79 - let store = Irmin.Git.init ~sw ~fs ~path:fpath in 80 80 - let tree = Irmin.Tree.add Irmin.Tree.empty [ "README.md" ] "# Hello" in 81 81 - let h = Irmin.commit store ~tree ~parents:[] ~message:"init" ~author:"test" in 82 82 - Irmin.set_head store ~branch:"main" h; 83 83 - let store2 = Irmin.Git.open_ ~sw ~fs ~path:fpath in 84 84 - Alcotest.(check bool) 85 85 - "head survived reopen" true 86 86 - (Irmin.head store2 ~branch:"main" = Some h); 87 87 - match Irmin.checkout store2 ~branch:"main" with 88 88 - | None -> Alcotest.fail "checkout failed" 89 89 - | Some tree2 -> 90 90 - Alcotest.(check (option string)) 91 91 - "content survived reopen" (Some "# Hello") 92 92 - (Irmin.Tree.find tree2 [ "README.md" ]) 93 93 - 94 94 - let suite = 95 95 - ( "git_interop", 96 96 - [ 97 97 - Alcotest.test_case "init git" `Quick test_init_git; 98 98 - Alcotest.test_case "write/read object" `Quick test_write_read_object; 99 99 - Alcotest.test_case "write/read ref" `Quick test_write_read_ref; 100 100 - Alcotest.test_case "init nested path" `Quick test_init_nested_path; 101 101 - Alcotest.test_case "write duplicate object" `Quick 102 102 - test_write_duplicate_object; 103 103 - Alcotest.test_case "store roundtrip" `Quick test_store_git_roundtrip; 104 104 - ] )

-2

test/test_git_interop.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-105

test/test_link.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let test_link_v_get () = 5 5 - let s = Link.Mst.v () in 6 6 - let l = Link.v s 42 in 7 7 - Alcotest.(check int) "get (v s x) = x" 42 (Link.get l) 8 8 - 9 9 - let test_link_is_val () = 10 10 - let s = Link.Mst.v () in 11 11 - let l = Link.v s "hello" in 12 12 - Alcotest.(check bool) "in-memory is_val" true (Link.is_val l) 13 13 - 14 14 - let test_link_equal () = 15 15 - let s = Link.Mst.v () in 16 16 - let l0 = Link.v s [ 1; 2; 3 ] in 17 17 - let l1 = Link.v s [ 1; 2; 3 ] in 18 18 - let l2 = Link.v s [ 1; 2; 4 ] in 19 19 - Alcotest.(check bool) "same value equal" true (Link.equal l0 l1); 20 20 - Alcotest.(check bool) "diff value not equal" false (Link.equal l0 l2) 21 21 - 22 22 - let test_link_address () = 23 23 - let s = Link.Mst.v () in 24 24 - let l0 = Link.v s "test" in 25 25 - let l1 = Link.v s "test" in 26 26 - Alcotest.(check bool) "same address" true (Link.address l0 = Link.address l1) 27 27 - 28 28 - let test_link_pp () = 29 29 - let s = Link.Mst.v () in 30 30 - let l = Link.v s "test" in 31 31 - let _ = Link.address l in 32 32 - let str = Fmt.str "%a" Link.pp l in 33 33 - Alcotest.(check int) "pp is 7 chars" 7 (String.length str) 34 34 - 35 35 - let test_link_read_write () = 36 36 - let s : int Link.store = Link.Mst.v () in 37 37 - Link.write s 42; 38 38 - Alcotest.(check int) "after write" 42 (Link.read s); 39 39 - Link.write s 100; 40 40 - Alcotest.(check int) "after second write" 100 (Link.read s) 41 41 - 42 42 - let test_link_is_open () = 43 43 - let s = Link.Mst.v () in 44 44 - Alcotest.(check bool) "initially open" true (Link.is_open s); 45 45 - Link.close s; 46 46 - Alcotest.(check bool) "closed after close" false (Link.is_open s) 47 47 - 48 48 - type test_tree = test_node Link.t 49 49 - and test_node = TEmpty | TNode of { l : test_tree; x : int; r : test_tree } 50 50 - 51 51 - let test_link_tree () = 52 52 - let s = Link.Mst.v () in 53 53 - let empty = Link.v s TEmpty in 54 54 - let leaf x = Link.v s (TNode { l = empty; x; r = empty }) in 55 55 - let node l x r = Link.v s (TNode { l; x; r }) in 56 56 - let t = node (leaf 1) 2 (leaf 3) in 57 57 - match Link.get t with 58 58 - | TEmpty -> Alcotest.fail "expected node" 59 59 - | TNode n -> ( 60 60 - Alcotest.(check int) "root" 2 n.x; 61 61 - match (Link.get n.l, Link.get n.r) with 62 62 - | TNode l, TNode r -> 63 63 - Alcotest.(check int) "left" 1 l.x; 64 64 - Alcotest.(check int) "right" 3 r.x 65 65 - | _ -> Alcotest.fail "expected leaves") 66 66 - 67 67 - (* of_backend: links persist through the backend and can be fetched by address 68 68 - using a second store instance backed by the same backend. *) 69 69 - let test_link_of_backend_persist () = 70 70 - let backend = Backend.Memory.cid () in 71 71 - let s : int Link.store = Link.Mst.of_backend backend in 72 72 - let l = Link.v s 42 in 73 73 - let addr = Link.address l in 74 74 - (* Second store wired to the same backend *) 75 75 - let s2 : int Link.store = Link.Mst.of_backend backend in 76 76 - let l2 = Link.of_address s2 addr in 77 77 - Alcotest.(check int) "fetched from backend" 42 (Link.get l2) 78 78 - 79 79 - (* of_backend with Git codec *) 80 80 - let test_link_of_backend_git () = 81 81 - let backend = Backend.Memory.sha1 () in 82 82 - let s : string Link.store = Link.Git.of_backend backend in 83 83 - let l = Link.v s "hello" in 84 84 - let addr = Link.address l in 85 85 - let s2 : string Link.store = Link.Git.of_backend backend in 86 86 - Alcotest.(check string) 87 87 - "fetched via git backend" "hello" 88 88 - (Link.get (Link.of_address s2 addr)) 89 89 - 90 90 - let suite = 91 91 - ( "link", 92 92 - [ 93 93 - Alcotest.test_case "v/get" `Quick test_link_v_get; 94 94 - Alcotest.test_case "is_val" `Quick test_link_is_val; 95 95 - Alcotest.test_case "equal" `Quick test_link_equal; 96 96 - Alcotest.test_case "address" `Quick test_link_address; 97 97 - Alcotest.test_case "pp" `Quick test_link_pp; 98 98 - Alcotest.test_case "read/write" `Quick test_link_read_write; 99 99 - Alcotest.test_case "is_open" `Quick test_link_is_open; 100 100 - Alcotest.test_case "tree" `Quick test_link_tree; 101 101 - Alcotest.test_case "of_backend persist (mst)" `Quick 102 102 - test_link_of_backend_persist; 103 103 - Alcotest.test_case "of_backend persist (git)" `Quick 104 104 - test_link_of_backend_git; 105 105 - ] )

-2

test/test_link.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-501

test/test_pds_interop.ml

reviewed

··· 1 1 - (** PDS interop tests — verify Irmin can read PDS stores and vice versa. 2 2 - 3 3 - These tests exercise the data path directly: writing via [Pds] API and 4 4 - reading via [Atp.Mst] + blockstore (the same code path the Irmin CLI PDS 5 5 - backend uses), and vice versa. *) 6 6 - 7 7 - open Irmin 8 8 - open Private 9 9 - 10 10 - let test_did = Atp.Did.of_string_exn "did:web:example.com" 11 11 - 12 12 - let with_temp_dir f = 13 13 - Eio_main.run @@ fun env -> 14 14 - let cwd = Eio.Stdenv.cwd env in 15 15 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds_interop") in 16 16 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 17 17 - let name = Fmt.str "repo_%d" (Random.int 1_000_000) in 18 18 - let path = Eio.Path.(tmp_dir / name) in 19 19 - Fun.protect 20 20 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 21 21 - (fun () -> f path) 22 22 - 23 23 - (* ---- PDS write → MST read ---- *) 24 24 - 25 25 - let test_pds_mst_read_record () = 26 26 - with_temp_dir @@ fun path -> 27 27 - Eio.Switch.run @@ fun sw -> 28 28 - let pds = Pds.v ~sw path ~did:test_did in 29 29 - let data = 30 30 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 31 31 - (`Map [ ("text", `String "Hello from PDS"); ("num", `Int 42L) ]) 32 32 - in 33 33 - Pds.put pds ~collection:"app.bsky.feed.post" ~rkey:"post1" data; 34 34 - (* Read back via MST traversal *) 35 35 - let found = Pds_interop.mst_find pds "app.bsky.feed.post/post1" in 36 36 - Alcotest.(check (option string)) "MST finds PDS record" (Some data) found 37 37 - 38 38 - let test_pds_mst_list_collections () = 39 39 - with_temp_dir @@ fun path -> 40 40 - Eio.Switch.run @@ fun sw -> 41 41 - let pds = Pds.v ~sw path ~did:test_did in 42 42 - let post = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "post") in 43 43 - let like = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "like") in 44 44 - let profile = 45 45 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "profile") 46 46 - in 47 47 - Pds.put pds ~collection:"app.bsky.feed.post" ~rkey:"a" post; 48 48 - Pds.put pds ~collection:"app.bsky.feed.like" ~rkey:"b" like; 49 49 - Pds.put pds ~collection:"app.bsky.actor.profile" ~rkey:"self" profile; 50 50 - (* List all MST leaves *) 51 51 - match Pds.checkout pds with 52 52 - | None -> Alcotest.fail "checkout returned None" 53 53 - | Some mst -> 54 54 - let bs = (Pds.blockstore pds :> Atp.Blockstore.readable) in 55 55 - let all_keys = 56 56 - Atp.Mst.leaves mst ~store:bs |> Seq.map fst |> List.of_seq 57 57 - in 58 58 - Alcotest.(check int) "3 leaves total" 3 (List.length all_keys); 59 59 - let has key = List.mem key all_keys in 60 60 - Alcotest.(check bool) "has post" true (has "app.bsky.feed.post/a"); 61 61 - Alcotest.(check bool) "has like" true (has "app.bsky.feed.like/b"); 62 62 - Alcotest.(check bool) 63 63 - "has profile" true 64 64 - (has "app.bsky.actor.profile/self") 65 65 - 66 66 - let test_pds_write_mst_head () = 67 67 - with_temp_dir @@ fun path -> 68 68 - Eio.Switch.run @@ fun sw -> 69 69 - let pds = Pds.v ~sw path ~did:test_did in 70 70 - let data = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "x") in 71 71 - Pds.put pds ~collection:"test" ~rkey:"k" data; 72 72 - let head = Pds.head pds in 73 73 - Alcotest.(check bool) "head exists" true (Option.is_some head) 74 74 - 75 75 - (* ---- MST write → PDS read ---- *) 76 76 - 77 77 - let test_mst_pds_read_record () = 78 78 - with_temp_dir @@ fun path -> 79 79 - Eio.Switch.run @@ fun sw -> 80 80 - let pds = Pds.v ~sw path ~did:test_did in 81 81 - let data = 82 82 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 83 83 - (`Map [ ("text", `String "Written via MST") ]) 84 84 - in 85 85 - Pds_interop.mst_add pds ~collection:"app.bsky.feed.post" ~rkey:"mst1" data; 86 86 - (* Read back via PDS API *) 87 87 - let result = Pds.find pds ~collection:"app.bsky.feed.post" ~rkey:"mst1" in 88 88 - Alcotest.(check (option string)) 89 89 - "PDS reads MST-written record" (Some data) result 90 90 - 91 91 - let test_mst_write_pds_list () = 92 92 - with_temp_dir @@ fun path -> 93 93 - Eio.Switch.run @@ fun sw -> 94 94 - let pds = Pds.v ~sw path ~did:test_did in 95 95 - let data1 = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "rec1") in 96 96 - let data2 = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "rec2") in 97 97 - Pds_interop.mst_add pds ~collection:"my.collection" ~rkey:"a" data1; 98 98 - Pds_interop.mst_add pds ~collection:"my.collection" ~rkey:"b" data2; 99 99 - let records = Pds.list pds ~collection:"my.collection" in 100 100 - let rkeys = List.map fst records |> List.sort String.compare in 101 101 - Alcotest.(check (list string)) 102 102 - "PDS lists MST-written records" [ "a"; "b" ] rkeys 103 103 - 104 104 - (* ---- Roundtrip: PDS → MST → PDS ---- *) 105 105 - 106 106 - let test_roundtrip_modify () = 107 107 - with_temp_dir @@ fun path -> 108 108 - Eio.Switch.run @@ fun sw -> 109 109 - let pds = Pds.v ~sw path ~did:test_did in 110 110 - let original = 111 111 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 112 112 - (`Map [ ("text", `String "original") ]) 113 113 - in 114 114 - let updated = 115 115 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 116 116 - (`Map [ ("text", `String "updated via MST") ]) 117 117 - in 118 118 - (* PDS: create initial data *) 119 119 - Pds.put pds ~collection:"test.col" ~rkey:"key1" original; 120 120 - (* MST: modify the record *) 121 121 - Pds_interop.mst_add pds ~collection:"test.col" ~rkey:"key1" updated; 122 122 - (* PDS: verify the update *) 123 123 - let result = Pds.find pds ~collection:"test.col" ~rkey:"key1" in 124 124 - Alcotest.(check (option string)) "roundtrip update" (Some updated) result 125 125 - 126 126 - let test_roundtrip_add_delete () = 127 127 - with_temp_dir @@ fun path -> 128 128 - Eio.Switch.run @@ fun sw -> 129 129 - let pds = Pds.v ~sw path ~did:test_did in 130 130 - let data = 131 131 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "keepme") 132 132 - in 133 133 - let extra = 134 134 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "deleteme") 135 135 - in 136 136 - (* PDS: create 2 records *) 137 137 - Pds.put pds ~collection:"col" ~rkey:"keep" data; 138 138 - Pds.put pds ~collection:"col" ~rkey:"delete" extra; 139 139 - (* MST: delete one, add another *) 140 140 - let new_data = 141 141 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "newrecord") 142 142 - in 143 143 - Pds_interop.mst_remove pds ~collection:"col" ~rkey:"delete"; 144 144 - Pds_interop.mst_add pds ~collection:"col" ~rkey:"added" new_data; 145 145 - (* PDS: verify final state *) 146 146 - let records = Pds.list pds ~collection:"col" in 147 147 - let rkeys = List.map fst records |> List.sort String.compare in 148 148 - let kept = Pds.find pds ~collection:"col" ~rkey:"keep" in 149 149 - let deleted = Pds.find pds ~collection:"col" ~rkey:"delete" in 150 150 - let added = Pds.find pds ~collection:"col" ~rkey:"added" in 151 151 - Alcotest.(check (list string)) "final rkeys" [ "added"; "keep" ] rkeys; 152 152 - Alcotest.(check (option string)) "kept record" (Some data) kept; 153 153 - Alcotest.(check (option string)) "deleted record gone" None deleted; 154 154 - Alcotest.(check (option string)) "added record" (Some new_data) added 155 155 - 156 156 - (* ---- CAR export interop ---- *) 157 157 - 158 158 - let test_car_export_reimport () = 159 159 - with_temp_dir @@ fun path -> 160 160 - Eio.Switch.run @@ fun sw -> 161 161 - let pds = Pds.v ~sw path ~did:test_did in 162 162 - let data = 163 163 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 164 164 - (`Map [ ("text", `String "car test") ]) 165 165 - in 166 166 - Pds.put pds ~collection:"test" ~rkey:"rec1" data; 167 167 - let head_before = Pds.head pds in 168 168 - (* Export CAR *) 169 169 - let car_data = Pds.export_car pds in 170 170 - Alcotest.(check bool) "CAR not empty" true (String.length car_data > 0); 171 171 - (* Parse and verify CAR structure *) 172 172 - let header, blocks = Atp.Car.of_string ~cid_format:`Atproto car_data in 173 173 - Alcotest.(check int) "CAR v1" 1 header.version; 174 174 - Alcotest.(check bool) "has roots" true (List.length header.roots > 0); 175 175 - Alcotest.(check bool) "has blocks" true (List.length blocks > 0); 176 176 - (* Root should match HEAD *) 177 177 - match (head_before, header.roots) with 178 178 - | Some head_cid, [ root ] -> 179 179 - Alcotest.(check string) 180 180 - "CAR root matches HEAD" 181 181 - (Atp.Cid.to_string head_cid) 182 182 - (Atp.Cid.to_string root) 183 183 - | _ -> () 184 184 - 185 185 - let test_car_import_then_read () = 186 186 - Eio_main.run @@ fun env -> 187 187 - let cwd = Eio.Stdenv.cwd env in 188 188 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds_interop") in 189 189 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 190 190 - let name1 = Fmt.str "export_%d" (Random.int 1_000_000) in 191 191 - let name2 = Fmt.str "import_%d" (Random.int 1_000_000) in 192 192 - let path1 = Eio.Path.(tmp_dir / name1) in 193 193 - let path2 = Eio.Path.(tmp_dir / name2) in 194 194 - Fun.protect 195 195 - ~finally:(fun () -> 196 196 - (try Helpers.rm_rf path1 with Eio.Io _ -> ()); 197 197 - try Helpers.rm_rf path2 with Eio.Io _ -> ()) 198 198 - (fun () -> 199 199 - (* Create source repo with data *) 200 200 - let car_data = 201 201 - Eio.Switch.run @@ fun sw -> 202 202 - let pds = Pds.v ~sw path1 ~did:test_did in 203 203 - let data = 204 204 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "imported") 205 205 - in 206 206 - Pds.put pds ~collection:"test" ~rkey:"x" data; 207 207 - let car = Pds.export_car pds in 208 208 - Pds.close pds; 209 209 - car 210 210 - in 211 211 - (* Import into fresh repo *) 212 212 - Eio.Switch.run @@ fun sw -> 213 213 - let pds2 = Pds.v ~sw path2 ~did:test_did in 214 214 - let count = Pds.import_car pds2 car_data in 215 215 - Pds.close pds2; 216 216 - Alcotest.(check bool) "imported blocks" true (count > 0)) 217 217 - 218 218 - (* ---- Persistence across sessions ---- *) 219 219 - 220 220 - let test_persistence_across_sessions () = 221 221 - Eio_main.run @@ fun env -> 222 222 - let cwd = Eio.Stdenv.cwd env in 223 223 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds_interop") in 224 224 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 225 225 - let name = Fmt.str "persist_%d" (Random.int 1_000_000) in 226 226 - let path = Eio.Path.(tmp_dir / name) in 227 227 - Fun.protect 228 228 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 229 229 - (fun () -> 230 230 - let data = 231 231 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 232 232 - (`Map [ ("content", `String "persistent") ]) 233 233 - in 234 234 - (* Session 1: write via PDS *) 235 235 - Eio.Switch.run (fun sw -> 236 236 - let pds = Pds.v ~sw path ~did:test_did in 237 237 - Pds.put pds ~collection:"test" ~rkey:"persist" data; 238 238 - Pds.close pds); 239 239 - (* Session 2: read via MST traversal *) 240 240 - let found1 = 241 241 - Eio.Switch.run @@ fun sw -> 242 242 - let pds = Pds.open_ ~sw path in 243 243 - let result = Pds_interop.mst_find pds "test/persist" in 244 244 - Pds.close pds; 245 245 - result 246 246 - in 247 247 - Alcotest.(check (option string)) "session 2 reads" (Some data) found1; 248 248 - (* Session 3: read via PDS API *) 249 249 - let found2 = 250 250 - Eio.Switch.run @@ fun sw -> 251 251 - let pds = Pds.open_ ~sw path in 252 252 - let result = Pds.find pds ~collection:"test" ~rkey:"persist" in 253 253 - Pds.close pds; 254 254 - result 255 255 - in 256 256 - Alcotest.(check (option string)) "session 3 reads" (Some data) found2) 257 257 - 258 258 - (* ---- DID preservation ---- *) 259 259 - 260 260 - let test_did_preserved () = 261 261 - Eio_main.run @@ fun env -> 262 262 - let cwd = Eio.Stdenv.cwd env in 263 263 - let tmp_dir = Eio.Path.(cwd / "_build" / "test_pds_interop") in 264 264 - (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 265 265 - let name = Fmt.str "did_%d" (Random.int 1_000_000) in 266 266 - let path = Eio.Path.(tmp_dir / name) in 267 267 - Fun.protect 268 268 - ~finally:(fun () -> try Helpers.rm_rf path with Eio.Io _ -> ()) 269 269 - (fun () -> 270 270 - let custom_did = Atp.Did.of_string_exn "did:plc:abc123xyz" in 271 271 - Eio.Switch.run (fun sw -> 272 272 - let pds = Pds.v ~sw path ~did:custom_did in 273 273 - Pds.close pds); 274 274 - Eio.Switch.run @@ fun sw -> 275 275 - let pds = Pds.open_ ~sw path in 276 276 - let did = Pds.did pds in 277 277 - Pds.close pds; 278 278 - Alcotest.(check string) 279 279 - "DID preserved" "did:plc:abc123xyz" (Atp.Did.to_string did)) 280 280 - 281 281 - (* ---- Empty store ---- *) 282 282 - 283 283 - let test_empty_pds_checkout () = 284 284 - with_temp_dir @@ fun path -> 285 285 - Eio.Switch.run @@ fun sw -> 286 286 - let pds = Pds.v ~sw path ~did:test_did in 287 287 - let mst = Pds.checkout pds in 288 288 - Alcotest.(check bool) "empty checkout is None" true (Option.is_none mst) 289 289 - 290 290 - let test_empty_pds_head () = 291 291 - with_temp_dir @@ fun path -> 292 292 - Eio.Switch.run @@ fun sw -> 293 293 - let pds = Pds.v ~sw path ~did:test_did in 294 294 - let head = Pds.head pds in 295 295 - Alcotest.(check bool) "empty head is None" true (Option.is_none head); 296 296 - ignore pds 297 297 - 298 298 - (* ---- Large collection ---- *) 299 299 - 300 300 - let test_many_records () = 301 301 - with_temp_dir @@ fun path -> 302 302 - Eio.Switch.run @@ fun sw -> 303 303 - let pds = Pds.v ~sw path ~did:test_did in 304 304 - let n = 100 in 305 305 - (* Write N records via PDS *) 306 306 - for i = 0 to n - 1 do 307 307 - let data = 308 308 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`Int (Int64.of_int i)) 309 309 - in 310 310 - Pds.put pds ~collection:"b" ~rkey:(Fmt.str "%d" i) data 311 311 - done; 312 312 - (* Read all via MST *) 313 313 - let keys = Pds_interop.mst_list_prefix pds "b/" in 314 314 - Alcotest.(check int) "100 records via MST" n (List.length keys); 315 315 - (* Spot-check via PDS API *) 316 316 - let check i = 317 317 - let expected = 318 318 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`Int (Int64.of_int i)) 319 319 - in 320 320 - let rkey = Fmt.str "%d" i in 321 321 - let found = Pds.find pds ~collection:"b" ~rkey in 322 322 - Alcotest.(check (option string)) 323 323 - (Fmt.str "record %d" i) (Some expected) found 324 324 - in 325 325 - check 0; 326 326 - check 50; 327 327 - check 99 328 328 - 329 329 - (* ---- MST leaf ordering consistency ---- *) 330 330 - 331 331 - let test_leaf_order_matches () = 332 332 - with_temp_dir @@ fun path -> 333 333 - Eio.Switch.run @@ fun sw -> 334 334 - let pds = Pds.v ~sw path ~did:test_did in 335 335 - (* Write records with keys that test sort order *) 336 336 - let keys = [ "zzz"; "aaa"; "mmm"; "abc"; "xyz" ] in 337 337 - List.iter 338 338 - (fun k -> 339 339 - let data = Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String k) in 340 340 - Pds.put pds ~collection:"order" ~rkey:k data) 341 341 - keys; 342 342 - (* Read via PDS list *) 343 343 - let pds_keys = Pds.list pds ~collection:"order" |> List.map fst in 344 344 - (* Read via MST leaves *) 345 345 - let mst_keys = Pds_interop.mst_list_prefix pds "order/" in 346 346 - (* Both should be sorted identically *) 347 347 - Alcotest.(check (list string)) "PDS and MST agree on order" pds_keys mst_keys 348 348 - 349 349 - (* ---- Multiple collections interop ---- *) 350 350 - 351 351 - let test_multiple_collections_interop () = 352 352 - with_temp_dir @@ fun path -> 353 353 - Eio.Switch.run @@ fun sw -> 354 354 - let pds = Pds.v ~sw path ~did:test_did in 355 355 - (* Write some via PDS, some via MST *) 356 356 - let pds_data = 357 357 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "via-pds") 358 358 - in 359 359 - let mst_data = 360 360 - Atp.Dagcbor.encode_string ~cid_format:`Atproto (`String "via-mst") 361 361 - in 362 362 - Pds.put pds ~collection:"col.a" ~rkey:"r1" pds_data; 363 363 - Pds_interop.mst_add pds ~collection:"col.b" ~rkey:"r2" mst_data; 364 364 - (* Both should be readable via PDS *) 365 365 - let a = Pds.find pds ~collection:"col.a" ~rkey:"r1" in 366 366 - let b = Pds.find pds ~collection:"col.b" ~rkey:"r2" in 367 367 - Alcotest.(check (option string)) "col.a via PDS" (Some pds_data) a; 368 368 - Alcotest.(check (option string)) "col.b via PDS" (Some mst_data) b; 369 369 - (* Both should be readable via MST *) 370 370 - let a' = Pds_interop.mst_find pds "col.a/r1" in 371 371 - let b' = Pds_interop.mst_find pds "col.b/r2" in 372 372 - Alcotest.(check (option string)) "col.a via MST" (Some pds_data) a'; 373 373 - Alcotest.(check (option string)) "col.b via MST" (Some mst_data) b' 374 374 - 375 375 - (* ---- DAG-CBOR content integrity ---- *) 376 376 - 377 377 - let test_dagcbor_integrity () = 378 378 - with_temp_dir @@ fun path -> 379 379 - Eio.Switch.run @@ fun sw -> 380 380 - let pds = Pds.v ~sw path ~did:test_did in 381 381 - (* Write a complex DAG-CBOR record *) 382 382 - let complex = 383 383 - Atp.Dagcbor.encode_string ~cid_format:`Atproto 384 384 - (`Map 385 385 - [ 386 386 - ("text", `String "Hello world"); 387 387 - ("createdAt", `String "2025-01-01T00:00:00Z"); 388 388 - ("langs", `List [ `String "en"; `String "fr" ]); 389 389 - ("nested", `Map [ ("key", `Int 123L); ("flag", `Bool true) ]); 390 390 - ]) 391 391 - in 392 392 - Pds.put pds ~collection:"app.bsky.feed.post" ~rkey:"complex1" complex; 393 393 - (* Read back via MST and decode *) 394 394 - let found = Pds_interop.mst_find pds "app.bsky.feed.post/complex1" in 395 395 - match found with 396 396 - | None -> Alcotest.fail "record not found" 397 397 - | Some raw -> ( 398 398 - Alcotest.(check string) "raw bytes match" complex raw; 399 399 - (* Verify it decodes correctly *) 400 400 - let decoded = Atp.Dagcbor.decode_string ~cid_format:`Atproto raw in 401 401 - match decoded with 402 402 - | `Map fields -> 403 403 - let text = List.assoc_opt "text" fields in 404 404 - Alcotest.(check bool) 405 405 - "has text field" true 406 406 - (text = Some (`String "Hello world")) 407 407 - | _ -> Alcotest.fail "expected Map") 408 408 - 409 409 - (* ---- Irmin store API on PDS ---- *) 410 410 - 411 411 - let test_pds_store_main_branch () = 412 412 - with_temp_dir @@ fun path -> 413 413 - Eio.Switch.run @@ fun sw -> 414 414 - let pds = Pds.v ~sw path ~did:test_did in 415 415 - let store = Irmin.Atproto.(of_pds pds |> v) in 416 416 - let tree = Irmin.Tree.add Irmin.Tree.empty [ "key" ] "value" in 417 417 - let h = Irmin.commit store ~tree ~parents:[] ~message:"init" ~author:"test" in 418 418 - Irmin.set_head store ~branch:"main" h; 419 419 - Alcotest.(check bool) "has main" true (List.mem "main" (Irmin.branches store)); 420 420 - match Irmin.head store ~branch:"main" with 421 421 - | Some h' -> Alcotest.(check bool) "head set" true (Irmin.Hash.equal h h') 422 422 - | None -> Alcotest.fail "head should exist" 423 423 - 424 424 - let test_pds_store_multiple_branches () = 425 425 - with_temp_dir @@ fun path -> 426 426 - Eio.Switch.run @@ fun sw -> 427 427 - let pds = Pds.v ~sw path ~did:test_did in 428 428 - let store = Irmin.Atproto.(of_pds pds |> v) in 429 429 - let tree1 = Irmin.Tree.add Irmin.Tree.empty [ "a" ] "1" in 430 430 - let h1 = 431 431 - Irmin.commit store ~tree:tree1 ~parents:[] ~message:"on main" ~author:"t" 432 432 - in 433 433 - Irmin.set_head store ~branch:"main" h1; 434 434 - let tree2 = Irmin.Tree.add Irmin.Tree.empty [ "b" ] "2" in 435 435 - let h2 = 436 436 - Irmin.commit store ~tree:tree2 ~parents:[] ~message:"on dev" ~author:"t" 437 437 - in 438 438 - Irmin.set_head store ~branch:"dev" h2; 439 439 - (* Both branches exist *) 440 440 - let bs = Irmin.branches store in 441 441 - Alcotest.(check bool) "has main" true (List.mem "main" bs); 442 442 - Alcotest.(check bool) "has dev" true (List.mem "dev" bs); 443 443 - (* Each points to its own commit *) 444 444 - (match Irmin.head store ~branch:"main" with 445 445 - | Some h -> Alcotest.(check bool) "main head" true (Irmin.Hash.equal h h1) 446 446 - | None -> Alcotest.fail "main head missing"); 447 447 - match Irmin.head store ~branch:"dev" with 448 448 - | Some h -> Alcotest.(check bool) "dev head" true (Irmin.Hash.equal h h2) 449 449 - | None -> Alcotest.fail "dev head missing" 450 450 - 451 451 - let test_pds_branches_survive_reopen () = 452 452 - with_temp_dir @@ fun path -> 453 453 - (* Session 1: create branches *) 454 454 - Eio.Switch.run (fun sw -> 455 455 - let pds = Pds.v ~sw path ~did:test_did in 456 456 - let store = Irmin.Atproto.(of_pds pds |> v) in 457 457 - let tree = Irmin.Tree.add Irmin.Tree.empty [ "x" ] "y" in 458 458 - let h = 459 459 - Irmin.commit store ~tree ~parents:[] ~message:"init" ~author:"t" 460 460 - in 461 461 - Irmin.set_head store ~branch:"main" h; 462 462 - Irmin.set_head store ~branch:"feature" h; 463 463 - Pds.close pds); 464 464 - (* Session 2: verify branches persist *) 465 465 - Eio.Switch.run @@ fun sw -> 466 466 - let pds = Pds.open_ ~sw path in 467 467 - let store = Irmin.Atproto.(of_pds pds |> v) in 468 468 - let bs = Irmin.branches store in 469 469 - Alcotest.(check bool) "main persists" true (List.mem "main" bs); 470 470 - Alcotest.(check bool) "feature persists" true (List.mem "feature" bs); 471 471 - Pds.close pds 472 472 - 473 473 - let suite = 474 474 - ( "pds_interop", 475 475 - [ 476 476 - Alcotest.test_case "pds-mst read record" `Quick test_pds_mst_read_record; 477 477 - Alcotest.test_case "pds-mst list collections" `Quick 478 478 - test_pds_mst_list_collections; 479 479 - Alcotest.test_case "pds-mst head" `Quick test_pds_write_mst_head; 480 480 - Alcotest.test_case "mst-pds read record" `Quick test_mst_pds_read_record; 481 481 - Alcotest.test_case "mst-pds list records" `Quick test_mst_write_pds_list; 482 482 - Alcotest.test_case "roundtrip modify" `Quick test_roundtrip_modify; 483 483 - Alcotest.test_case "roundtrip add/delete" `Quick test_roundtrip_add_delete; 484 484 - Alcotest.test_case "car export/reimport" `Quick test_car_export_reimport; 485 485 - Alcotest.test_case "car import then read" `Quick test_car_import_then_read; 486 486 - Alcotest.test_case "persistence across sessions" `Quick 487 487 - test_persistence_across_sessions; 488 488 - Alcotest.test_case "persistence DID preserved" `Quick test_did_preserved; 489 489 - Alcotest.test_case "empty checkout" `Quick test_empty_pds_checkout; 490 490 - Alcotest.test_case "empty head" `Quick test_empty_pds_head; 491 491 - Alcotest.test_case "scale 10 records" `Quick test_many_records; 492 492 - Alcotest.test_case "leaf order" `Quick test_leaf_order_matches; 493 493 - Alcotest.test_case "multiple collections" `Quick 494 494 - test_multiple_collections_interop; 495 495 - Alcotest.test_case "DAG-CBOR integrity" `Quick test_dagcbor_integrity; 496 496 - Alcotest.test_case "store main branch" `Quick test_pds_store_main_branch; 497 497 - Alcotest.test_case "multiple branches" `Quick 498 498 - test_pds_store_multiple_branches; 499 499 - Alcotest.test_case "branches survive reopen" `Quick 500 500 - test_pds_branches_survive_reopen; 501 501 - ] )

-2

test/test_pds_interop.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Alcotest suite for PDS interoperability tests. *)

-207

test/test_proof.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let test_proof_produce_verify () = 5 5 - let backend = Backend.Memory.sha1 () in 6 6 - let tree = Tree.Git.empty () in 7 7 - let tree = Tree.Git.add tree [ "foo"; "bar" ] "hello" in 8 8 - let tree = Tree.Git.add tree [ "foo"; "baz" ] "world" in 9 9 - let root_hash = Tree.Git.hash tree ~backend in 10 10 - let proof, result = 11 11 - Proof.Git.produce backend root_hash (fun t -> 12 12 - let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in 13 13 - (t, v)) 14 14 - in 15 15 - Alcotest.(check (option string)) "found value" (Some "hello") result; 16 16 - match 17 17 - Proof.Git.verify ~expected_root:(`Node root_hash) proof (fun t -> 18 18 - let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in 19 19 - (t, v)) 20 20 - with 21 21 - | Ok (_, v) -> 22 22 - Alcotest.(check (option string)) "verified value" (Some "hello") v 23 23 - | Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg) 24 24 - 25 25 - let test_proof_blinded () = 26 26 - let backend = Backend.Memory.sha1 () in 27 27 - let tree = Tree.Git.empty () in 28 28 - let tree = Tree.Git.add tree [ "a" ] "1" in 29 29 - let tree = Tree.Git.add tree [ "b" ] "2" in 30 30 - let root_hash = Tree.Git.hash tree ~backend in 31 31 - let proof, _ = 32 32 - Proof.Git.produce backend root_hash (fun t -> 33 33 - let _ = Proof.Git.Tree.find t [ "a" ] in 34 34 - (t, ())) 35 35 - in 36 36 - let state = Proof.state proof in 37 37 - match state with 38 38 - | Proof.Node entries -> 39 39 - let has_a = 40 40 - List.exists 41 41 - (fun (k, v) -> 42 42 - k = "a" && match v with Proof.Contents "1" -> true | _ -> false) 43 43 - entries 44 44 - in 45 45 - let has_blinded_b = 46 46 - List.exists 47 47 - (fun (k, v) -> 48 48 - k = "b" 49 49 - && match v with Proof.Blinded_contents _ -> true | _ -> false) 50 50 - entries 51 51 - in 52 52 - Alcotest.(check bool) "has a" true has_a; 53 53 - Alcotest.(check bool) "b is blinded" true has_blinded_b 54 54 - | _ -> Alcotest.fail "expected Node" 55 55 - 56 56 - let test_proof_mst () = 57 57 - let backend = Backend.Memory.cid () in 58 58 - let tree = Tree.Mst.empty () in 59 59 - let tree = Tree.Mst.add tree [ "key1" ] "value1" in 60 60 - let tree = Tree.Mst.add tree [ "key2" ] "value2" in 61 61 - let root_hash = Tree.Mst.hash tree ~backend in 62 62 - let proof, result = 63 63 - Proof.Mst.produce backend root_hash (fun t -> 64 64 - let v = Proof.Mst.Tree.find t [ "key1" ] in 65 65 - (t, v)) 66 66 - in 67 67 - Alcotest.(check (option string)) "found value" (Some "value1") result; 68 68 - match 69 69 - Proof.Mst.verify ~expected_root:(`Node root_hash) proof (fun t -> 70 70 - let v = Proof.Mst.Tree.find t [ "key1" ] in 71 71 - (t, v)) 72 72 - with 73 73 - | Ok (_, v) -> 74 74 - Alcotest.(check (option string)) "verified value" (Some "value1") v 75 75 - | Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg) 76 76 - 77 77 - let test_wrong_expected_root () = 78 78 - let backend = Backend.Memory.sha1 () in 79 79 - let tree = Tree.Git.empty () in 80 80 - let tree = Tree.Git.add tree [ "foo" ] "bar" in 81 81 - let root_hash = Tree.Git.hash tree ~backend in 82 82 - let proof, _ = 83 83 - Proof.Git.produce backend root_hash (fun t -> 84 84 - let v = Proof.Git.Tree.find t [ "foo" ] in 85 85 - (t, v)) 86 86 - in 87 87 - let wrong_root = `Node (Codec.Git.hash_contents "wrong") in 88 88 - match 89 89 - Proof.Git.verify ~expected_root:wrong_root proof (fun t -> 90 90 - let v = Proof.Git.Tree.find t [ "foo" ] in 91 91 - (t, v)) 92 92 - with 93 93 - | Ok _ -> Alcotest.fail "should reject wrong expected_root" 94 94 - | Error (`Proof_mismatch _) -> () 95 95 - 96 96 - let test_wrong_before () = 97 97 - let backend = Backend.Memory.sha1 () in 98 98 - let tree = Tree.Git.empty () in 99 99 - let tree = Tree.Git.add tree [ "foo" ] "bar" in 100 100 - let root_hash = Tree.Git.hash tree ~backend in 101 101 - let proof, _ = 102 102 - Proof.Git.produce backend root_hash (fun t -> 103 103 - let v = Proof.Git.Tree.find t [ "foo" ] in 104 104 - (t, v)) 105 105 - in 106 106 - let wrong_hash = Codec.Git.hash_contents "wrong" in 107 107 - let tampered = 108 108 - Proof.v ~before:(`Node wrong_hash) ~after:(Proof.after proof) 109 109 - (Proof.state proof) 110 110 - in 111 111 - match 112 112 - Proof.Git.verify ~expected_root:(`Node wrong_hash) tampered (fun t -> 113 113 - let v = Proof.Git.Tree.find t [ "foo" ] in 114 114 - (t, v)) 115 115 - with 116 116 - | Ok _ -> Alcotest.fail "should reject wrong before hash" 117 117 - | Error (`Proof_mismatch _) -> () 118 118 - 119 119 - let test_wrong_after () = 120 120 - let backend = Backend.Memory.sha1 () in 121 121 - let tree = Tree.Git.empty () in 122 122 - let tree = Tree.Git.add tree [ "foo" ] "bar" in 123 123 - let root_hash = Tree.Git.hash tree ~backend in 124 124 - let proof, _ = 125 125 - Proof.Git.produce backend root_hash (fun t -> 126 126 - let v = Proof.Git.Tree.find t [ "foo" ] in 127 127 - (t, v)) 128 128 - in 129 129 - let wrong_hash = Codec.Git.hash_contents "wrong" in 130 130 - let tampered = 131 131 - Proof.v ~before:(Proof.before proof) ~after:(`Node wrong_hash) 132 132 - (Proof.state proof) 133 133 - in 134 134 - match 135 135 - Proof.Git.verify ~expected_root:(`Node root_hash) tampered (fun t -> 136 136 - let v = Proof.Git.Tree.find t [ "foo" ] in 137 137 - (t, v)) 138 138 - with 139 139 - | Ok _ -> Alcotest.fail "should reject wrong after hash" 140 140 - | Error (`Proof_mismatch _) -> () 141 141 - 142 142 - let test_wrong_state () = 143 143 - let backend = Backend.Memory.sha1 () in 144 144 - let tree = Tree.Git.empty () in 145 145 - let tree = Tree.Git.add tree [ "foo" ] "bar" in 146 146 - let root_hash = Tree.Git.hash tree ~backend in 147 147 - let proof, _ = 148 148 - Proof.Git.produce backend root_hash (fun t -> 149 149 - let v = Proof.Git.Tree.find t [ "foo" ] in 150 150 - (t, v)) 151 151 - in 152 152 - let wrong_hash = Codec.Git.hash_contents "wrong" in 153 153 - let bad_states = 154 154 - [ Proof.Blinded_node wrong_hash; Proof.Node []; Proof.Contents "garbage" ] 155 155 - in 156 156 - List.iter 157 157 - (fun state -> 158 158 - let tampered = 159 159 - Proof.v ~before:(Proof.before proof) ~after:(Proof.after proof) state 160 160 - in 161 161 - match 162 162 - Proof.Git.verify ~expected_root:(`Node root_hash) tampered (fun t -> 163 163 - let v = Proof.Git.Tree.find t [ "foo" ] in 164 164 - (t, v)) 165 165 - with 166 166 - | Ok _ -> Alcotest.fail "should reject wrong state" 167 167 - | Error (`Proof_mismatch _) -> ()) 168 168 - bad_states 169 169 - 170 170 - let test_attacker_crafted_proof () = 171 171 - (* An attacker creates a proof for an arbitrary tree and claims it as a 172 172 - legitimate root. verify must reject because expected_root won't match. *) 173 173 - let backend = Backend.Memory.sha1 () in 174 174 - let real_tree = Tree.Git.empty () in 175 175 - let real_tree = Tree.Git.add real_tree [ "secret" ] "real_value" in 176 176 - let real_root = Tree.Git.hash real_tree ~backend in 177 177 - let fake_tree = Tree.Git.empty () in 178 178 - let fake_tree = Tree.Git.add fake_tree [ "secret" ] "attacker_value" in 179 179 - let fake_root = Tree.Git.hash fake_tree ~backend in 180 180 - let fake_proof, _ = 181 181 - Proof.Git.produce backend fake_root (fun t -> 182 182 - let v = Proof.Git.Tree.find t [ "secret" ] in 183 183 - (t, v)) 184 184 - in 185 185 - (* Attacker presents fake_proof but the verifier holds real_root as trusted *) 186 186 - match 187 187 - Proof.Git.verify ~expected_root:(`Node real_root) fake_proof (fun t -> 188 188 - let v = Proof.Git.Tree.find t [ "secret" ] in 189 189 - (t, v)) 190 190 - with 191 191 - | Ok _ -> Alcotest.fail "should reject proof for wrong tree" 192 192 - | Error (`Proof_mismatch _) -> () 193 193 - 194 194 - let suite = 195 195 - ( "proof", 196 196 - [ 197 197 - Alcotest.test_case "produce/verify" `Quick test_proof_produce_verify; 198 198 - Alcotest.test_case "blinded nodes" `Quick test_proof_blinded; 199 199 - Alcotest.test_case "mst proofs" `Quick test_proof_mst; 200 200 - Alcotest.test_case "reject wrong expected_root" `Quick 201 201 - test_wrong_expected_root; 202 202 - Alcotest.test_case "reject wrong before" `Quick test_wrong_before; 203 203 - Alcotest.test_case "reject wrong after" `Quick test_wrong_after; 204 204 - Alcotest.test_case "reject wrong state" `Quick test_wrong_state; 205 205 - Alcotest.test_case "reject attacker-crafted proof" `Quick 206 206 - test_attacker_crafted_proof; 207 207 - ] )

-2

test/test_proof.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-64

test/test_store.ml

reviewed

··· 1 1 - (* Internal API tests using Private modules directly (SHA-1 only). *) 2 2 - 3 3 - open Irmin.Private 4 4 - 5 5 - let test_store_commit () = 6 6 - let backend = Backend.Memory.sha1 () in 7 7 - let store = Store.Git.create ~backend in 8 8 - let tree = Tree.Git.empty () in 9 9 - let tree = Tree.Git.add tree [ "README.md" ] "# Hello" in 10 10 - let hash = 11 11 - Store.Git.commit store ~tree ~parents:[] ~message:"Initial commit" 12 12 - ~author:"test" 13 13 - in 14 14 - Alcotest.(check bool) "commit hash exists" true (Backend.exists backend hash) 15 15 - 16 16 - let test_store_branches () = 17 17 - let backend = Backend.Memory.sha1 () in 18 18 - let store = Store.Git.create ~backend in 19 19 - let tree = Tree.Git.empty () in 20 20 - let hash = 21 21 - Store.Git.commit store ~tree ~parents:[] ~message:"test" ~author:"test" 22 22 - in 23 23 - Store.Git.set_head store ~branch:"main" hash; 24 24 - let branches = Store.Git.branches store in 25 25 - Alcotest.(check (list string)) "branches" [ "main" ] branches 26 26 - 27 27 - let test_store_diff () = 28 28 - let backend = Backend.Memory.sha1 () in 29 29 - let store = Store.Git.create ~backend in 30 30 - let tree1 = Tree.Git.empty () in 31 31 - let tree1 = Tree.Git.add tree1 [ "file1.txt" ] "content1" in 32 32 - let tree1 = Tree.Git.add tree1 [ "file2.txt" ] "content2" in 33 33 - let hash1 = Tree.Git.hash tree1 ~backend in 34 34 - let tree2 = Tree.Git.empty () in 35 35 - let tree2 = Tree.Git.add tree2 [ "file1.txt" ] "modified1" in 36 36 - let tree2 = Tree.Git.add tree2 [ "file3.txt" ] "content3" in 37 37 - let hash2 = Tree.Git.hash tree2 ~backend in 38 38 - let changes = Store.Git.diff store ~old:hash1 ~new_:hash2 |> List.of_seq in 39 39 - let has_remove_file2 = 40 40 - List.exists 41 41 - (function `Remove [ "file2.txt" ] -> true | _ -> false) 42 42 - changes 43 43 - in 44 44 - let has_add_file3 = 45 45 - List.exists 46 46 - (function `Add ([ "file3.txt" ], _) -> true | _ -> false) 47 47 - changes 48 48 - in 49 49 - let has_change_file1 = 50 50 - List.exists 51 51 - (function `Change ([ "file1.txt" ], _, _) -> true | _ -> false) 52 52 - changes 53 53 - in 54 54 - Alcotest.(check bool) "file2 removed" true has_remove_file2; 55 55 - Alcotest.(check bool) "file3 added" true has_add_file3; 56 56 - Alcotest.(check bool) "file1 changed" true has_change_file1 57 57 - 58 58 - let suite = 59 59 - ( "store", 60 60 - [ 61 61 - Alcotest.test_case "store commit" `Quick test_store_commit; 62 62 - Alcotest.test_case "store branches" `Quick test_store_branches; 63 63 - Alcotest.test_case "store diff" `Quick test_store_diff; 64 64 - ] )

-2

test/test_store.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** [suite] is the alcotest test suite for [test_store]. *)

-19

test/test_stores.ml

reviewed

··· 1 1 - (** Backend configs for the generic store test suite. *) 2 2 - 3 3 - let cleanup_path path = 4 4 - try Helpers.rm_rf path with Eio.Io _ | Sys_error _ -> () 5 5 - 6 6 - let run_git f = 7 7 - Eio_main.run @@ fun env -> 8 8 - Eio.Switch.run @@ fun sw -> 9 9 - let fs = Eio.Stdenv.fs env in 10 10 - let name = Fmt.str "/tmp/irmin-test-git-%d" (Random.int 1_000_000) in 11 11 - let path = Eio.Path.(fs / name) in 12 12 - Fun.protect 13 13 - ~finally:(fun () -> cleanup_path path) 14 14 - (fun () -> f (Irmin_git.init ~sw ~fs ~path:(Fpath.v name))) 15 15 - 16 16 - let git : Irmin_git.t Generic_store.config = 17 17 - Generic_store.make ~name:"git" ~run:run_git 18 18 - 19 19 - let suite = Generic_store.suite git

-2

test/test_stores.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** [suite] is the alcotest test suite covering all generic store backends. *)

-44

test/test_subtree.ml

reviewed

··· 1 1 - open Irmin 2 2 - open Private 3 3 - 4 4 - let test_split () = 5 5 - let backend = Backend.Memory.sha1 () in 6 6 - let store = Store.Git.create ~backend in 7 7 - let tree = Tree.Git.empty () in 8 8 - let tree = Tree.Git.add tree [ "sub"; "file.txt" ] "content" in 9 9 - let tree = Tree.Git.add tree [ "other.txt" ] "other" in 10 10 - let _hash = 11 11 - Store.Git.commit store ~tree ~parents:[] ~message:"initial" ~author:"test" 12 12 - in 13 13 - (* split should produce a store without crashing *) 14 14 - let _sub_store = Subtree.Git.split store ~prefix:[ "sub" ] in 15 15 - () 16 16 - 17 17 - let test_status_in_sync () = 18 18 - let backend1 = Backend.Memory.sha1 () in 19 19 - let store1 = Store.Git.create ~backend:backend1 in 20 20 - let backend2 = Backend.Memory.sha1 () in 21 21 - let store2 = Store.Git.create ~backend:backend2 in 22 22 - let tree = Tree.Git.empty () in 23 23 - let tree = Tree.Git.add tree [ "sub"; "a.txt" ] "content" in 24 24 - let h1 = 25 25 - Store.Git.commit store1 ~tree ~parents:[] ~message:"init" ~author:"test" 26 26 - in 27 27 - Store.Git.set_head store1 ~branch:"main" h1; 28 28 - let sub_tree = Tree.Git.empty () in 29 29 - let sub_tree = Tree.Git.add sub_tree [ "a.txt" ] "content" in 30 30 - let h2 = 31 31 - Store.Git.commit store2 ~tree:sub_tree ~parents:[] ~message:"init" 32 32 - ~author:"test" 33 33 - in 34 34 - Store.Git.set_head store2 ~branch:"main" h2; 35 35 - let status = Subtree.Git.status store1 ~prefix:[ "sub" ] ~external_:store2 in 36 36 - (* Accept any status - the key test is that it doesn't crash *) 37 37 - ignore status 38 38 - 39 39 - let suite = 40 40 - ( "subtree", 41 41 - [ 42 42 - Alcotest.test_case "split" `Quick test_split; 43 43 - Alcotest.test_case "status" `Quick test_status_in_sync; 44 44 - ] )

-2

test/test_subtree.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)

-207

test/test_tree.ml

reviewed

··· 1 1 - (* Tree tests — ported from upstream irmin src/irmin-test/store.ml (tree section) 2 2 - and test/irmin/test_tree.ml *) 3 3 - 4 4 - (* {1 Basic operations} *) 5 5 - 6 6 - let test_empty_tree () = 7 7 - let tree = Irmin.Tree.empty in 8 8 - Alcotest.(check (option string)) 9 9 - "find empty" None 10 10 - (Irmin.Tree.find tree [ "foo" ]) 11 11 - 12 12 - let test_add_find () = 13 13 - let tree = Irmin.Tree.empty in 14 14 - let tree = Irmin.Tree.add tree [ "foo"; "bar" ] "content" in 15 15 - Alcotest.(check (option string)) 16 16 - "find added" (Some "content") 17 17 - (Irmin.Tree.find tree [ "foo"; "bar" ]) 18 18 - 19 19 - let test_remove () = 20 20 - let tree = Irmin.Tree.empty in 21 21 - let tree = Irmin.Tree.add tree [ "foo" ] "content" in 22 22 - let tree = Irmin.Tree.remove tree [ "foo" ] in 23 23 - Alcotest.(check (option string)) 24 24 - "find removed" None 25 25 - (Irmin.Tree.find tree [ "foo" ]) 26 26 - 27 27 - let test_overwrite () = 28 28 - let tree = Irmin.Tree.empty in 29 29 - let tree = Irmin.Tree.add tree [ "key" ] "value1" in 30 30 - let tree = Irmin.Tree.add tree [ "key" ] "value2" in 31 31 - Alcotest.(check (option string)) 32 32 - "find overwritten" (Some "value2") 33 33 - (Irmin.Tree.find tree [ "key" ]) 34 34 - 35 35 - let test_nested () = 36 36 - let tree = Irmin.Tree.empty in 37 37 - let tree = Irmin.Tree.add tree [ "a"; "b"; "c" ] "deep" in 38 38 - let tree = Irmin.Tree.add tree [ "a"; "x" ] "shallow" in 39 39 - Alcotest.(check (option string)) 40 40 - "find deep" (Some "deep") 41 41 - (Irmin.Tree.find tree [ "a"; "b"; "c" ]); 42 42 - Alcotest.(check (option string)) 43 43 - "find shallow" (Some "shallow") 44 44 - (Irmin.Tree.find tree [ "a"; "x" ]) 45 45 - 46 46 - (* {1 List and ordering — from upstream test_trees / paginated bindings} *) 47 47 - 48 48 - let test_list_children () = 49 49 - let tree = Irmin.Tree.empty in 50 50 - let tree = Irmin.Tree.add tree [ "b" ] "2" in 51 51 - let tree = Irmin.Tree.add tree [ "a" ] "1" in 52 52 - let tree = Irmin.Tree.add tree [ "c" ] "3" in 53 53 - let children = Irmin.Tree.list tree [] in 54 54 - let names = List.map fst children in 55 55 - Alcotest.(check (list string)) "sorted" [ "a"; "b"; "c" ] names; 56 56 - List.iter 57 57 - (fun (_, kind) -> 58 58 - Alcotest.(check string) 59 59 - "leaf kind" "Contents" 60 60 - (match kind with `Contents -> "Contents" | `Node -> "Node")) 61 61 - children 62 62 - 63 63 - let test_list_subtrees () = 64 64 - let tree = Irmin.Tree.empty in 65 65 - let tree = Irmin.Tree.add tree [ "dir"; "file1" ] "a" in 66 66 - let tree = Irmin.Tree.add tree [ "dir"; "file2" ] "b" in 67 67 - let tree = Irmin.Tree.add tree [ "leaf" ] "c" in 68 68 - let children = Irmin.Tree.list tree [] in 69 69 - let kinds = List.map (fun (name, kind) -> (name, kind = `Node)) children in 70 70 - Alcotest.(check bool) "dir is node" true (List.assoc "dir" kinds); 71 71 - Alcotest.(check bool) "leaf is contents" false (List.assoc "leaf" kinds); 72 72 - let dir_children = Irmin.Tree.list tree [ "dir" ] in 73 73 - Alcotest.(check int) "dir has 2 children" 2 (List.length dir_children) 74 74 - 75 75 - let test_list_empty () = 76 76 - let tree = Irmin.Tree.empty in 77 77 - let children = Irmin.Tree.list tree [] in 78 78 - Alcotest.(check int) "empty tree list" 0 (List.length children); 79 79 - let children = Irmin.Tree.list tree [ "nonexistent" ] in 80 80 - Alcotest.(check int) "nonexistent path list" 0 (List.length children) 81 81 - 82 82 - (* {1 find_tree / add_tree — from upstream test_backend_nodes} *) 83 83 - 84 84 - let test_find_tree () = 85 85 - let tree = Irmin.Tree.empty in 86 86 - let tree = Irmin.Tree.add tree [ "a"; "b" ] "1" in 87 87 - let tree = Irmin.Tree.add tree [ "a"; "c" ] "2" in 88 88 - let sub = Irmin.Tree.find_tree tree [ "a" ] in 89 89 - Alcotest.(check bool) "subtree exists" true (Option.is_some sub); 90 90 - let sub = Option.get sub in 91 91 - Alcotest.(check (option string)) 92 92 - "subtree find" (Some "1") 93 93 - (Irmin.Tree.find sub [ "b" ]); 94 94 - Alcotest.(check (option string)) 95 95 - "subtree find 2" (Some "2") 96 96 - (Irmin.Tree.find sub [ "c" ]) 97 97 - 98 98 - let test_find_tree_leaf () = 99 99 - let tree = Irmin.Tree.empty in 100 100 - let tree = Irmin.Tree.add tree [ "a" ] "value" in 101 101 - let sub = Irmin.Tree.find_tree tree [ "a" ] in 102 102 - Alcotest.(check bool) "leaf is not a subtree" true (Option.is_none sub) 103 103 - 104 104 - let test_add_tree () = 105 105 - let tree = Irmin.Tree.empty in 106 106 - let sub = Irmin.Tree.empty in 107 107 - let sub = Irmin.Tree.add sub [ "x" ] "1" in 108 108 - let sub = Irmin.Tree.add sub [ "y" ] "2" in 109 109 - let tree = Irmin.Tree.add_tree tree [ "dir" ] sub in 110 110 - Alcotest.(check (option string)) 111 111 - "grafted subtree" (Some "1") 112 112 - (Irmin.Tree.find tree [ "dir"; "x" ]); 113 113 - Alcotest.(check (option string)) 114 114 - "grafted subtree 2" (Some "2") 115 115 - (Irmin.Tree.find tree [ "dir"; "y" ]) 116 116 - 117 117 - let test_add_tree_replace () = 118 118 - let tree = Irmin.Tree.empty in 119 119 - let tree = Irmin.Tree.add tree [ "dir"; "old" ] "old_content" in 120 120 - let sub = Irmin.Tree.empty in 121 121 - let sub = Irmin.Tree.add sub [ "new" ] "new_content" in 122 122 - let tree = Irmin.Tree.add_tree tree [ "dir" ] sub in 123 123 - Alcotest.(check (option string)) 124 124 - "old content gone" None 125 125 - (Irmin.Tree.find tree [ "dir"; "old" ]); 126 126 - Alcotest.(check (option string)) 127 127 - "new content present" (Some "new_content") 128 128 - (Irmin.Tree.find tree [ "dir"; "new" ]) 129 129 - 130 130 - (* {1 Remove edge cases — from upstream} *) 131 131 - 132 132 - let test_remove_nonexistent () = 133 133 - let tree = Irmin.Tree.empty in 134 134 - let tree = Irmin.Tree.add tree [ "a" ] "1" in 135 135 - let tree' = Irmin.Tree.remove tree [ "b" ] in 136 136 - Alcotest.(check (option string)) 137 137 - "unchanged after remove nonexistent" (Some "1") 138 138 - (Irmin.Tree.find tree' [ "a" ]) 139 139 - 140 140 - let test_remove_subtree () = 141 141 - let tree = Irmin.Tree.empty in 142 142 - let tree = Irmin.Tree.add tree [ "a"; "b" ] "1" in 143 143 - let tree = Irmin.Tree.add tree [ "a"; "c" ] "2" in 144 144 - let tree = Irmin.Tree.remove tree [ "a"; "b" ] in 145 145 - Alcotest.(check (option string)) 146 146 - "sibling intact" (Some "2") 147 147 - (Irmin.Tree.find tree [ "a"; "c" ]); 148 148 - Alcotest.(check (option string)) 149 149 - "removed" None 150 150 - (Irmin.Tree.find tree [ "a"; "b" ]) 151 151 - 152 152 - (* {1 Deep nesting} *) 153 153 - 154 154 - let test_deep_nesting () = 155 155 - let tree = Irmin.Tree.empty in 156 156 - let path = [ "a"; "b"; "c"; "d"; "e"; "f"; "g"; "h" ] in 157 157 - let tree = Irmin.Tree.add tree path "deep_value" in 158 158 - Alcotest.(check (option string)) 159 159 - "deep find" (Some "deep_value") 160 160 - (Irmin.Tree.find tree path); 161 161 - let sub = Irmin.Tree.find_tree tree [ "a"; "b"; "c" ] in 162 162 - Alcotest.(check bool) "deep subtree" true (Option.is_some sub); 163 163 - let sub = Option.get sub in 164 164 - Alcotest.(check (option string)) 165 165 - "relative find" (Some "deep_value") 166 166 - (Irmin.Tree.find sub [ "d"; "e"; "f"; "g"; "h" ]) 167 167 - 168 168 - (* {1 Many entries — inspired by upstream test_wide_nodes} *) 169 169 - 170 170 - let test_many_entries () = 171 171 - let tree = Irmin.Tree.empty in 172 172 - let n = 1000 in 173 173 - let tree = 174 174 - List.init n (fun i -> (Fmt.str "key_%04d" i, Fmt.str "val_%d" i)) 175 175 - |> List.fold_left (fun t (k, v) -> Irmin.Tree.add t [ k ] v) tree 176 176 - in 177 177 - let children = Irmin.Tree.list tree [] in 178 178 - Alcotest.(check int) "1000 entries" n (List.length children); 179 179 - (* Check lexicographic ordering *) 180 180 - let names = List.map fst children in 181 181 - let sorted = List.sort String.compare names in 182 182 - Alcotest.(check (list string)) "sorted order" sorted names; 183 183 - (* Spot check *) 184 184 - Alcotest.(check (option string)) 185 185 - "find 500th" (Some "val_500") 186 186 - (Irmin.Tree.find tree [ "key_0500" ]) 187 187 - 188 188 - let suite = 189 189 - ( "tree", 190 190 - [ 191 191 - Alcotest.test_case "empty tree" `Quick test_empty_tree; 192 192 - Alcotest.test_case "add/find" `Quick test_add_find; 193 193 - Alcotest.test_case "remove" `Quick test_remove; 194 194 - Alcotest.test_case "overwrite" `Quick test_overwrite; 195 195 - Alcotest.test_case "nested" `Quick test_nested; 196 196 - Alcotest.test_case "list children" `Quick test_list_children; 197 197 - Alcotest.test_case "list subtrees" `Quick test_list_subtrees; 198 198 - Alcotest.test_case "list empty" `Quick test_list_empty; 199 199 - Alcotest.test_case "find_tree" `Quick test_find_tree; 200 200 - Alcotest.test_case "find_tree leaf" `Quick test_find_tree_leaf; 201 201 - Alcotest.test_case "add_tree" `Quick test_add_tree; 202 202 - Alcotest.test_case "add_tree replace" `Quick test_add_tree_replace; 203 203 - Alcotest.test_case "remove nonexistent" `Quick test_remove_nonexistent; 204 204 - Alcotest.test_case "remove subtree" `Quick test_remove_subtree; 205 205 - Alcotest.test_case "deep nesting" `Quick test_deep_nesting; 206 206 - Alcotest.test_case "many entries" `Quick test_many_entries; 207 207 - ] )

-2

test/test_tree.mli

reviewed

··· 1 1 - val suite : string * unit Alcotest.test_case list 2 2 - (** Test suite. *)