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 typed_json_ref =
4 { type': string [@key "$type"]
5 ; ref: Cid.t
6 ; mime_type: string [@key "mimeType"]
7 ; size: int64 }
8[@@deriving yojson]
9
10type untyped_json_ref = {cid: string; mime_type: string [@key "mimeType"]}
11
12type json_ref = Typed of typed_json_ref | Untyped of untyped_json_ref
13
14type t = {original: json_ref; ref: Cid.t; mime_type: string; size: int64}
15
16let of_yojson json =
17 let open Yojson.Safe.Util in
18 let assoc = to_assoc json in
19 try
20 if List.mem_assoc "$type" assoc then
21 let type' = assoc |> List.assoc "$type" |> to_string in
22 if type' = "blob" then
23 let ref = assoc |> List.assoc "ref" |> Cid.of_yojson |> Result.get_ok in
24 let mime_type = assoc |> List.assoc "mimeType" |> to_string in
25 let maybe_size = assoc |> List.assoc "size" in
26 let size =
27 match maybe_size with
28 | `Int i ->
29 Int64.of_int i
30 | `Intlit i ->
31 Int64.of_string i
32 | _ ->
33 0L
34 in
35 Typed {type'; ref; mime_type; size}
36 else failwith "invalid $type"
37 else
38 let cid = assoc |> List.assoc "cid" |> to_string in
39 let mime_type = assoc |> List.assoc "mimeType" |> to_string in
40 Untyped {cid; mime_type}
41 with e ->
42 invalid_arg
43 (Printf.sprintf "of_yojson: invalid blob ref (%s)" (Printexc.to_string e))
44
45let to_yojson blob =
46 let json =
47 match blob.original with
48 | Typed {type'; ref; mime_type; size} ->
49 `Assoc
50 [ ("$type", `String type')
51 ; ("ref", Cid.to_yojson ref)
52 ; ("mimeType", `String mime_type)
53 ; ("size", `Int size) ]
54 | Untyped {cid; mime_type} ->
55 `Assoc [("cid", `String cid); ("mimeType", `String mime_type)]
56 in
57 json
58
59let of_json_ref json =
60 match json with
61 | Typed {ref; mime_type; size; _} ->
62 {original= json; ref; mime_type; size}
63 | Untyped {cid; mime_type} ->
64 { original= json
65 ; ref= Result.get_ok @@ Cid.of_string cid
66 ; mime_type
67 ; size= 0L }
68
69let to_ipld blob : Dag_cbor.value String_map.t =
70 String_map.of_list
71 [ ("$type", `String "blob")
72 ; ("ref", `Link blob.ref)
73 ; ("mimeType", `String blob.mime_type)
74 ; ("size", `Integer blob.size) ]
75
76let of_ipld (ipld : Dag_cbor.value) =
77 match ipld with
78 | `Map m -> (
79 try
80 if String_map.mem "$type" m then
81 let type' =
82 match String_map.find "$type" m with
83 | `String "blob" ->
84 "blob"
85 | _ ->
86 invalid_arg "of_ipld: invalid blob ref $type"
87 in
88 let ref =
89 match String_map.find "ref" m with
90 | `Link ref ->
91 ref
92 | _ ->
93 invalid_arg "of_ipld: invalid blob ref ref"
94 in
95 let mime_type =
96 match String_map.find "mimeType" m with
97 | `String mime_type ->
98 mime_type
99 | _ ->
100 invalid_arg "of_ipld: invalid blob ref mimeType"
101 in
102 let size =
103 match String_map.find "size" m with
104 | `Integer size ->
105 size
106 | _ ->
107 invalid_arg "of_ipld: invalid blob ref size"
108 in
109 of_json_ref (Typed {type'; ref; mime_type; size})
110 else if String_map.mem "cid" m then
111 let cid =
112 match String_map.find "cid" m with
113 | `String cid ->
114 cid
115 | _ ->
116 invalid_arg "of_ipld: invalid blob ref cid"
117 in
118 let mime_type =
119 match String_map.find "mimeType" m with
120 | `String mime_type ->
121 mime_type
122 | _ ->
123 invalid_arg "of_ipld: invalid blob ref mimeType"
124 in
125 of_json_ref (Untyped {cid; mime_type})
126 else invalid_arg "of_ipld: invalid blob ref"
127 with
128 | Not_found ->
129 invalid_arg "of_ipld: incomplete blob ref"
130 | _ ->
131 invalid_arg "of_ipld: invalid blob ref" )
132 | _ ->
133 invalid_arg "of_ipld: invalid blob ref"