an atproto pds written in F# (.NET 9) 馃
desertthunder.dev
pds
fsharp
giraffe
dotnet
atproto
1namespace PDSharp.Core
2
3open System
4open System.IO
5
6/// CARv1 (Content Addressable aRchives) writer module
7/// Implements the CAR format per https://ipld.io/specs/transport/car/carv1/
8module Car =
9 /// Encode an unsigned integer as LEB128 varint
10 let encodeVarint (value : int) : byte[] =
11 if value < 0 then
12 failwith "Varint value must be non-negative"
13 elif value = 0 then
14 [| 0uy |]
15 else
16 use ms = new MemoryStream()
17 let mutable v = value
18
19 while v > 0 do
20 let mutable b = byte (v &&& 0x7F)
21 v <- v >>> 7
22
23 if v > 0 then
24 b <- b ||| 0x80uy
25
26 ms.WriteByte(b)
27
28 ms.ToArray()
29
30 /// Create CAR header as DAG-CBOR encoded bytes
31 /// Header format: { version: 1, roots: [CID, ...] }
32 let createHeader (roots : Cid list) : byte[] =
33 let headerMap =
34 Map.ofList [ ("roots", box (roots |> List.map box)); ("version", box 1) ]
35
36 DagCbor.encode headerMap
37
38 /// Encode a single block section: varint(len) | CID bytes | block data
39 let encodeBlock (cid : Cid) (data : byte[]) : byte[] =
40 let cidBytes = cid.Bytes
41 let sectionLen = cidBytes.Length + data.Length
42 let varintBytes = encodeVarint sectionLen
43
44 use ms = new MemoryStream()
45 ms.Write(varintBytes, 0, varintBytes.Length)
46 ms.Write(cidBytes, 0, cidBytes.Length)
47 ms.Write(data, 0, data.Length)
48 ms.ToArray()
49
50 /// Create a complete CARv1 file from roots and blocks
51 /// CAR format: [varint | header] [varint | CID | block]...
52 let createCar (roots : Cid list) (blocks : (Cid * byte[]) seq) : byte[] =
53 use ms = new MemoryStream()
54
55 let headerBytes = createHeader roots
56 let headerVarint = encodeVarint headerBytes.Length
57 ms.Write(headerVarint, 0, headerVarint.Length)
58 ms.Write(headerBytes, 0, headerBytes.Length)
59
60 for cid, data in blocks do
61 let blockSection = encodeBlock cid data
62 ms.Write(blockSection, 0, blockSection.Length)
63
64 ms.ToArray()
65
66 /// Create a CAR from a single root with an async block fetcher
67 let createCarAsync (roots : Cid list) (getBlock : Cid -> Async<byte[] option>) (allCids : Cid seq) = async {
68 use ms = new MemoryStream()
69
70 let headerBytes = createHeader roots
71 let headerVarint = encodeVarint headerBytes.Length
72 ms.Write(headerVarint, 0, headerVarint.Length)
73 ms.Write(headerBytes, 0, headerBytes.Length)
74
75 for cid in allCids do
76 let! dataOpt = getBlock cid
77
78 match dataOpt with
79 | Some data ->
80 let blockSection = encodeBlock cid data
81 ms.Write(blockSection, 0, blockSection.Length)
82 | None -> ()
83
84 return ms.ToArray()
85 }