feat: CARv1 writer

* add CID parsing utilities

PDSharp.Core/BlockStore.fs

···
     abstract member Get : Cid -> Async<byte[] option>
     abstract member Put : byte[] -> Async<Cid>
     abstract member Has : Cid -> Async<bool>
+    abstract member GetAllCidsAndData : unit -> Async<(Cid * byte[]) list>
 
   /// In-memory implementation of IBlockStore for testing
   type MemoryBlockStore() =
-    let store = ConcurrentDictionary<string, byte[]>()
+    let store = ConcurrentDictionary<string, (Cid * byte[])>()
 
     let cidKey (cid : Cid) =
       System.Convert.ToBase64String(cid.Bytes)
···
     interface IBlockStore with
       member _.Get(cid : Cid) = async {
         let key = cidKey cid
-        let success, data = store.TryGetValue(key)
-        return if success then Some data else None
+
+        match store.TryGetValue(key) with
+        | true, (_, data) -> return Some data
+        | false, _ -> return None
       }
 
       member _.Put(data : byte[]) = async {
         let hash = Crypto.sha256 data
         let cid = Cid.FromHash hash
         let key = cidKey cid
-        store.[key] <- data
+        store.[key] <- (cid, data)
         return cid
       }
 
···
         let key = cidKey cid
         return store.ContainsKey(key)
       }
+
+      member _.GetAllCidsAndData() = async { return store.Values |> Seq.toList }
 
     /// Get the number of blocks stored (for testing)
     member _.Count = store.Count

PDSharp.Core/Car.fs

···
+namespace PDSharp.Core
+
+open System
+open System.IO
+
+/// CARv1 (Content Addressable aRchives) writer module
+/// Implements the CAR format per https://ipld.io/specs/transport/car/carv1/
+module Car =
+  /// Encode an unsigned integer as LEB128 varint
+  let encodeVarint (value : int) : byte[] =
+    if value < 0 then
+      failwith "Varint value must be non-negative"
+    elif value = 0 then
+      [| 0uy |]
+    else
+      use ms = new MemoryStream()
+      let mutable v = value
+
+      while v > 0 do
+        let mutable b = byte (v &&& 0x7F)
+        v <- v >>> 7
+
+        if v > 0 then
+          b <- b ||| 0x80uy
+
+        ms.WriteByte(b)
+
+      ms.ToArray()
+
+  /// Create CAR header as DAG-CBOR encoded bytes
+  /// Header format: { version: 1, roots: [CID, ...] }
+  let createHeader (roots : Cid list) : byte[] =
+    let headerMap =
+      Map.ofList [ ("roots", box (roots |> List.map box)); ("version", box 1) ]
+
+    DagCbor.encode headerMap
+
+  /// Encode a single block section: varint(len) | CID bytes | block data
+  let encodeBlock (cid : Cid) (data : byte[]) : byte[] =
+    let cidBytes = cid.Bytes
+    let sectionLen = cidBytes.Length + data.Length
+    let varintBytes = encodeVarint sectionLen
+
+    use ms = new MemoryStream()
+    ms.Write(varintBytes, 0, varintBytes.Length)
+    ms.Write(cidBytes, 0, cidBytes.Length)
+    ms.Write(data, 0, data.Length)
+    ms.ToArray()
+
+  /// Create a complete CARv1 file from roots and blocks
+  /// CAR format: [varint | header] [varint | CID | block]...
+  let createCar (roots : Cid list) (blocks : (Cid * byte[]) seq) : byte[] =
+    use ms = new MemoryStream()
+
+    let headerBytes = createHeader roots
+    let headerVarint = encodeVarint headerBytes.Length
+    ms.Write(headerVarint, 0, headerVarint.Length)
+    ms.Write(headerBytes, 0, headerBytes.Length)
+
+    for cid, data in blocks do
+      let blockSection = encodeBlock cid data
+      ms.Write(blockSection, 0, blockSection.Length)
+
+    ms.ToArray()
+
+  /// Create a CAR from a single root with an async block fetcher
+  let createCarAsync (roots : Cid list) (getBlock : Cid -> Async<byte[] option>) (allCids : Cid seq) = async {
+    use ms = new MemoryStream()
+
+    let headerBytes = createHeader roots
+    let headerVarint = encodeVarint headerBytes.Length
+    ms.Write(headerVarint, 0, headerVarint.Length)
+    ms.Write(headerBytes, 0, headerBytes.Length)
+
+    for cid in allCids do
+      let! dataOpt = getBlock cid
+
+      match dataOpt with
+      | Some data ->
+        let blockSection = encodeBlock cid data
+        ms.Write(blockSection, 0, blockSection.Length)
+      | None -> ()
+
+    return ms.ToArray()
+  }

