host-persist: content-addressed blob adapter — Blocker CLOSED
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s

blob/put|get|has? backed by <root>/blobs/<cid>, CIDv1 (raw codec,
sha2-256 via Sx_cid/Sx_sha2). put idempotent; persist stores only the
{:cid :size :mime} ref. persist_durable_test.sh extended (8/8): blob
round-trip + content-address idempotency + bytes/ref surviving real
restart. Mock blob suite 14/0 on worktree binary. Durable-storage
Blocker now CLOSED.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-06 22:56:27 +00:00
parent c6c2cebf98
commit 95e981eb03
3 changed files with 84 additions and 9 deletions

View File

@@ -45,6 +45,7 @@ let rec ensure_dir dir =
let streams_dir () = Filename.concat (root_dir ()) "streams"
let kv_dir () = Filename.concat (root_dir ()) "kv"
let blobs_dir () = Filename.concat (root_dir ()) "blobs"
let read_file path =
let ic = open_in_bin path in
@@ -227,6 +228,32 @@ let do_kv_keys () =
|> List.sort String.compare
|> List.map (fun s -> String s))
(* ---- blob store (content-addressed) ------------------------------------ *)
(* Same pattern as the persist ops, but a SEPARATE adapter: large objects live
in a content-addressed directory keyed by a CIDv1 (raw codec, sha2-256).
persist only ever stores the returned ref ({:cid :size :mime}), never bytes.
blob/put is idempotent — identical bytes hash to the same cid + same file. *)
let codec_raw = 0x55
let blob_cid bytes =
let digest = Sx_cid.unhex (Sx_sha2.sha256_hex bytes) in
Sx_cid.cidv1 codec_raw (Sx_cid.multihash Sx_cid.mh_sha2_256 digest)
let blob_path cid = Filename.concat (blobs_dir ()) cid
let do_blob_put bytes =
let cid = blob_cid bytes in
let p = blob_path cid in
if not (Sys.file_exists p) then write_file_atomic p bytes;
String cid
let do_blob_get cid =
let p = blob_path cid in
if Sys.file_exists p then String (read_file p) else Nil
let do_blob_has cid = Bool (Sys.file_exists (blob_path cid))
(* ---- dispatch ---------------------------------------------------------- *)
let arglist = function
@@ -257,4 +284,10 @@ let handle_op op args =
| "persist/kv-has?" ->
(match a with key :: _ -> Some (do_kv_has (str key)) | _ -> Some (Bool false))
| "persist/kv-keys" -> Some (do_kv_keys ())
| "blob/put" ->
(match a with bytes :: _ -> Some (do_blob_put (str bytes)) | _ -> Some Nil)
| "blob/get" ->
(match a with cid :: _ -> Some (do_blob_get (str cid)) | _ -> Some Nil)
| "blob/has?" ->
(match a with cid :: _ -> Some (do_blob_has (str cid)) | _ -> Some (Bool false))
| _ -> None