objective categorical abstract machine language personal data server
CAR attempt
+161
-3
+3
-1
dune-project
+3
-1
dune-project
···
40
40
(package
41
41
(name ipld)
42
42
(synopsis "A DASL-compliant implementation of some IPLD formats")
43
-
(description "Currently includes DAG-CBOR and CIDv1")
43
+
(description "Currently includes DAG-CBOR, CIDv1, and CARv1")
44
44
(allow_empty)
45
45
(depends
46
46
ocaml
47
47
dune
48
48
(base64 (>= 3.5.1))
49
49
(digestif (>= 1.2.0))
50
+
lwt
50
51
(multibase (>= 0.1.0))
51
52
(yojson (>= 3.0.0))
53
+
(lwt_ppx (>= 5.9.1))
52
54
(alcotest :with-test)))
+3
-1
ipld.opam
+3
-1
ipld.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
3
synopsis: "A DASL-compliant implementation of some IPLD formats"
4
-
description: "Currently includes DAG-CBOR and CIDv1"
4
+
description: "Currently includes DAG-CBOR, CIDv1, and CARv1"
5
5
maintainer: ["futurGH"]
6
6
authors: ["futurGH"]
7
7
license: "MPL-2.0"
···
12
12
"dune" {>= "3.14"}
13
13
"base64" {>= "3.5.1"}
14
14
"digestif" {>= "1.2.0"}
15
+
"lwt"
15
16
"multibase" {>= "0.1.0"}
16
17
"yojson" {>= "3.0.0"}
18
+
"lwt_ppx" {>= "5.9.1"}
17
19
"alcotest" {with-test}
18
20
"odoc" {with-doc}
19
21
]
+152
ipld/lib/car.ml
+152
ipld/lib/car.ml
···
1
+
(* varint encoding/decoding; ripped from https://github.com/chrisdickinson/varint *)
2
+
module Varint = struct
3
+
let bytes = ref 0
4
+
5
+
let msb = 0x80
6
+
7
+
let rest = 0x7F
8
+
9
+
let msball = lnot rest
10
+
11
+
let int_threshold = 1 lsl 31
12
+
13
+
let encode (n0 : int) : bytes =
14
+
if n0 < 0 then (
15
+
bytes := 0 ;
16
+
failwith "negative numbers not supported" ) ;
17
+
let num = ref n0 in
18
+
let buf = Buffer.create 10 in
19
+
let offset = ref 0 in
20
+
while !num >= int_threshold do
21
+
let byte = !num land 0xFF lor msb in
22
+
Buffer.add_char buf (Char.chr (byte land 0xFF)) ;
23
+
incr offset ;
24
+
num := !num / 128
25
+
done ;
26
+
while !num land msball <> 0 do
27
+
let byte = !num land 0xFF lor msb in
28
+
Buffer.add_char buf (Char.chr (byte land 0xFF)) ;
29
+
incr offset ;
30
+
num := !num lsr 7
31
+
done ;
32
+
let last = !num in
33
+
Buffer.add_char buf (Char.chr (last land 0xFF)) ;
34
+
incr offset ;
35
+
bytes := !offset ;
36
+
Bytes.unsafe_of_string (Buffer.contents buf)
37
+
38
+
let decode buf =
39
+
let l = Bytes.length buf in
40
+
let rec aux res shift counter =
41
+
if counter >= l || shift > 49 then failwith "could not decode varint"
42
+
else
43
+
let b = Bytes.get_uint8 buf counter in
44
+
let new_res =
45
+
if shift < 28 then res + ((b land rest) lsl shift)
46
+
else res + (b land rest * (1 lsl shift))
47
+
in
48
+
let new_counter = counter + 1 in
49
+
let new_shift = shift + 7 in
50
+
if b >= msb then aux new_res new_shift new_counter
51
+
else (new_res, new_counter)
52
+
in
53
+
let result, final_counter = aux 0 0 0 in
54
+
(result, final_counter)
55
+
end
56
+
57
+
(* converts a series of mst blocks into a car stream *)
58
+
let blocks_to_stream (root : Cid.t option) (blocks : (Cid.t * bytes) Lwt_seq.t)
59
+
: bytes Lwt_seq.t =
60
+
let header =
61
+
Dag_cbor.encode
62
+
(`Map
63
+
(Dag_cbor.StringMap.of_list
64
+
[ ("version", `Integer 1L)
65
+
; ( "roots"
66
+
, `Array
67
+
(match root with None -> [||] | Some root -> [|`Link root|])
68
+
) ] ) )
69
+
in
70
+
let seq = Lwt_seq.of_list [Varint.encode (Bytes.length header); header] in
71
+
Lwt_seq.append seq
72
+
(Lwt_seq.flat_map
73
+
(fun (cid, block) ->
74
+
Lwt_seq.of_list
75
+
[ Varint.encode
76
+
((cid |> Cid.to_bytes |> Bytes.length) + Bytes.length block)
77
+
; cid.bytes
78
+
; block ] )
79
+
blocks )
80
+
81
+
(* converts a series of mst blocks into a car file *)
82
+
let blocks_to_car (root : Cid.t option) (blocks : (Cid.t * bytes) Lwt_seq.t) :
83
+
bytes Lwt.t =
84
+
let stream = blocks_to_stream root blocks in
85
+
let buf = Buffer.create 1024 in
86
+
let%lwt () = Lwt_seq.iter (Buffer.add_bytes buf) stream in
87
+
Lwt.return (Buffer.to_bytes buf)
88
+
89
+
(* reads a car stream into a serialized mst
90
+
returns (roots, blocks) *)
91
+
let read_car_stream (stream : bytes Lwt_seq.t) :
92
+
(Cid.t list * (Cid.t * bytes) Lwt_seq.t) Lwt.t =
93
+
let buf = Buffer.create 1024 in
94
+
let%lwt () = Lwt_seq.iter (Buffer.add_bytes buf) stream in
95
+
let bytes = Buffer.to_bytes buf in
96
+
let bytes_len = Bytes.length bytes in
97
+
let pos = ref 0 in
98
+
let read_varint () =
99
+
if !pos >= bytes_len then None
100
+
else
101
+
let n, used = Varint.decode (Bytes.sub bytes !pos (bytes_len - !pos)) in
102
+
pos := !pos + used ;
103
+
Some n
104
+
in
105
+
let read_bytes n =
106
+
if !pos + n > bytes_len then failwith "unexpected end of car stream"
107
+
else
108
+
let b = Bytes.sub bytes !pos n in
109
+
pos := !pos + n ;
110
+
b
111
+
in
112
+
let header_size =
113
+
match read_varint () with
114
+
| None ->
115
+
failwith "could not parse car header"
116
+
| Some n ->
117
+
n
118
+
in
119
+
let header_bytes = read_bytes header_size in
120
+
let header = Dag_cbor.decode header_bytes in
121
+
let roots =
122
+
match header with
123
+
| `Map m -> (
124
+
let roots_v =
125
+
try Some (Dag_cbor.StringMap.find "roots" m) with Not_found -> None
126
+
in
127
+
match roots_v with
128
+
| Some (`Array arr) ->
129
+
Array.fold_right
130
+
(fun v acc -> match v with `Link cid -> cid :: acc | _ -> acc)
131
+
arr []
132
+
| _ ->
133
+
[] )
134
+
| _ ->
135
+
[]
136
+
in
137
+
let rec read_blocks acc =
138
+
if !pos >= bytes_len then List.rev acc
139
+
else
140
+
match read_varint () with
141
+
| None ->
142
+
List.rev acc
143
+
| Some block_size ->
144
+
if block_size <= 0 then read_blocks acc
145
+
else
146
+
let block_bytes = read_bytes block_size in
147
+
let cid, remainder = Cid.decode_first block_bytes in
148
+
read_blocks ((cid, remainder) :: acc)
149
+
in
150
+
let blocks_list = read_blocks [] in
151
+
let blocks_seq = Lwt_seq.of_list blocks_list in
152
+
Lwt.return (roots, blocks_seq)