PDSharp.Core/Cid.fs

···
 
       sb.ToString()
 
+  let FromString (s : string) : byte[] option =
+    if String.IsNullOrEmpty s then
+      Some [||]
+    else
+      try
+        let bits = s.Length * 5
+        let bytes = Array.zeroCreate<byte> (bits / 8)
+        let mutable buffer = 0
+        let mutable bitsInBuffer = 0
+        let mutable byteIndex = 0
+
+        for c in s do
+          let idx = alphabet.IndexOf(Char.ToLowerInvariant c)
+
+          if idx < 0 then
+            failwith "Invalid base32 character"
+
+          buffer <- buffer <<< 5 ||| idx
+          bitsInBuffer <- bitsInBuffer + 5
+
+          if bitsInBuffer >= 8 then
+            bitsInBuffer <- bitsInBuffer - 8
+
+            if byteIndex < bytes.Length then
+              bytes.[byteIndex] <- byte ((buffer >>> bitsInBuffer) &&& 0xFF)
+              byteIndex <- byteIndex + 1
+
+        Some bytes
+      with _ ->
+        None
+
 /// Basic CID implementation for AT Protocol (CIDv1 + dag-cbor + sha2-256)
 ///
 /// Constants for ATProto defaults:
···
     cidBytes.[3] <- 0x20uy
     Array.Copy(hash, 0, cidBytes, 4, 32)
     Cid cidBytes
+
+  static member TryParse(s : string) : Cid option =
+    if String.IsNullOrWhiteSpace s then
+      None
+    elif s.StartsWith("b") then
+      match Base32Encoding.FromString(s.Substring(1)) with
+      | Some bytes when bytes.Length = 36 -> Some(Cid bytes)
+      | _ -> None
+    else
+      None
 
   override this.ToString() =
     "b" + Base32Encoding.ToString(this.Bytes)

PDSharp.Core/PDSharp.Core.fsproj

···
         <Compile Include="Crypto.fs" />
         <Compile Include="Mst.fs" />
         <Compile Include="BlockStore.fs" />
+        <Compile Include="Car.fs" />
         <Compile Include="AtUri.fs" />
         <Compile Include="Repository.fs" />
         <Compile Include="DidResolver.fs" />

PDSharp.Tests/Car.Tests.fs

···
+module CarTests
+
+open Xunit
+open PDSharp.Core
+open PDSharp.Core.Car
+open PDSharp.Core.Crypto
+
+[<Fact>]
+let ``Varint encodes zero correctly`` () =
+  let result = encodeVarint 0
+  Assert.Equal<byte[]>([| 0uy |], result)
+
+[<Fact>]
+let ``Varint encodes single byte values correctly`` () =
+  let result1 = encodeVarint 1
+  Assert.Equal<byte[]>([| 1uy |], result1)
+
+  let result127 = encodeVarint 127
+  Assert.Equal<byte[]>([| 127uy |], result127)
+
+[<Fact>]
+let ``Varint encodes multi-byte values correctly`` () =
+  let result128 = encodeVarint 128
+  Assert.Equal<byte[]>([| 0x80uy; 0x01uy |], result128)
+
+  let result300 = encodeVarint 300
+  Assert.Equal<byte[]>([| 0xACuy; 0x02uy |], result300)
+
+  let result16384 = encodeVarint 16384
+  Assert.Equal<byte[]>([| 0x80uy; 0x80uy; 0x01uy |], result16384)
+
+[<Fact>]
+let ``CAR header starts with version and roots`` () =
+  let hash = sha256Str "test-root"
+  let root = Cid.FromHash hash
+  let header = createHeader [ root ]
+
+  Assert.True(header.Length > 0, "Header should not be empty")
+  Assert.True(header.[0] >= 0xa0uy && header.[0] <= 0xbfuy, "Header should be a CBOR map")
+
+[<Fact>]
+let ``CAR block section is varint + CID + data`` () =
+  let hash = sha256Str "test-block"
+  let cid = Cid.FromHash hash
+  let data = [| 1uy; 2uy; 3uy; 4uy |]
+
+  let block = encodeBlock cid data
+
+  Assert.Equal(40uy, block.[0])
+  Assert.Equal(41, block.Length)
+
+[<Fact>]
+let ``Full CAR creation produces valid structure`` () =
+  let hash = sha256Str "root-data"
+  let rootCid = Cid.FromHash hash
+  let blocks = [ (rootCid, [| 1uy; 2uy; 3uy |]) ]
+  let car = createCar [ rootCid ] blocks
+
+  Assert.True(car.Length > 0, "CAR should not be empty")
+  Assert.True(car.[0] < 128uy, "Header length should fit in one varint byte for small headers")
+
+[<Fact>]
+let ``CAR with multiple blocks`` () =
+  let hash1 = sha256Str "block1"
+  let hash2 = sha256Str "block2"
+  let cid1 = Cid.FromHash hash1
+  let cid2 = Cid.FromHash hash2
+
+  let blocks = [ cid1, [| 1uy; 2uy; 3uy |]; cid2, [| 4uy; 5uy; 6uy; 7uy |] ]
+  let car = createCar [ cid1 ] blocks
+  Assert.True(car.Length > 80, "CAR with two blocks should be substantial")

