futur.blue
objective categorical abstract machine language personal data server
Move repository to pegasus, remove unused deps
+11
-10
dune-project
+11
-10
dune-project
···
15
(synopsis "An atproto Personal Data Server implementation")
16
(description "Eventually")
17
(allow_empty)
18
-
(depends ocaml dune))
19
20
(package
21
(name mist)
···
24
(depends
25
ocaml
26
dune
27
(core_unix (>= 0.17.1))
28
-
(cborl (>= 0.1.0))
29
-
(cid (>= 0.1.0))
30
-
(hacl-star (>= 0.7.2))
31
-
lwt
32
-
(mtime (>= 2.1.0))
33
-
(multihash (>= 0.1.0))
34
(re (>= 1.13.2))
35
(yojson (>= 3.0.0))
36
(lwt_ppx (>= 5.9.1))
···
45
(depends
46
ocaml
47
dune
48
-
(base64 (>= 3.5.1))
49
-
(digestif (>= 1.2.0))
50
lwt
51
-
(multibase (>= 0.1.0))
52
(yojson (>= 3.0.0))
53
(lwt_ppx (>= 5.9.1))
54
(alcotest :with-test)))
···
15
(synopsis "An atproto Personal Data Server implementation")
16
(description "Eventually")
17
(allow_empty)
18
+
(depends
19
+
ocaml
20
+
dune
21
+
lwt
22
+
(re (>= 1.13.2))
23
+
(yojson (>= 3.0.0))
24
+
(lwt_ppx (>= 5.9.1))
25
+
(ppx_deriving_yojson (>= 3.9.1))
26
+
(alcotest :with-test)))
27
28
(package
29
(name mist)
···
32
(depends
33
ocaml
34
dune
35
+
lwt
36
(core_unix (>= 0.17.1))
37
(re (>= 1.13.2))
38
(yojson (>= 3.0.0))
39
(lwt_ppx (>= 5.9.1))
···
48
(depends
49
ocaml
50
dune
51
lwt
52
+
(digestif (>= 1.2.0))
53
(yojson (>= 3.0.0))
54
(lwt_ppx (>= 5.9.1))
55
(alcotest :with-test)))
-2
ipld.opam
-2
ipld.opam
+1
-1
ipld/lib/dune
+1
-1
ipld/lib/dune
-5
mist.opam
-5
mist.opam
-3
mist/lib/dune
-3
mist/lib/dune
+3
-9
mist/lib/repository.ml
pegasus/lib/repository.ml
+3
-9
mist/lib/repository.ml
pegasus/lib/repository.ml
···
1
type commit =
2
{ did: string
3
; version: int (* always 3 *)
···
36
type signing_key = P256 of bytes | K256 of bytes
37
38
module Make (Store : Storage.Writable_blockstore) = struct
39
-
type store = Store.t
40
-
41
-
let read_commit store cid : (signed_commit, string) Lwt_result.t =
42
-
let%lwt bytes = Store.get_bytes store cid in
43
-
match bytes with
44
-
| Some b ->
45
-
b |> Dag_cbor.decode_to_yojson |> signed_commit_of_yojson |> Lwt.return
46
-
| None ->
47
-
Lwt.return_error ("commit not found in blockstore: " ^ Cid.to_string cid)
48
end
+18
-7
mist/test/test_mst.ml
+18
-7
mist/test/test_mst.ml
···
1
open Mist
2
open Lwt.Infix
3
module MemMst = Mst.Make (Storage.Memory_blockstore)
4
-
module MemRepo = Repository.Make (Storage.Memory_blockstore)
5
module StringMap = Dag_cbor.StringMap
6
7
let cid_of_string_exn s =
···
826
in
827
let store = Storage.Memory_blockstore.create ~blocks:bm () in
828
let%lwt commit =
829
-
MemRepo.read_commit store root
830
-
>|= function Ok commit -> commit | Error msg -> failwith msg
831
in
832
-
let mst = MemMst.create store commit.data in
833
Lwt.return (commit, mst)
834
in
835
let%lwt ic = Lwt_io.open_file ~mode:Lwt_io.input "sample.car" in
···
837
let%lwt () = Lwt_io.close ic in
838
let%lwt commit, mst = mst_of_car_bytes car in
839
let mst_stream = MemMst.to_blocks_stream mst in
840
-
let commit_bytes =
841
-
Dag_cbor.encode_yojson (Repository.signed_commit_to_yojson commit)
842
-
in
843
let commit_cid = Cid.create Dcbor commit_bytes in
844
let%lwt car' =
845
Car.blocks_to_car (Some commit_cid)
···
1
open Mist
2
open Lwt.Infix
3
module MemMst = Mst.Make (Storage.Memory_blockstore)
4
module StringMap = Dag_cbor.StringMap
5
6
let cid_of_string_exn s =
···
825
in
826
let store = Storage.Memory_blockstore.create ~blocks:bm () in
827
let%lwt commit =
828
+
match%lwt Storage.Memory_blockstore.get_bytes store root with
829
+
| Some b -> (
830
+
match Dag_cbor.decode b with
831
+
| `Map commit ->
832
+
Lwt.return commit
833
+
| _ ->
834
+
failwith "non-object commit" )
835
+
| None ->
836
+
failwith "root not found in blockstore"
837
in
838
+
let mst =
839
+
MemMst.create store
840
+
( match StringMap.find "data" commit with
841
+
| `Link cid ->
842
+
cid
843
+
| _ ->
844
+
failwith "non-cid data in commit" )
845
+
in
846
Lwt.return (commit, mst)
847
in
848
let%lwt ic = Lwt_io.open_file ~mode:Lwt_io.input "sample.car" in
···
850
let%lwt () = Lwt_io.close ic in
851
let%lwt commit, mst = mst_of_car_bytes car in
852
let mst_stream = MemMst.to_blocks_stream mst in
853
+
let commit_bytes = Dag_cbor.encode (`Map commit) in
854
let commit_cid = Cid.create Dcbor commit_bytes in
855
let%lwt car' =
856
Car.blocks_to_car (Some commit_cid)
+6
pegasus.opam
+6
pegasus.opam
+15
-1
pegasus/lib/dune
+15
-1
pegasus/lib/dune