8bit.lol
forked from
futur.blue/pegasus
objective categorical abstract machine language personal data server
futur.blue
1module String_map = Dag_cbor.String_map
2
3type value =
4 [ Dag_cbor.value
5 | `BlobRef of Blob_ref.t
6 | `LexArray of value Array.t
7 | `LexMap of value String_map.t ]
8
9let rec to_ipld (v : value) : Dag_cbor.value =
10 match v with
11 | `BlobRef r -> (
12 match r.original with
13 | Typed {ref; mime_type; size; _} ->
14 `Map
15 (String_map.of_list
16 [ ("$type", `String "blob")
17 ; ("ref", `Link ref)
18 ; ("mimeType", `String mime_type)
19 ; ("size", `Integer size) ] )
20 | Untyped {cid; mime_type} ->
21 `Map
22 (String_map.of_list
23 [("cid", `String cid); ("mimeType", `String mime_type)] ) )
24 | `LexArray a ->
25 `Array (Array.map to_ipld a)
26 | `LexMap m ->
27 `Map (String_map.map to_ipld m)
28 | `Boolean b ->
29 `Boolean b
30 | `Integer i ->
31 `Integer i
32 | `Float f ->
33 `Float f
34 | `Bytes b ->
35 `Bytes b
36 | `String s ->
37 `String s
38 | `Array a ->
39 `Array a
40 | `Map m ->
41 `Map m
42 | `Link l ->
43 `Link l
44 | `Null ->
45 `Null
46
47let rec of_ipld (v : Dag_cbor.value) : value =
48 match v with
49 | `Map m ->
50 if
51 (String_map.mem "$type" m && String_map.find "$type" m = `String "blob")
52 || (String_map.mem "cid" m && String_map.mem "mimeType" m)
53 then `BlobRef (Blob_ref.of_ipld (`Map m))
54 else `LexMap (String_map.map of_ipld m)
55 | `Array a ->
56 `LexArray (Array.map of_ipld a)
57 | `Boolean b ->
58 `Boolean b
59 | `Integer i ->
60 `Integer i
61 | `Float f ->
62 `Float f
63 | `Bytes b ->
64 `Bytes b
65 | `String s ->
66 `String s
67 | `Link l ->
68 `Link l
69 | `Null ->
70 `Null
71
72let to_cbor_block obj =
73 let ipld = to_ipld obj in
74 let encoded = Dag_cbor.encode ipld in
75 let cid = Cid.create Dcbor encoded in
76 (cid, encoded)
77
78let of_yojson (v : Yojson.Safe.t) : value = of_ipld (Dag_cbor.of_yojson v)
79
80let to_yojson (v : value) : Yojson.Safe.t = Dag_cbor.to_yojson (to_ipld v)
81
82type repo_record =
83 (value String_map.t
84 [@of_yojson
85 fun v ->
86 match of_yojson v with
87 | `LexMap m ->
88 Ok m
89 | _ ->
90 Error "decoded non-map value"]
91 [@to_yojson fun v -> to_yojson (`LexMap v)] )
92[@@deriving yojson]
93
94let repo_record_to_string (record : repo_record) =
95 record |> repo_record_to_yojson |> Yojson.Safe.to_string
96
97let repo_record_to_cbor_block (record : repo_record) =
98 to_cbor_block (`LexMap record)
99
100let of_cbor encoded : repo_record =
101 let decoded = Dag_cbor.decode encoded in
102 match of_ipld decoded with
103 | `LexMap m ->
104 m
105 | _ ->
106 raise (Failure "Decoded non-record value")