PDSharp.Tests/PDSharp.Tests.fsproj

···
 <Project Sdk="Microsoft.NET.Sdk">
-
   <PropertyGroup>
     <TargetFramework>net9.0</TargetFramework>
     <IsPackable>false</IsPackable>
···
     <Compile Include="BlockStore.Tests.fs" />
     <Compile Include="AtUri.Tests.fs" />
     <Compile Include="Repository.Tests.fs" />
+    <Compile Include="Car.Tests.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
 
···
     <ProjectReference Include="..\PDSharp\PDSharp.fsproj" />
     <ProjectReference Include="..\PDSharp.Core\PDSharp.Core.fsproj" />
   </ItemGroup>
-
 </Project>

PDSharp.Tests/Tests.fs

···
   Assert.Equal("did:web:example.com", config.DidHost)
 
 [<Fact>]
+let ``CID TryParse roundtrip`` () =
+  let hash = Crypto.sha256Str "test-data"
+  let cid = Cid.FromHash hash
+  let cidStr = cid.ToString()
+
+  match Cid.TryParse cidStr with
+  | Some parsed -> Assert.Equal<byte[]>(cid.Bytes, parsed.Bytes)
+  | None -> Assert.Fail "TryParse should succeed for valid CID"
+
+[<Fact>]
+let ``CID TryParse returns None for invalid`` () =
+  Assert.True(Cid.TryParse("invalid").IsNone)
+  Assert.True(Cid.TryParse("").IsNone)
+  Assert.True(Cid.TryParse("btooshort").IsNone)
+
+[<Fact>]
 let ``Can instantiate DescribeServerResponse`` () =
   let response = {
     availableUserDomains = [ "example.com" ]

PDSharp/Program.fs

···
             ctx
     }
 
