an atproto pds written in F# (.NET 9) ๐Ÿฆ’
pds fsharp giraffe dotnet atproto

feat: implement BlockStore, AT-URI parsing, and commit signing

+41
PDSharp.Core/AtUri.fs
···
··· 1 + namespace PDSharp.Core 2 + 3 + open System 4 + open System.Text.RegularExpressions 5 + 6 + /// AT-URI parsing and validation 7 + module AtUri = 8 + /// Represents an AT Protocol URI: at://did/collection/rkey 9 + type AtUri = { Did : string; Collection : string; Rkey : string } 10 + 11 + let private didPattern = @"^did:[a-z]+:[a-zA-Z0-9._:%-]+$" 12 + let private nsidPattern = @"^[a-z][a-z0-9]*(\.[a-z][a-z0-9]*)+$" 13 + let private rkeyPattern = @"^[a-zA-Z0-9._~-]+$" 14 + 15 + /// Parse an AT-URI string into components 16 + let parse (uri : string) : Result<AtUri, string> = 17 + if not (uri.StartsWith("at://")) then 18 + Error "AT-URI must start with at://" 19 + else 20 + let path = uri.Substring(5) 21 + let parts = path.Split('/') 22 + 23 + if parts.Length < 3 then 24 + Error "AT-URI must have format at://did/collection/rkey" 25 + else 26 + let did = parts.[0] 27 + let collection = parts.[1] 28 + let rkey = parts.[2] 29 + 30 + if not (Regex.IsMatch(did, didPattern)) then 31 + Error $"Invalid DID format: {did}" 32 + elif not (Regex.IsMatch(collection, nsidPattern)) then 33 + Error $"Invalid collection NSID: {collection}" 34 + elif not (Regex.IsMatch(rkey, rkeyPattern)) then 35 + Error $"Invalid rkey format: {rkey}" 36 + else 37 + Ok { Did = did; Collection = collection; Rkey = rkey } 38 + 39 + /// Convert AtUri back to string 40 + let toString (uri : AtUri) : string = 41 + $"at://{uri.Did}/{uri.Collection}/{uri.Rkey}"
+45
PDSharp.Core/BlockStore.fs
···
··· 1 + namespace PDSharp.Core 2 + 3 + open System.Collections.Concurrent 4 + 5 + /// Block storage interface for CID โ†’ byte[] mappings 6 + module BlockStore = 7 + 8 + /// Interface for content-addressed block storage 9 + type IBlockStore = 10 + abstract member Get : Cid -> Async<byte[] option> 11 + abstract member Put : byte[] -> Async<Cid> 12 + abstract member Has : Cid -> Async<bool> 13 + 14 + /// In-memory implementation of IBlockStore for testing 15 + type MemoryBlockStore() = 16 + let store = ConcurrentDictionary<string, byte[]>() 17 + 18 + let cidKey (cid : Cid) = 19 + System.Convert.ToBase64String(cid.Bytes) 20 + 21 + interface IBlockStore with 22 + member _.Get(cid : Cid) = async { 23 + let key = cidKey cid 24 + let success, data = store.TryGetValue(key) 25 + return if success then Some data else None 26 + } 27 + 28 + member _.Put(data : byte[]) = async { 29 + let hash = Crypto.sha256 data 30 + let cid = Cid.FromHash hash 31 + let key = cidKey cid 32 + store.[key] <- data 33 + return cid 34 + } 35 + 36 + member _.Has(cid : Cid) = async { 37 + let key = cidKey cid 38 + return store.ContainsKey(key) 39 + } 40 + 41 + /// Get the number of blocks stored (for testing) 42 + member _.Count = store.Count 43 + 44 + /// Clear all blocks (for testing) 45 + member _.Clear() = store.Clear()
+3
PDSharp.Core/PDSharp.Core.fsproj
··· 10 <Compile Include="DagCbor.fs" /> 11 <Compile Include="Crypto.fs" /> 12 <Compile Include="Mst.fs" /> 13 <Compile Include="DidResolver.fs" /> 14 <Compile Include="Library.fs" /> 15 </ItemGroup>
··· 10 <Compile Include="DagCbor.fs" /> 11 <Compile Include="Crypto.fs" /> 12 <Compile Include="Mst.fs" /> 13 + <Compile Include="BlockStore.fs" /> 14 + <Compile Include="AtUri.fs" /> 15 + <Compile Include="Repository.fs" /> 16 <Compile Include="DidResolver.fs" /> 17 <Compile Include="Library.fs" /> 18 </ItemGroup>
+123
PDSharp.Core/Repository.fs
···
··· 1 + namespace PDSharp.Core 2 + 3 + open System 4 + 5 + /// Repository commit signing and management 6 + module Repository = 7 + /// TID (Timestamp ID) generation for revision IDs 8 + module Tid = 9 + let private chars = "234567abcdefghijklmnopqrstuvwxyz" 10 + let private clockIdBits = 10 11 + let private timestampBits = 53 12 + 13 + /// Generate a random clock ID component 14 + let private randomClockId () = 15 + let rng = Random() 16 + rng.Next(1 <<< clockIdBits) 17 + 18 + /// Encode a number to base32 sortable string 19 + let private encode (value : int64) (length : int) = 20 + let mutable v = value 21 + let arr = Array.zeroCreate<char> length 22 + 23 + for i in (length - 1) .. -1 .. 0 do 24 + arr.[i] <- chars.[int (v &&& 0x1FL)] 25 + v <- v >>> 5 26 + 27 + String(arr) 28 + 29 + /// Generate a new TID based on current timestamp 30 + let generate () : string = 31 + let timestamp = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds() 32 + let clockId = randomClockId () 33 + let combined = (timestamp <<< clockIdBits) ||| int64 clockId 34 + encode combined 13 35 + 36 + /// Unsigned commit record (before signing) 37 + type UnsignedCommit = { 38 + Did : string 39 + Version : int 40 + Data : Cid 41 + Rev : string 42 + Prev : Cid option 43 + } 44 + 45 + /// Signed commit record 46 + type SignedCommit = { 47 + Did : string 48 + Version : int 49 + Data : Cid 50 + Rev : string 51 + Prev : Cid option 52 + Sig : byte[] 53 + } 54 + 55 + /// Convert unsigned commit to CBOR-encodable map 56 + let private unsignedToCborMap (commit : UnsignedCommit) : Map<string, obj> = 57 + let baseMap = 58 + Map.ofList [ 59 + ("did", box commit.Did) 60 + ("version", box commit.Version) 61 + ("data", box commit.Data) 62 + ("rev", box commit.Rev) 63 + ] 64 + 65 + match commit.Prev with 66 + | Some prev -> baseMap |> Map.add "prev" (box prev) 67 + | None -> baseMap 68 + 69 + /// Sign an unsigned commit 70 + let signCommit (key : Crypto.EcKeyPair) (commit : UnsignedCommit) : SignedCommit = 71 + let cborMap = unsignedToCborMap commit 72 + let cborBytes = DagCbor.encode cborMap 73 + let hash = Crypto.sha256 cborBytes 74 + let signature = Crypto.sign key hash 75 + 76 + { 77 + Did = commit.Did 78 + Version = commit.Version 79 + Data = commit.Data 80 + Rev = commit.Rev 81 + Prev = commit.Prev 82 + Sig = signature 83 + } 84 + 85 + /// Verify a signed commit's signature 86 + let verifyCommit (key : Crypto.EcKeyPair) (commit : SignedCommit) : bool = 87 + let unsigned = { 88 + Did = commit.Did 89 + Version = commit.Version 90 + Data = commit.Data 91 + Rev = commit.Rev 92 + Prev = commit.Prev 93 + } 94 + 95 + let cborMap = unsignedToCborMap unsigned 96 + let cborBytes = DagCbor.encode cborMap 97 + let hash = Crypto.sha256 cborBytes 98 + Crypto.verify key hash commit.Sig 99 + 100 + /// Convert signed commit to CBOR-encodable map 101 + let signedToCborMap (commit : SignedCommit) : Map<string, obj> = 102 + let baseMap = 103 + Map.ofList [ 104 + ("did", box commit.Did) 105 + ("version", box commit.Version) 106 + ("data", box commit.Data) 107 + ("rev", box commit.Rev) 108 + ("sig", box commit.Sig) 109 + ] 110 + 111 + match commit.Prev with 112 + | Some prev -> baseMap |> Map.add "prev" (box prev) 113 + | None -> baseMap 114 + 115 + /// Serialize a signed commit to DAG-CBOR bytes 116 + let serializeCommit (commit : SignedCommit) : byte[] = 117 + signedToCborMap commit |> DagCbor.encode 118 + 119 + /// Get CID for a signed commit 120 + let commitCid (commit : SignedCommit) : Cid = 121 + let bytes = serializeCommit commit 122 + let hash = Crypto.sha256 bytes 123 + Cid.FromHash hash
+74
PDSharp.Tests/AtUri.Tests.fs
···
··· 1 + module AtUriTests 2 + 3 + open Xunit 4 + open PDSharp.Core.AtUri 5 + 6 + [<Fact>] 7 + let ``Parse valid AT-URI`` () = 8 + let uri = "at://did:plc:abcd1234/app.bsky.feed.post/3kbq5vk4beg2f" 9 + let result = parse uri 10 + 11 + match result with 12 + | Ok parsed -> 13 + Assert.Equal("did:plc:abcd1234", parsed.Did) 14 + Assert.Equal("app.bsky.feed.post", parsed.Collection) 15 + Assert.Equal("3kbq5vk4beg2f", parsed.Rkey) 16 + | Error msg -> Assert.Fail(msg) 17 + 18 + [<Fact>] 19 + let ``Parse did:web AT-URI`` () = 20 + let uri = "at://did:web:example.com/app.bsky.actor.profile/self" 21 + let result = parse uri 22 + 23 + match result with 24 + | Ok parsed -> 25 + Assert.Equal("did:web:example.com", parsed.Did) 26 + Assert.Equal("app.bsky.actor.profile", parsed.Collection) 27 + Assert.Equal("self", parsed.Rkey) 28 + | Error msg -> Assert.Fail(msg) 29 + 30 + [<Fact>] 31 + let ``Parse fails without at:// prefix`` () = 32 + let uri = "http://did:plc:abcd/app.bsky.feed.post/123" 33 + let result = parse uri 34 + 35 + Assert.True(Result.isError result) 36 + 37 + [<Fact>] 38 + let ``Parse fails with invalid DID`` () = 39 + let uri = "at://not-a-did/app.bsky.feed.post/123" 40 + let result = parse uri 41 + 42 + Assert.True(Result.isError result) 43 + 44 + [<Fact>] 45 + let ``Parse fails with invalid collection`` () = 46 + let uri = "at://did:plc:abcd/NotAnNsid/123" 47 + let result = parse uri 48 + 49 + Assert.True(Result.isError result) 50 + 51 + [<Fact>] 52 + let ``Parse fails with missing parts`` () = 53 + let uri = "at://did:plc:abcd/app.bsky.feed.post" 54 + let result = parse uri 55 + 56 + Assert.True(Result.isError result) 57 + 58 + [<Fact>] 59 + let ``ToString roundtrip`` () = 60 + let original = { 61 + Did = "did:plc:abcd" 62 + Collection = "app.bsky.feed.post" 63 + Rkey = "123" 64 + } 65 + 66 + let str = toString original 67 + let parsed = parse str 68 + 69 + match parsed with 70 + | Ok p -> 71 + Assert.Equal(original.Did, p.Did) 72 + Assert.Equal(original.Collection, p.Collection) 73 + Assert.Equal(original.Rkey, p.Rkey) 74 + | Error msg -> Assert.Fail(msg)
+52
PDSharp.Tests/BlockStore.Tests.fs
···
··· 1 + module BlockStoreTests 2 + 3 + open Xunit 4 + open PDSharp.Core 5 + open PDSharp.Core.BlockStore 6 + 7 + [<Fact>] 8 + let ``MemoryBlockStore Put and Get roundtrip`` () = 9 + let store = MemoryBlockStore() :> IBlockStore 10 + let data = System.Text.Encoding.UTF8.GetBytes("hello world") 11 + 12 + let cid = store.Put(data) |> Async.RunSynchronously 13 + let retrieved = store.Get(cid) |> Async.RunSynchronously 14 + 15 + Assert.True(Option.isSome retrieved) 16 + Assert.Equal<byte[]>(data, Option.get retrieved) 17 + 18 + [<Fact>] 19 + let ``MemoryBlockStore Has returns true for existing`` () = 20 + let store = MemoryBlockStore() :> IBlockStore 21 + let data = System.Text.Encoding.UTF8.GetBytes("test data") 22 + 23 + let cid = store.Put(data) |> Async.RunSynchronously 24 + let exists = store.Has(cid) |> Async.RunSynchronously 25 + 26 + Assert.True(exists) 27 + 28 + [<Fact>] 29 + let ``MemoryBlockStore Has returns false for missing`` () = 30 + let store = MemoryBlockStore() :> IBlockStore 31 + let fakeCid = Cid.FromHash(Crypto.sha256Str "nonexistent") 32 + 33 + let exists = store.Has(fakeCid) |> Async.RunSynchronously 34 + 35 + Assert.False(exists) 36 + 37 + [<Fact>] 38 + let ``MemoryBlockStore Get returns None for missing`` () = 39 + let store = MemoryBlockStore() :> IBlockStore 40 + let fakeCid = Cid.FromHash(Crypto.sha256Str "nonexistent") 41 + 42 + let result = store.Get(fakeCid) |> Async.RunSynchronously 43 + 44 + Assert.True(Option.isNone result) 45 + 46 + [<Fact>] 47 + let ``MemoryBlockStore CID is content-addressed`` () = 48 + let store = MemoryBlockStore() :> IBlockStore 49 + let data = System.Text.Encoding.UTF8.GetBytes("same content") 50 + let cid1 = store.Put data |> Async.RunSynchronously 51 + let cid2 = store.Put data |> Async.RunSynchronously 52 + Assert.Equal<byte[]>(cid1.Bytes, cid2.Bytes)
+3
PDSharp.Tests/PDSharp.Tests.fsproj
··· 9 <ItemGroup> 10 <Compile Include="Tests.fs" /> 11 <Compile Include="Mst.Tests.fs" /> 12 <Compile Include="Program.fs" /> 13 </ItemGroup> 14
··· 9 <ItemGroup> 10 <Compile Include="Tests.fs" /> 11 <Compile Include="Mst.Tests.fs" /> 12 + <Compile Include="BlockStore.Tests.fs" /> 13 + <Compile Include="AtUri.Tests.fs" /> 14 + <Compile Include="Repository.Tests.fs" /> 15 <Compile Include="Program.fs" /> 16 </ItemGroup> 17
+128
PDSharp.Tests/Repository.Tests.fs
···
··· 1 + module RepositoryTests 2 + 3 + open Xunit 4 + open PDSharp.Core 5 + open PDSharp.Core.Crypto 6 + open PDSharp.Core.Repository 7 + 8 + [<Fact>] 9 + let ``TID generation produces 13 character string`` () = 10 + let tid = Tid.generate () 11 + Assert.Equal(13, tid.Length) 12 + 13 + [<Fact>] 14 + let ``TID generation is sortable by time`` () = 15 + let tid1 = Tid.generate () 16 + System.Threading.Thread.Sleep(2) 17 + let tid2 = Tid.generate () 18 + Assert.True(tid2 > tid1, $"Expected {tid2} > {tid1}") 19 + 20 + [<Fact>] 21 + let ``Commit signing produces valid signature`` () = 22 + let keyPair = generateKey P256 23 + let mstRoot = Cid.FromHash(sha256Str "mst-root") 24 + 25 + let unsigned = { 26 + Did = "did:plc:test1234" 27 + Version = 3 28 + Data = mstRoot 29 + Rev = Tid.generate () 30 + Prev = None 31 + } 32 + 33 + let signed = signCommit keyPair unsigned 34 + 35 + Assert.Equal(64, signed.Sig.Length) 36 + Assert.Equal(unsigned.Did, signed.Did) 37 + Assert.Equal(unsigned.Data, signed.Data) 38 + 39 + [<Fact>] 40 + let ``Commit verification succeeds for valid commit`` () = 41 + let keyPair = generateKey P256 42 + let mstRoot = Cid.FromHash(sha256Str "data") 43 + 44 + let unsigned = { 45 + Did = "did:plc:abc" 46 + Version = 3 47 + Data = mstRoot 48 + Rev = Tid.generate () 49 + Prev = None 50 + } 51 + 52 + let signed = signCommit keyPair unsigned 53 + 54 + Assert.True(verifyCommit keyPair signed) 55 + 56 + [<Fact>] 57 + let ``Commit verification fails for tampered data`` () = 58 + let keyPair = generateKey P256 59 + let mstRoot = Cid.FromHash(sha256Str "original") 60 + 61 + let unsigned = { 62 + Did = "did:plc:abc" 63 + Version = 3 64 + Data = mstRoot 65 + Rev = Tid.generate () 66 + Prev = None 67 + } 68 + 69 + let signed = signCommit keyPair unsigned 70 + let tampered = { signed with Did = "did:plc:different" } 71 + 72 + Assert.False(verifyCommit keyPair tampered) 73 + 74 + [<Fact>] 75 + let ``Commit with prev CID`` () = 76 + let keyPair = generateKey P256 77 + let mstRoot = Cid.FromHash(sha256Str "new-data") 78 + let prevCid = Cid.FromHash(sha256Str "prev-commit") 79 + 80 + let unsigned = { 81 + Did = "did:plc:abc" 82 + Version = 3 83 + Data = mstRoot 84 + Rev = Tid.generate () 85 + Prev = Some prevCid 86 + } 87 + 88 + let signed = signCommit keyPair unsigned 89 + Assert.True(verifyCommit keyPair signed) 90 + Assert.True(Option.isSome signed.Prev) 91 + 92 + [<Fact>] 93 + let ``Commit CID is deterministic`` () = 94 + let keyPair = generateKey P256 95 + let mstRoot = Cid.FromHash(sha256Str "data") 96 + 97 + let unsigned = { 98 + Did = "did:plc:abc" 99 + Version = 3 100 + Data = mstRoot 101 + Rev = "abcdefghijklm" 102 + Prev = None 103 + } 104 + 105 + let signed = signCommit keyPair unsigned 106 + let cid1 = commitCid signed 107 + let cid2 = commitCid signed 108 + 109 + Assert.Equal<byte[]>(cid1.Bytes, cid2.Bytes) 110 + 111 + [<Fact>] 112 + let ``Commit serialization produces valid DAG-CBOR`` () = 113 + let keyPair = generateKey P256 114 + let mstRoot = Cid.FromHash(sha256Str "test") 115 + 116 + let unsigned = { 117 + Did = "did:plc:test" 118 + Version = 3 119 + Data = mstRoot 120 + Rev = Tid.generate () 121 + Prev = None 122 + } 123 + 124 + let signed = signCommit keyPair unsigned 125 + let bytes = serializeCommit signed 126 + 127 + Assert.True(bytes.Length > 0) 128 + Assert.True(bytes.[0] >= 0xa0uy && bytes.[0] <= 0xbfuy)
+311 -2
PDSharp/Program.fs
··· 1 ๏ปฟopen System 2 open System.IO 3 open Microsoft.AspNetCore.Builder 4 open Microsoft.AspNetCore.Hosting 5 open Microsoft.Extensions.Hosting 6 open Microsoft.Extensions.DependencyInjection 7 open Microsoft.Extensions.Configuration 8 open Giraffe 9 open PDSharp.Core.Models 10 open PDSharp.Core.Config 11 12 module App = 13 14 let describeServerHandler : HttpHandler = 15 fun next ctx -> 16 let config = ctx.GetService<AppConfig>() 17 18 - // TODO: add to config 19 let response = { 20 availableUserDomains = [] 21 did = config.DidHost ··· 24 25 json response next ctx 26 27 let webApp = 28 choose [ 29 - route "/xrpc/com.atproto.server.describeServer" >=> describeServerHandler 30 route "/" >=> text "PDSharp PDS is running." 31 RequestErrors.NOT_FOUND "Not Found" 32 ]
··· 1 ๏ปฟopen System 2 open System.IO 3 + open System.Text 4 + open System.Text.Json 5 open Microsoft.AspNetCore.Builder 6 open Microsoft.AspNetCore.Hosting 7 + open Microsoft.AspNetCore.Http 8 open Microsoft.Extensions.Hosting 9 open Microsoft.Extensions.DependencyInjection 10 open Microsoft.Extensions.Configuration 11 open Giraffe 12 + open PDSharp.Core 13 open PDSharp.Core.Models 14 open PDSharp.Core.Config 15 + open PDSharp.Core.BlockStore 16 + open PDSharp.Core.Repository 17 + open PDSharp.Core.Mst 18 + open PDSharp.Core.Crypto 19 20 module App = 21 + /// Repo state per DID: MST root, collections, current rev, head commit CID 22 + type RepoData = { 23 + MstRoot : MstNode 24 + Collections : Map<string, Map<string, Cid>> 25 + Rev : string 26 + Head : Cid option 27 + Prev : Cid option 28 + } 29 + 30 + let emptyRepo = { 31 + MstRoot = { Left = None; Entries = [] } 32 + Collections = Map.empty 33 + Rev = "" 34 + Head = None 35 + Prev = None 36 + } 37 + 38 + let mutable repos : Map<string, RepoData> = Map.empty 39 + let blockStore = MemoryBlockStore() 40 + let mutable signingKeys : Map<string, EcKeyPair> = Map.empty 41 + 42 + let getOrCreateKey (did : string) = 43 + match Map.tryFind did signingKeys with 44 + | Some k -> k 45 + | None -> 46 + let k = generateKey P256 47 + signingKeys <- Map.add did k signingKeys 48 + k 49 + 50 + let loader (c : Cid) = async { 51 + let! bytesOpt = (blockStore :> IBlockStore).Get(c) 52 + 53 + match bytesOpt with 54 + | Some bytes -> return Some(Mst.deserialize bytes) 55 + | None -> return None 56 + } 57 + 58 + let persister (n : MstNode) = async { 59 + let bytes = Mst.serialize n 60 + return! (blockStore :> IBlockStore).Put(bytes) 61 + } 62 + 63 + let signAndStoreCommit (did : string) (mstRootCid : Cid) (rev : string) (prev : Cid option) = async { 64 + let key = getOrCreateKey did 65 + 66 + let unsigned : UnsignedCommit = { 67 + Did = did 68 + Version = 3 69 + Data = mstRootCid 70 + Rev = rev 71 + Prev = prev 72 + } 73 + 74 + let signed = signCommit key unsigned 75 + let commitBytes = serializeCommit signed 76 + let! commitCid = (blockStore :> IBlockStore).Put(commitBytes) 77 + return (signed, commitCid) 78 + } 79 + 80 + [<CLIMutable>] 81 + type CreateRecordRequest = { 82 + repo : string 83 + collection : string 84 + record : JsonElement 85 + rkey : string option 86 + } 87 + 88 + [<CLIMutable>] 89 + type CreateRecordResponse = { 90 + uri : string 91 + cid : string 92 + commit : {| rev : string; cid : string |} 93 + } 94 + 95 + [<CLIMutable>] 96 + type GetRecordResponse = { uri : string; cid : string; value : JsonElement } 97 + 98 + [<CLIMutable>] 99 + type ErrorResponse = { error : string; message : string } 100 101 let describeServerHandler : HttpHandler = 102 fun next ctx -> 103 let config = ctx.GetService<AppConfig>() 104 105 let response = { 106 availableUserDomains = [] 107 did = config.DidHost ··· 110 111 json response next ctx 112 113 + let createRecordHandler : HttpHandler = 114 + fun next ctx -> task { 115 + let! body = ctx.ReadBodyFromRequestAsync() 116 + 117 + let request = 118 + JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 119 + 120 + let did = request.repo 121 + 122 + let rkey = 123 + match request.rkey with 124 + | Some r when not (String.IsNullOrWhiteSpace(r)) -> r 125 + | _ -> Tid.generate () 126 + 127 + let recordJson = request.record.GetRawText() 128 + let recordBytes = Encoding.UTF8.GetBytes(recordJson) 129 + let! recordCid = (blockStore :> IBlockStore).Put(recordBytes) 130 + 131 + let repoData = Map.tryFind did repos |> Option.defaultValue emptyRepo 132 + let mstKey = $"{request.collection}/{rkey}" 133 + 134 + let! newMstRoot = Mst.put loader persister repoData.MstRoot mstKey recordCid "" 135 + let! mstRootCid = persister newMstRoot 136 + 137 + let newRev = Tid.generate () 138 + let! (_, commitCid) = signAndStoreCommit did mstRootCid newRev repoData.Head 139 + 140 + let collectionMap = 141 + Map.tryFind request.collection repoData.Collections 142 + |> Option.defaultValue Map.empty 143 + 144 + let newCollectionMap = Map.add rkey recordCid collectionMap 145 + 146 + let newCollections = 147 + Map.add request.collection newCollectionMap repoData.Collections 148 + 149 + let updatedRepo = { 150 + MstRoot = newMstRoot 151 + Collections = newCollections 152 + Rev = newRev 153 + Head = Some commitCid 154 + Prev = repoData.Head 155 + } 156 + 157 + repos <- Map.add did updatedRepo repos 158 + 159 + let uri = $"at://{did}/{request.collection}/{rkey}" 160 + ctx.SetStatusCode 200 161 + 162 + return! 163 + json 164 + {| 165 + uri = uri 166 + cid = recordCid.ToString() 167 + commit = {| rev = newRev; cid = commitCid.ToString() |} 168 + |} 169 + next 170 + ctx 171 + } 172 + 173 + let getRecordHandler : HttpHandler = 174 + fun next ctx -> task { 175 + let repo = ctx.Request.Query.["repo"].ToString() 176 + let collection = ctx.Request.Query.["collection"].ToString() 177 + let rkey = ctx.Request.Query.["rkey"].ToString() 178 + 179 + if 180 + String.IsNullOrWhiteSpace(repo) 181 + || String.IsNullOrWhiteSpace(collection) 182 + || String.IsNullOrWhiteSpace(rkey) 183 + then 184 + ctx.SetStatusCode 400 185 + 186 + return! 187 + json 188 + { 189 + error = "InvalidRequest" 190 + message = "Missing required query parameters: repo, collection, rkey" 191 + } 192 + next 193 + ctx 194 + else 195 + match Map.tryFind repo repos with 196 + | None -> 197 + ctx.SetStatusCode 404 198 + 199 + return! 200 + json 201 + { 202 + error = "RepoNotFound" 203 + message = $"Repository not found: {repo}" 204 + } 205 + next 206 + ctx 207 + | Some repoData -> 208 + match Map.tryFind collection repoData.Collections with 209 + | None -> 210 + ctx.SetStatusCode 404 211 + 212 + return! 213 + json 214 + { 215 + error = "RecordNotFound" 216 + message = $"Collection not found: {collection}" 217 + } 218 + next 219 + ctx 220 + | Some collectionMap -> 221 + match Map.tryFind rkey collectionMap with 222 + | None -> 223 + ctx.SetStatusCode 404 224 + 225 + return! 226 + json 227 + { 228 + error = "RecordNotFound" 229 + message = $"Record not found: {rkey}" 230 + } 231 + next 232 + ctx 233 + | Some recordCid -> 234 + let! recordBytesOpt = (blockStore :> IBlockStore).Get(recordCid) 235 + 236 + match recordBytesOpt with 237 + | None -> 238 + ctx.SetStatusCode 500 239 + 240 + return! 241 + json 242 + { 243 + error = "InternalError" 244 + message = "Block not found in store" 245 + } 246 + next 247 + ctx 248 + | Some recordBytes -> 249 + let recordJson = Encoding.UTF8.GetString(recordBytes) 250 + let uri = $"at://{repo}/{collection}/{rkey}" 251 + let valueElement = JsonSerializer.Deserialize<JsonElement>(recordJson) 252 + ctx.SetStatusCode 200 253 + 254 + return! 255 + json 256 + {| 257 + uri = uri 258 + cid = recordCid.ToString() 259 + value = valueElement 260 + |} 261 + next 262 + ctx 263 + } 264 + 265 + let putRecordHandler : HttpHandler = 266 + fun next ctx -> task { 267 + let! body = ctx.ReadBodyFromRequestAsync() 268 + 269 + let request = 270 + JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 271 + 272 + match request.rkey with 273 + | Some r when not (String.IsNullOrWhiteSpace r) -> 274 + let did = request.repo 275 + let recordJson = request.record.GetRawText() 276 + let recordBytes = Encoding.UTF8.GetBytes(recordJson) 277 + let! recordCid = (blockStore :> IBlockStore).Put(recordBytes) 278 + 279 + let repoData = Map.tryFind did repos |> Option.defaultValue emptyRepo 280 + let mstKey = $"{request.collection}/{r}" 281 + 282 + let! newMstRoot = Mst.put loader persister repoData.MstRoot mstKey recordCid "" 283 + let! mstRootCid = persister newMstRoot 284 + 285 + let newRev = Tid.generate () 286 + let! (_, commitCid) = signAndStoreCommit did mstRootCid newRev repoData.Head 287 + 288 + let collectionMap = 289 + Map.tryFind request.collection repoData.Collections 290 + |> Option.defaultValue Map.empty 291 + 292 + let newCollectionMap = Map.add r recordCid collectionMap 293 + 294 + let newCollections = 295 + Map.add request.collection newCollectionMap repoData.Collections 296 + 297 + let updatedRepo = { 298 + MstRoot = newMstRoot 299 + Collections = newCollections 300 + Rev = newRev 301 + Head = Some commitCid 302 + Prev = repoData.Head 303 + } 304 + 305 + repos <- Map.add did updatedRepo repos 306 + 307 + ctx.SetStatusCode 200 308 + 309 + return! 310 + json 311 + {| 312 + uri = $"at://{did}/{request.collection}/{r}" 313 + cid = recordCid.ToString() 314 + commit = {| rev = newRev; cid = commitCid.ToString() |} 315 + |} 316 + next 317 + ctx 318 + | _ -> 319 + ctx.SetStatusCode 400 320 + 321 + return! 322 + json 323 + { 324 + error = "InvalidRequest" 325 + message = "rkey is required for putRecord" 326 + } 327 + next 328 + ctx 329 + } 330 + 331 let webApp = 332 choose [ 333 + GET 334 + >=> route "/xrpc/com.atproto.server.describeServer" 335 + >=> describeServerHandler 336 + POST >=> route "/xrpc/com.atproto.repo.createRecord" >=> createRecordHandler 337 + GET >=> route "/xrpc/com.atproto.repo.getRecord" >=> getRecordHandler 338 + POST >=> route "/xrpc/com.atproto.repo.putRecord" >=> putRecordHandler 339 route "/" >=> text "PDSharp PDS is running." 340 RequestErrors.NOT_FOUND "Not Found" 341 ]
+7 -7
roadmap.txt
··· 30 -------------------------------------------------------------------------------- 31 Milestone E: Commit + BlockStore + putRecord 32 -------------------------------------------------------------------------------- 33 - - BlockStore: cid โ†’ bytes, indexed by DID/rev/head 34 - - Commit signing: UnsignedCommit โ†’ DAG-CBOR โ†’ sha256 โ†’ ECDSA sign 35 - - Implement com.atproto.repo.putRecord/createRecord 36 DoD: Write and read records by path/AT-URI 37 -------------------------------------------------------------------------------- 38 Milestone F: CAR Export + Sync Endpoints ··· 114 ================================================================================ 115 QUICK CHECKLIST 116 ================================================================================ 117 - [ ] describeServer endpoint working 118 - [ ] Crypto primitives (sha256, ECDSA p256/k256, low-S) 119 - [ ] DAG-CBOR + CID generation correct 120 [x] MST producing deterministic root CIDs 121 - [ ] putRecord + blockstore operational 122 [ ] CAR export + sync endpoints 123 [ ] subscribeRepos firehose 124 [ ] Authentication (createAccount, createSession)
··· 30 -------------------------------------------------------------------------------- 31 Milestone E: Commit + BlockStore + putRecord 32 -------------------------------------------------------------------------------- 33 + - [x] BlockStore: cid โ†’ bytes, indexed by DID/rev/head 34 + - [x] Commit signing: UnsignedCommit โ†’ DAG-CBOR โ†’ sha256 โ†’ ECDSA sign 35 + - [x] Implement com.atproto.repo.putRecord/createRecord 36 DoD: Write and read records by path/AT-URI 37 -------------------------------------------------------------------------------- 38 Milestone F: CAR Export + Sync Endpoints ··· 114 ================================================================================ 115 QUICK CHECKLIST 116 ================================================================================ 117 + [x] describeServer endpoint working 118 + [x] Crypto primitives (sha256, ECDSA p256/k256, low-S) 119 + [x] DAG-CBOR + CID generation correct 120 [x] MST producing deterministic root CIDs 121 + [x] putRecord + blockstore operational 122 [ ] CAR export + sync endpoints 123 [ ] subscribeRepos firehose 124 [ ] Authentication (createAccount, createSession)