+  /// sync.getRepo: Export entire repository as CAR file
+  let getRepoHandler : HttpHandler =
+    fun next ctx -> task {
+      let did = ctx.Request.Query.["did"].ToString()
+
+      if String.IsNullOrWhiteSpace(did) then
+        ctx.SetStatusCode 400
+
+        return!
+          json
+            {
+              error = "InvalidRequest"
+              message = "Missing required query parameter: did"
+            }
+            next
+            ctx
+      else
+        match Map.tryFind did repos with
+        | None ->
+          ctx.SetStatusCode 404
+
+          return!
+            json
+              {
+                error = "RepoNotFound"
+                message = $"Repository not found: {did}"
+              }
+              next
+              ctx
+        | Some repoData ->
+          match repoData.Head with
+          | None ->
+            ctx.SetStatusCode 404
+
+            return!
+              json
+                {
+                  error = "RepoNotFound"
+                  message = "Repository has no commits"
+                }
+                next
+                ctx
+          | Some headCid ->
+            let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData()
+            let carBytes = Car.createCar [ headCid ] allBlocks
+            ctx.SetContentType "application/vnd.ipld.car"
+            ctx.SetStatusCode 200
+            return! ctx.WriteBytesAsync carBytes
+    }
+
+  /// sync.getBlocks: Fetch specific blocks by CID
+  let getBlocksHandler : HttpHandler =
+    fun next ctx -> task {
+      let did = ctx.Request.Query.["did"].ToString()
+      let cidsParam = ctx.Request.Query.["cids"].ToString()
+
+      if String.IsNullOrWhiteSpace did || String.IsNullOrWhiteSpace cidsParam then
+        ctx.SetStatusCode 400
+
+        return!
+          json
+            {
+              error = "InvalidRequest"
+              message = "Missing required query parameters: did, cids"
+            }
+            next
+            ctx
+      else
+        match Map.tryFind did repos with
+        | None ->
+          ctx.SetStatusCode 404
+
+          return!
+            json
+              {
+                error = "RepoNotFound"
+                message = $"Repository not found: {did}"
+              }
+              next
+              ctx
+        | Some _ ->
+          let cidStrs = cidsParam.Split(',') |> Array.map (fun s -> s.Trim())
+          let parsedCids = cidStrs |> Array.choose Cid.TryParse |> Array.toList
+          let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData()
+
+          let filteredBlocks =
+            if parsedCids.IsEmpty then
+              allBlocks
+            else
+              allBlocks
+              |> List.filter (fun (c, _) -> parsedCids |> List.exists (fun pc -> pc.Bytes = c.Bytes))
+
+          let roots =
+            if filteredBlocks.Length > 0 then
+              [ fst filteredBlocks.[0] ]
+            else
+              []
+
+          let carBytes = Car.createCar roots filteredBlocks
+          ctx.SetContentType "application/vnd.ipld.car"
+          ctx.SetStatusCode 200
+          return! ctx.WriteBytesAsync carBytes
+    }
+
+  /// sync.getBlob: Fetch a blob by CID
+  let getBlobHandler : HttpHandler =
+    fun next ctx -> task {
+      let did = ctx.Request.Query.["did"].ToString()
+      let cidStr = ctx.Request.Query.["cid"].ToString()
+
+      if String.IsNullOrWhiteSpace(did) || String.IsNullOrWhiteSpace(cidStr) then
+        ctx.SetStatusCode 400
+
+        return!
+          json
+            {
+              error = "InvalidRequest"
+              message = "Missing required query parameters: did, cid"
+            }
+            next
+            ctx
+      else
+        match Map.tryFind did repos with
+        | None ->
+          ctx.SetStatusCode 404
+
+          return!
+            json
+              {
+                error = "RepoNotFound"
+                message = $"Repository not found: {did}"
+              }
+              next
+              ctx
+        | Some _ ->
+          match Cid.TryParse cidStr with
+          | None ->
+            ctx.SetStatusCode 400
+
+            return!
+              json
+                {
+                  error = "InvalidRequest"
+                  message = $"Invalid CID format: {cidStr}"
+                }
+                next
+                ctx
+          | Some cid ->
+            let! dataOpt = (blockStore :> IBlockStore).Get(cid)
+
+            match dataOpt with
+            | None ->
+              ctx.SetStatusCode 404
+
+              return!
+                json
+                  {
+                    error = "BlobNotFound"
+                    message = $"Blob not found: {cidStr}"
+                  }
+                  next
+                  ctx
+            | Some data ->
+              ctx.SetContentType "application/octet-stream"
+              ctx.SetStatusCode 200
+              return! ctx.WriteBytesAsync data
+    }
+
   let webApp =
     choose [
       GET
···
       POST >=> route "/xrpc/com.atproto.repo.createRecord" >=> createRecordHandler
       GET >=> route "/xrpc/com.atproto.repo.getRecord" >=> getRecordHandler
       POST >=> route "/xrpc/com.atproto.repo.putRecord" >=> putRecordHandler
+      GET >=> route "/xrpc/com.atproto.sync.getRepo" >=> getRepoHandler
+      GET >=> route "/xrpc/com.atproto.sync.getBlocks" >=> getBlocksHandler
+      GET >=> route "/xrpc/com.atproto.sync.getBlob" >=> getBlobHandler
       route "/" >=> text "PDSharp PDS is running."
       RequestErrors.NOT_FOUND "Not Found"
     ]

roadmap.txt

···
 --------------------------------------------------------------------------------
 Milestone F: CAR Export + Sync Endpoints
 --------------------------------------------------------------------------------
-- CARv1 writer (roots = commit CID, blocks stream)
-- Implement: sync.getRepo, sync.getBlocks, sync.getBlob
+- [x] CARv1 writer (roots = commit CID, blocks stream)
+- [x] Implement: sync.getRepo, sync.getBlocks, sync.getBlob
 DoD: External services can fetch repo snapshot + blocks
 --------------------------------------------------------------------------------
 Milestone G: subscribeRepos Firehose
···
 [x] DAG-CBOR + CID generation correct
 [x] MST producing deterministic root CIDs
 [x] putRecord + blockstore operational
-[ ] CAR export + sync endpoints
+[x] CAR export + sync endpoints
 [ ] subscribeRepos firehose
 [ ] Authentication (createAccount, createSession)
 [ ] Lexicon validation