+3 -1

.gitignore

··· 47 47 TestResult.xml 48 48 nunit-*.xml 49 49 50 50 - .fake 50 50 + .fake 51 51 + *.db 52 52 + *.db-*

+221

PDSharp/Handlers/Auth.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open System 4 4 + open System.Text.Json 5 5 + open Microsoft.AspNetCore.Http 6 6 + open Giraffe 7 7 + open PDSharp.Core.Config 8 8 + open PDSharp.Core.Auth 9 9 + open PDSharp.Handlers 10 10 + 11 11 + module Auth = 12 12 + [<CLIMutable>] 13 13 + type CreateAccountRequest = { 14 14 + handle : string 15 15 + email : string option 16 16 + password : string 17 17 + inviteCode : string option 18 18 + } 19 19 + 20 20 + [<CLIMutable>] 21 21 + type CreateSessionRequest = { identifier : string; password : string } 22 22 + 23 23 + type SessionResponse = { 24 24 + accessJwt : string 25 25 + refreshJwt : string 26 26 + handle : string 27 27 + did : string 28 28 + email : string option 29 29 + } 30 30 + 31 31 + let private extractBearerToken (ctx : HttpContext) : string option = 32 32 + match ctx.Request.Headers.TryGetValue("Authorization") with 33 33 + | true, values -> 34 34 + let header = values.ToString() 35 35 + 36 36 + if header.StartsWith("Bearer ", StringComparison.OrdinalIgnoreCase) then 37 37 + Some(header.Substring(7)) 38 38 + else 39 39 + None 40 40 + | _ -> None 41 41 + 42 42 + let createAccountHandler : HttpHandler = 43 43 + fun next ctx -> task { 44 44 + let config = ctx.GetService<AppConfig>() 45 45 + let accountStore = ctx.GetService<IAccountStore>() 46 46 + let! body = ctx.ReadBodyFromRequestAsync() 47 47 + 48 48 + let request = 49 49 + JsonSerializer.Deserialize<CreateAccountRequest>( 50 50 + body, 51 51 + JsonSerializerOptions(PropertyNameCaseInsensitive = true) 52 52 + ) 53 53 + 54 54 + if 55 55 + String.IsNullOrWhiteSpace(request.handle) 56 56 + || String.IsNullOrWhiteSpace(request.password) 57 57 + then 58 58 + ctx.SetStatusCode 400 59 59 + 60 60 + return! 61 61 + json 62 62 + { 63 63 + error = "InvalidRequest" 64 64 + message = "handle and password are required" 65 65 + } 66 66 + next 67 67 + ctx 68 68 + else 69 69 + match! PDSharp.Core.Auth.createAccount accountStore request.handle request.password request.email with 70 70 + | Result.Error msg -> 71 71 + ctx.SetStatusCode 400 72 72 + return! json { error = "AccountExists"; message = msg } next ctx 73 73 + | Result.Ok(account : Account) -> 74 74 + let accessJwt = PDSharp.Core.Auth.createAccessToken config.JwtSecret account.Did 75 75 + let refreshJwt = PDSharp.Core.Auth.createRefreshToken config.JwtSecret account.Did 76 76 + ctx.SetStatusCode 200 77 77 + 78 78 + return! 79 79 + json 80 80 + { 81 81 + accessJwt = accessJwt 82 82 + refreshJwt = refreshJwt 83 83 + handle = account.Handle 84 84 + did = account.Did 85 85 + email = account.Email 86 86 + } 87 87 + next 88 88 + ctx 89 89 + } 90 90 + 91 91 + let createSessionHandler : HttpHandler = 92 92 + fun next ctx -> task { 93 93 + let config = ctx.GetService<AppConfig>() 94 94 + let accountStore = ctx.GetService<IAccountStore>() 95 95 + let! body = ctx.ReadBodyFromRequestAsync() 96 96 + 97 97 + let request = 98 98 + JsonSerializer.Deserialize<CreateSessionRequest>( 99 99 + body, 100 100 + JsonSerializerOptions(PropertyNameCaseInsensitive = true) 101 101 + ) 102 102 + 103 103 + if 104 104 + String.IsNullOrWhiteSpace(request.identifier) 105 105 + || String.IsNullOrWhiteSpace(request.password) 106 106 + then 107 107 + ctx.SetStatusCode 400 108 108 + 109 109 + return! 110 110 + json 111 111 + { 112 112 + error = "InvalidRequest" 113 113 + message = "identifier and password are required" 114 114 + } 115 115 + next 116 116 + ctx 117 117 + else 118 118 + let! accountOpt = 119 119 + if request.identifier.StartsWith("did:") then 120 120 + accountStore.GetAccountByDid request.identifier 121 121 + else 122 122 + accountStore.GetAccountByHandle request.identifier 123 123 + 124 124 + match accountOpt with 125 125 + | None -> 126 126 + ctx.SetStatusCode 401 127 127 + 128 128 + return! 129 129 + json 130 130 + { 131 131 + error = "AuthenticationRequired" 132 132 + message = "Invalid identifier or password" 133 133 + } 134 134 + next 135 135 + ctx 136 136 + | Some(account : Account) -> 137 137 + if not (PDSharp.Core.Auth.verifyPassword request.password account.PasswordHash) then 138 138 + ctx.SetStatusCode 401 139 139 + 140 140 + return! 141 141 + json 142 142 + { 143 143 + error = "AuthenticationRequired" 144 144 + message = "Invalid identifier or password" 145 145 + } 146 146 + next 147 147 + ctx 148 148 + else 149 149 + let accessJwt = PDSharp.Core.Auth.createAccessToken config.JwtSecret account.Did 150 150 + let refreshJwt = PDSharp.Core.Auth.createRefreshToken config.JwtSecret account.Did 151 151 + ctx.SetStatusCode 200 152 152 + 153 153 + return! 154 154 + json 155 155 + { 156 156 + accessJwt = accessJwt 157 157 + refreshJwt = refreshJwt 158 158 + handle = account.Handle 159 159 + did = account.Did 160 160 + email = account.Email 161 161 + } 162 162 + next 163 163 + ctx 164 164 + } 165 165 + 166 166 + let refreshSessionHandler : HttpHandler = 167 167 + fun next ctx -> task { 168 168 + let config = ctx.GetService<AppConfig>() 169 169 + let accountStore = ctx.GetService<IAccountStore>() 170 170 + 171 171 + match extractBearerToken ctx with 172 172 + | None -> 173 173 + ctx.SetStatusCode 401 174 174 + 175 175 + return! 176 176 + json 177 177 + { 178 178 + error = "AuthenticationRequired" 179 179 + message = "Missing or invalid Authorization header" 180 180 + } 181 181 + next 182 182 + ctx 183 183 + | Some token -> 184 184 + match PDSharp.Core.Auth.validateToken config.JwtSecret token with 185 185 + | PDSharp.Core.Auth.Invalid reason -> 186 186 + ctx.SetStatusCode 401 187 187 + return! json { error = "ExpiredToken"; message = reason } next ctx 188 188 + | PDSharp.Core.Auth.Valid(did, tokenType, _) -> 189 189 + if tokenType <> PDSharp.Core.Auth.Refresh then 190 190 + ctx.SetStatusCode 400 191 191 + 192 192 + return! 193 193 + json 194 194 + { 195 195 + error = "InvalidRequest" 196 196 + message = "Refresh token required" 197 197 + } 198 198 + next 199 199 + ctx 200 200 + else 201 201 + match! accountStore.GetAccountByDid did with 202 202 + | None -> 203 203 + ctx.SetStatusCode 401 204 204 + return! json { error = "AccountNotFound"; message = "Account not found" } next ctx 205 205 + | Some account -> 206 206 + let accessJwt = PDSharp.Core.Auth.createAccessToken config.JwtSecret account.Did 207 207 + let refreshJwt = PDSharp.Core.Auth.createRefreshToken config.JwtSecret account.Did 208 208 + ctx.SetStatusCode 200 209 209 + 210 210 + return! 211 211 + json 212 212 + { 213 213 + accessJwt = accessJwt 214 214 + refreshJwt = refreshJwt 215 215 + handle = account.Handle 216 216 + did = account.Did 217 217 + email = account.Email 218 218 + } 219 219 + next 220 220 + ctx 221 221 + }

+149

PDSharp/Handlers/Common.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open System 4 4 + open System.Text.Json 5 5 + open System.Collections.Concurrent 6 6 + open System.Net.WebSockets 7 7 + open PDSharp.Core 8 8 + open PDSharp.Core.Models 9 9 + open PDSharp.Core.BlockStore 10 10 + open PDSharp.Core.Repository 11 11 + open PDSharp.Core.Mst 12 12 + open PDSharp.Core.SqliteStore 13 13 + open PDSharp.Core.Crypto 14 14 + open PDSharp.Core.Firehose 15 15 + 16 16 + /// Repo state per DID: MST root, collections, current rev, head commit CID 17 17 + type RepoData = { 18 18 + Did : string 19 19 + Head : Cid option 20 20 + Mst : Mst.MstNode 21 21 + Collections : Map<string, string> 22 22 + } 23 23 + 24 24 + /// Manages active Firehose WebSocket subscribers 25 25 + type FirehoseState() = 26 26 + member val Subscribers = ConcurrentDictionary<string, WebSocket>() with get 27 27 + 28 28 + /// Simple in-memory key store (TODO: Persist) 29 29 + type SigningKeyStore() = 30 30 + let mutable keys : Map<string, EcKeyPair> = Map.empty 31 31 + let lockObj = obj () 32 32 + 33 33 + member _.GetOrCreateKey(did : string) = 34 34 + lock lockObj (fun () -> 35 35 + match Map.tryFind did keys with 36 36 + | Some k -> k 37 37 + | None -> 38 38 + let k = Crypto.generateKey P256 39 39 + keys <- Map.add did k keys 40 40 + k) 41 41 + 42 42 + [<CLIMutable>] 43 43 + type ErrorResponse = { error : string; message : string } 44 44 + 45 45 + module Persistence = 46 46 + let nodeLoader (blockStore : IBlockStore) (cid : Cid) = async { 47 47 + let! data = blockStore.Get cid 48 48 + return data |> Option.map Mst.deserialize 49 49 + } 50 50 + 51 51 + let nodePersister (blockStore : IBlockStore) (node : MstNode) = async { 52 52 + let bytes = Mst.serialize node 53 53 + return! blockStore.Put bytes 54 54 + } 55 55 + 56 56 + let loadRepo (repoStore : IRepoStore) (blockStore : IBlockStore) (did : string) : Async<RepoData option> = async { 57 57 + let! rowOpt = repoStore.GetRepo did 58 58 + 59 59 + match rowOpt with 60 60 + | None -> return None 61 61 + | Some row -> 62 62 + let! mstNode = async { 63 63 + if String.IsNullOrEmpty row.mst_root_cid then 64 64 + return None 65 65 + else 66 66 + match Cid.TryParse row.mst_root_cid with 67 67 + | None -> return None 68 68 + | Some rootCid -> return! nodeLoader blockStore rootCid 69 69 + } 70 70 + 71 71 + let mst = mstNode |> Option.defaultValue { Left = None; Entries = [] } 72 72 + 73 73 + let collections = 74 74 + try 75 75 + JsonSerializer.Deserialize<Map<string, string>>(row.collections_json) 76 76 + with _ -> 77 77 + Map.empty 78 78 + 79 79 + let head = 80 80 + if String.IsNullOrEmpty row.head_cid then 81 81 + None 82 82 + else 83 83 + Cid.TryParse row.head_cid 84 84 + 85 85 + return 86 86 + Some { 87 87 + Did = did 88 88 + Head = head 89 89 + Mst = mst 90 90 + Collections = collections 91 91 + } 92 92 + } 93 93 + 94 94 + let saveRepo (repoStore : IRepoStore) (blockStore : IBlockStore) (repo : RepoData) (rev : string) : Async<unit> = async { 95 95 + let! rootCid = nodePersister blockStore repo.Mst 96 96 + 97 97 + let row : RepoRow = { 98 98 + did = repo.Did 99 99 + rev = rev 100 100 + mst_root_cid = rootCid.ToString() 101 101 + head_cid = 102 102 + (match repo.Head with 103 103 + | Some c -> c.ToString() 104 104 + | None -> "") 105 105 + collections_json = JsonSerializer.Serialize repo.Collections 106 106 + } 107 107 + 108 108 + do! repoStore.SaveRepo row 109 109 + } 110 110 + 111 111 + let signAndStoreCommit 112 112 + (blockStore : IBlockStore) 113 113 + (keyStore : SigningKeyStore) 114 114 + (did : string) 115 115 + (mstRootCid : Cid) 116 116 + (rev : string) 117 117 + (prev : Cid option) 118 118 + = 119 119 + async { 120 120 + let key = keyStore.GetOrCreateKey did 121 121 + 122 122 + let unsigned : UnsignedCommit = { 123 123 + Did = did 124 124 + Version = 3 125 125 + Data = mstRootCid 126 126 + Rev = rev 127 127 + Prev = prev 128 128 + } 129 129 + 130 130 + let signed = signCommit key unsigned 131 131 + let commitBytes = serializeCommit signed 132 132 + let! commitCid = blockStore.Put(commitBytes) 133 133 + return signed, commitCid 134 134 + } 135 135 + 136 136 + let broadcastEvent (firehose : FirehoseState) (event : CommitEvent) = 137 137 + let eventBytes = Firehose.encodeEvent event 138 138 + let segment = ArraySegment<byte>(eventBytes) 139 139 + 140 140 + for kvp in firehose.Subscribers do 141 141 + let ws = kvp.Value 142 142 + 143 143 + if ws.State = WebSocketState.Open then 144 144 + try 145 145 + ws.SendAsync(segment, WebSocketMessageType.Binary, true, System.Threading.CancellationToken.None) 146 146 + |> Async.AwaitTask 147 147 + |> Async.RunSynchronously 148 148 + with _ -> 149 149 + firehose.Subscribers.TryRemove(kvp.Key) |> ignore

+32

PDSharp/Handlers/Health.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open System.Text.Json 4 4 + open Microsoft.AspNetCore.Http 5 5 + open Giraffe 6 6 + open PDSharp.Core.Health 7 7 + open PDSharp.Core.Config 8 8 + 9 9 + module HealthHandler = 10 10 + /// PDS version (could be read from assembly info) 11 11 + let private version = "0.1.0" 12 12 + 13 13 + /// JSON serialization options with camelCase naming 14 14 + let private jsonOptions = 15 15 + JsonSerializerOptions(PropertyNamingPolicy = JsonNamingPolicy.CamelCase, WriteIndented = true) 16 16 + 17 17 + /// Health check handler for /xrpc/_health endpoint 18 18 + let healthHandler : HttpHandler = 19 19 + fun next ctx -> task { 20 20 + let config = ctx.GetService<AppConfig>() 21 21 + let healthState = ctx.GetService<HealthState>() 22 22 + let status = buildHealthStatus version healthState config.SqliteConnectionString "." // Check disk of current working directory 23 23 + 24 24 + if status.DatabaseStatus.IsHealthy then 25 25 + ctx.SetStatusCode 200 26 26 + else 27 27 + ctx.SetStatusCode 503 28 28 + 29 29 + let json = JsonSerializer.Serialize(status, jsonOptions) 30 30 + ctx.SetContentType "application/json" 31 31 + return! text json next ctx 32 32 + }

+261

PDSharp/Handlers/Repo.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open System 4 4 + open System.Text 5 5 + open System.Text.Json 6 6 + open Microsoft.AspNetCore.Http 7 7 + open Giraffe 8 8 + open PDSharp.Core 9 9 + open PDSharp.Core.Models 10 10 + open PDSharp.Core.BlockStore 11 11 + open PDSharp.Core.Repository 12 12 + open PDSharp.Core.Mst 13 13 + open PDSharp.Core.Lexicon 14 14 + open PDSharp.Core.Car 15 15 + open PDSharp.Core.Firehose 16 16 + open PDSharp.Core.SqliteStore 17 17 + open PDSharp.Handlers 18 18 + 19 19 + module Repo = 20 20 + [<CLIMutable>] 21 21 + type CreateRecordRequest = { 22 22 + repo : string 23 23 + collection : string 24 24 + record : JsonElement 25 25 + rkey : string option 26 26 + } 27 27 + 28 28 + [<CLIMutable>] 29 29 + type CreateRecordResponse = { 30 30 + uri : string 31 31 + cid : string 32 32 + commit : {| rev : string; cid : string |} 33 33 + } 34 34 + 35 35 + [<CLIMutable>] 36 36 + type GetRecordResponse = { uri : string; cid : string; value : JsonElement } 37 37 + 38 38 + let createRecordHandler : HttpHandler = 39 39 + fun next ctx -> task { 40 40 + let blockStore = ctx.GetService<IBlockStore>() 41 41 + let repoStore = ctx.GetService<IRepoStore>() 42 42 + let keyStore = ctx.GetService<SigningKeyStore>() 43 43 + let firehose = ctx.GetService<FirehoseState>() 44 44 + 45 45 + let! body = ctx.ReadBodyFromRequestAsync() 46 46 + 47 47 + let request = 48 48 + JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 49 49 + 50 50 + match Lexicon.validate request.collection request.record with 51 51 + | Lexicon.Error msg -> 52 52 + ctx.SetStatusCode 400 53 53 + return! json { error = "InvalidRequest"; message = msg } next ctx 54 54 + | Lexicon.Ok -> 55 55 + let did = request.repo 56 56 + 57 57 + let rkey = 58 58 + match request.rkey with 59 59 + | Some r when not (String.IsNullOrWhiteSpace r) -> r 60 60 + | _ -> Tid.generate () 61 61 + 62 62 + let recordJson = request.record.GetRawText() 63 63 + let recordBytes = Encoding.UTF8.GetBytes(recordJson) 64 64 + let! recordCid = blockStore.Put(recordBytes) 65 65 + 66 66 + let! existingRepoOpt = Persistence.loadRepo repoStore blockStore did 67 67 + 68 68 + let repoData = 69 69 + match existingRepoOpt with 70 70 + | Some r -> r 71 71 + | None -> { 72 72 + Did = did 73 73 + Head = None 74 74 + Mst = { Left = None; Entries = [] } 75 75 + Collections = Map.empty 76 76 + } 77 77 + 78 78 + let mstKey = $"{request.collection}/{rkey}" 79 79 + let loader = Persistence.nodeLoader blockStore 80 80 + let persister = Persistence.nodePersister blockStore 81 81 + 82 82 + let! newMstRoot = Mst.put loader persister repoData.Mst mstKey recordCid "" 83 83 + 84 84 + let newRev = Tid.generate () 85 85 + let! mstRootCid = persister newMstRoot 86 86 + 87 87 + let! (_, commitCid) = Persistence.signAndStoreCommit blockStore keyStore did mstRootCid newRev repoData.Head 88 88 + 89 89 + let updatedRepo = { 90 90 + Did = did 91 91 + Mst = newMstRoot 92 92 + Collections = Map.empty 93 93 + Head = Some commitCid 94 94 + } 95 95 + 96 96 + do! Persistence.saveRepo repoStore blockStore updatedRepo newRev 97 97 + 98 98 + let carBytes = Car.createCar [ commitCid ] [ (recordCid, recordBytes) ] 99 99 + let event = Firehose.createCommitEvent did newRev commitCid carBytes 100 100 + Persistence.broadcastEvent firehose event 101 101 + 102 102 + let uri = $"at://{did}/{request.collection}/{rkey}" 103 103 + ctx.SetStatusCode 200 104 104 + 105 105 + return! 106 106 + json 107 107 + {| 108 108 + uri = uri 109 109 + cid = recordCid.ToString() 110 110 + commit = {| rev = newRev; cid = commitCid.ToString() |} 111 111 + |} 112 112 + next 113 113 + ctx 114 114 + } 115 115 + 116 116 + let getRecordHandler : HttpHandler = 117 117 + fun next ctx -> task { 118 118 + let repoStore = ctx.GetService<IRepoStore>() 119 119 + let blockStore = ctx.GetService<IBlockStore>() 120 120 + 121 121 + let repo = ctx.Request.Query.["repo"].ToString() 122 122 + let collection = ctx.Request.Query.["collection"].ToString() 123 123 + let rkey = ctx.Request.Query.["rkey"].ToString() 124 124 + 125 125 + if 126 126 + String.IsNullOrWhiteSpace(repo) 127 127 + || String.IsNullOrWhiteSpace(collection) 128 128 + || String.IsNullOrWhiteSpace(rkey) 129 129 + then 130 130 + ctx.SetStatusCode 400 131 131 + 132 132 + return! 133 133 + json 134 134 + { 135 135 + error = "InvalidRequest" 136 136 + message = "Missing required params" 137 137 + } 138 138 + next 139 139 + ctx 140 140 + else 141 141 + let! repoOpt = Persistence.loadRepo repoStore blockStore repo 142 142 + 143 143 + match repoOpt with 144 144 + | None -> 145 145 + ctx.SetStatusCode 404 146 146 + 147 147 + return! 148 148 + json 149 149 + { 150 150 + error = "RepoNotFound" 151 151 + message = $"Repository not found: {repo}" 152 152 + } 153 153 + next 154 154 + ctx 155 155 + | Some repoData -> 156 156 + let mstKey = $"{collection}/{rkey}" 157 157 + let loader = Persistence.nodeLoader blockStore 158 158 + let! cidOpt = Mst.get loader repoData.Mst mstKey "" 159 159 + 160 160 + match cidOpt with 161 161 + | None -> 162 162 + ctx.SetStatusCode 404 163 163 + return! json { error = "RecordNotFound"; message = "Record not found" } next ctx 164 164 + | Some recordCid -> 165 165 + let! recordBytesOpt = blockStore.Get(recordCid) 166 166 + 167 167 + match recordBytesOpt with 168 168 + | None -> 169 169 + ctx.SetStatusCode 500 170 170 + return! json { error = "InternalError"; message = "Block missing" } next ctx 171 171 + | Some recordBytes -> 172 172 + let recordJson = Encoding.UTF8.GetString(recordBytes) 173 173 + let uri = $"at://{repo}/{collection}/{rkey}" 174 174 + let valueElement = JsonSerializer.Deserialize<JsonElement>(recordJson) 175 175 + ctx.SetStatusCode 200 176 176 + 177 177 + return! 178 178 + json 179 179 + {| 180 180 + uri = uri 181 181 + cid = recordCid.ToString() 182 182 + value = valueElement 183 183 + |} 184 184 + next 185 185 + ctx 186 186 + } 187 187 + 188 188 + let putRecordHandler : HttpHandler = 189 189 + fun next ctx -> task { 190 190 + let blockStore = ctx.GetService<IBlockStore>() 191 191 + let repoStore = ctx.GetService<IRepoStore>() 192 192 + let keyStore = ctx.GetService<SigningKeyStore>() 193 193 + let firehose = ctx.GetService<FirehoseState>() 194 194 + 195 195 + let! body = ctx.ReadBodyFromRequestAsync() 196 196 + 197 197 + let request = 198 198 + JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 199 199 + 200 200 + match Lexicon.validate request.collection request.record with 201 201 + | Lexicon.Error msg -> 202 202 + ctx.SetStatusCode 400 203 203 + return! json { error = "InvalidRequest"; message = msg } next ctx 204 204 + | Lexicon.Ok -> 205 205 + match request.rkey with 206 206 + | Some r when not (String.IsNullOrWhiteSpace r) -> 207 207 + let did = request.repo 208 208 + let recordJson = request.record.GetRawText() 209 209 + let recordBytes = Encoding.UTF8.GetBytes(recordJson) 210 210 + let! recordCid = blockStore.Put(recordBytes) 211 211 + 212 212 + let! existingRepoOpt = Persistence.loadRepo repoStore blockStore did 213 213 + 214 214 + let repoData = 215 215 + match existingRepoOpt with 216 216 + | Some r -> r 217 217 + | None -> { 218 218 + Did = did 219 219 + Head = None 220 220 + Mst = { Left = None; Entries = [] } 221 221 + Collections = Map.empty 222 222 + } 223 223 + 224 224 + let mstKey = $"{request.collection}/{r}" 225 225 + let loader = Persistence.nodeLoader blockStore 226 226 + let persister = Persistence.nodePersister blockStore 227 227 + 228 228 + let! newMstRoot = Mst.put loader persister repoData.Mst mstKey recordCid "" 229 229 + let! mstRootCid = persister newMstRoot 230 230 + 231 231 + let newRev = Tid.generate () 232 232 + let! (_, commitCid) = Persistence.signAndStoreCommit blockStore keyStore did mstRootCid newRev repoData.Head 233 233 + 234 234 + let updatedRepo = { 235 235 + Did = did 236 236 + Mst = newMstRoot 237 237 + Collections = Map.empty 238 238 + Head = Some commitCid 239 239 + } 240 240 + 241 241 + do! Persistence.saveRepo repoStore blockStore updatedRepo newRev 242 242 + 243 243 + let carBytes = Car.createCar [ commitCid ] [ (recordCid, recordBytes) ] 244 244 + let event = Firehose.createCommitEvent did newRev commitCid carBytes 245 245 + Persistence.broadcastEvent firehose event 246 246 + 247 247 + ctx.SetStatusCode 200 248 248 + 249 249 + return! 250 250 + json 251 251 + {| 252 252 + uri = $"at://{did}/{request.collection}/{r}" 253 253 + cid = recordCid.ToString() 254 254 + commit = {| rev = newRev; cid = commitCid.ToString() |} 255 255 + |} 256 256 + next 257 257 + ctx 258 258 + | _ -> 259 259 + ctx.SetStatusCode 400 260 260 + return! json { error = "InvalidRequest"; message = "rkey is required" } next ctx 261 261 + }

+66

PDSharp/Handlers/Server.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open Microsoft.AspNetCore.Http 4 4 + open Giraffe 5 5 + open PDSharp.Core.Config 6 6 + 7 7 + // ========================================= 8 8 + // Server & Meta Handlers 9 9 + // ========================================= 10 10 + 11 11 + module Server = 12 12 + [<CLIMutable>] 13 13 + type DescribeServerResponse = { 14 14 + availableUserDomains : string list 15 15 + did : string 16 16 + inviteCodeRequired : bool 17 17 + } 18 18 + 19 19 + let describeServerHandler : HttpHandler = 20 20 + fun next ctx -> 21 21 + let config = ctx.GetService<AppConfig>() 22 22 + 23 23 + let response = { 24 24 + availableUserDomains = [] 25 25 + did = config.DidHost 26 26 + inviteCodeRequired = true 27 27 + } 28 28 + 29 29 + json response next ctx 30 30 + 31 31 + let indexHandler : HttpHandler = 32 32 + fun next ctx -> 33 33 + let html = 34 34 + """<html> 35 35 + <head><title>PDSharp</title></head> 36 36 + <body> 37 37 + <pre> 38 38 + 888 888 8888888888 888 888 39 39 + 888 888 888 888 888 40 40 + 888 888 888 888888888888 41 41 + 8888b. 888888 88888b. 888d888 .d88b. 888888 .d88b. 88 8888888 888 888 42 42 + "88b 888 888 "88b 888P" d88""88b 888 d88""88b 888888 888 888 888 43 43 + .d888888 888 888 888 888 888 888 888 888 888 88 888 888888888888 44 44 + 888 888 Y88b. 888 d88P 888 Y88..88P Y88b. Y88..88P 888 888 888 45 45 + "Y888888 "Y888 88888P" 888 "Y88P" "Y888 "Y88P" 888 888 888 46 46 + 888 47 47 + 888 48 48 + 888 49 49 + 50 50 + 51 51 + This is an AT Protocol Personal Data Server (aka, an atproto PDS) 52 52 + 53 53 + Most API routes are under /xrpc/ 54 54 + 55 55 + Code: https://github.com/bluesky-social/atproto 56 56 + https://github.com/stormlightlabs/PDSharp 57 57 + https://tangled.org/desertthunder.dev/PDSharp 58 58 + Self-Host: https://github.com/bluesky-social/pds 59 59 + Protocol: https://atproto.com 60 60 + </pre> 61 61 + </body> 62 62 + </html>""" 63 63 + 64 64 + ctx.SetContentType "text/html" 65 65 + ctx.SetStatusCode 200 66 66 + ctx.WriteStringAsync html

+137

PDSharp/Handlers/Sync.fs

··· 1 1 + namespace PDSharp.Handlers 2 2 + 3 3 + open System 4 4 + open System.Threading.Tasks 5 5 + open System.Net.WebSockets 6 6 + open Microsoft.AspNetCore.Http 7 7 + open Giraffe 8 8 + open PDSharp.Core 9 9 + open PDSharp.Core.Models 10 10 + open PDSharp.Core.BlockStore 11 11 + open PDSharp.Core.Repository 12 12 + open PDSharp.Core.Car 13 13 + open PDSharp.Core.BlobStore 14 14 + open PDSharp.Core.SqliteStore 15 15 + open PDSharp.Handlers 16 16 + 17 17 + module Sync = 18 18 + let getRepoHandler : HttpHandler = 19 19 + fun next ctx -> task { 20 20 + let repoStore = ctx.GetService<IRepoStore>() 21 21 + let blockStore = ctx.GetService<IBlockStore>() 22 22 + let did = ctx.Request.Query.["did"].ToString() 23 23 + 24 24 + if String.IsNullOrWhiteSpace(did) then 25 25 + ctx.SetStatusCode 400 26 26 + return! json { error = "InvalidRequest"; message = "Missing did" } next ctx 27 27 + else 28 28 + let! repoOpt = Persistence.loadRepo repoStore blockStore did 29 29 + 30 30 + match repoOpt with 31 31 + | None -> 32 32 + ctx.SetStatusCode 404 33 33 + return! json { error = "RepoNotFound"; message = "Repository not found" } next ctx 34 34 + | Some repoData -> 35 35 + match repoData.Head with 36 36 + | None -> 37 37 + ctx.SetStatusCode 404 38 38 + 39 39 + return! 40 40 + json 41 41 + { 42 42 + error = "RepoNotFound" 43 43 + message = "Repository has no commits" 44 44 + } 45 45 + next 46 46 + ctx 47 47 + | Some headCid -> 48 48 + let! allBlocks = blockStore.GetAllCidsAndData() 49 49 + let carBytes = Car.createCar [ headCid ] allBlocks 50 50 + ctx.SetContentType "application/vnd.ipld.car" 51 51 + ctx.SetStatusCode 200 52 52 + return! ctx.WriteBytesAsync carBytes 53 53 + } 54 54 + 55 55 + let getBlocksHandler : HttpHandler = 56 56 + fun next ctx -> task { 57 57 + let repoStore = ctx.GetService<IRepoStore>() 58 58 + let blockStore = ctx.GetService<IBlockStore>() 59 59 + let did = ctx.Request.Query.["did"].ToString() 60 60 + let cidsParam = ctx.Request.Query.["cids"].ToString() 61 61 + 62 62 + if String.IsNullOrWhiteSpace did || String.IsNullOrWhiteSpace cidsParam then 63 63 + ctx.SetStatusCode 400 64 64 + return! json { error = "InvalidRequest"; message = "Missing parameters" } next ctx 65 65 + else 66 66 + let! repoOpt = Persistence.loadRepo repoStore blockStore did 67 67 + 68 68 + match repoOpt with 69 69 + | None -> 70 70 + ctx.SetStatusCode 404 71 71 + return! json { error = "RepoNotFound"; message = "Repository not found" } next ctx 72 72 + | Some _ -> 73 73 + let cidStrs = cidsParam.Split(',') |> Array.map (fun s -> s.Trim()) 74 74 + let parsedCids = cidStrs |> Array.choose Cid.TryParse |> Array.toList 75 75 + 76 76 + let! blocks = 77 77 + parsedCids 78 78 + |> List.map (fun cid -> async { 79 79 + let! dataOpt = blockStore.Get cid 80 80 + return dataOpt |> Option.map (fun d -> (cid, d)) 81 81 + }) 82 82 + |> Async.Sequential 83 83 + 84 84 + let foundBlocks = blocks |> Array.choose id |> Array.toList 85 85 + let roots = if foundBlocks.IsEmpty then [] else [ fst foundBlocks.Head ] 86 86 + let carBytes = Car.createCar roots foundBlocks 87 87 + ctx.SetContentType "application/vnd.ipld.car" 88 88 + ctx.SetStatusCode 200 89 89 + return! ctx.WriteBytesAsync carBytes 90 90 + } 91 91 + 92 92 + let getBlobHandler : HttpHandler = 93 93 + fun next ctx -> task { 94 94 + let blobStore = ctx.GetService<IBlobStore>() 95 95 + let did = ctx.Request.Query.["did"].ToString() 96 96 + let cidStr = ctx.Request.Query.["cid"].ToString() 97 97 + 98 98 + if String.IsNullOrWhiteSpace(did) || String.IsNullOrWhiteSpace(cidStr) then 99 99 + ctx.SetStatusCode 400 100 100 + return! json { error = "InvalidRequest"; message = "Missing parameters" } next ctx 101 101 + else 102 102 + match Cid.TryParse cidStr with 103 103 + | None -> 104 104 + ctx.SetStatusCode 400 105 105 + return! json { error = "InvalidCid"; message = "Invalid CID" } next ctx 106 106 + | Some cid -> 107 107 + let! blobOpt = blobStore.Get cid 108 108 + 109 109 + match blobOpt with 110 110 + | Some blob -> 111 111 + ctx.SetContentType "application/octet-stream" 112 112 + ctx.SetStatusCode 200 113 113 + return! ctx.WriteBytesAsync blob 114 114 + | None -> 115 115 + ctx.SetStatusCode 404 116 116 + return! json { error = "NotFound"; message = "Blob not found" } next ctx 117 117 + } 118 118 + 119 119 + let subscribeReposHandler : HttpHandler = 120 120 + fun next ctx -> task { 121 121 + if ctx.WebSockets.IsWebSocketRequest then 122 122 + let firehose = ctx.GetService<FirehoseState>() 123 123 + let! ws = ctx.WebSockets.AcceptWebSocketAsync() 124 124 + let id = Guid.NewGuid().ToString() 125 125 + firehose.Subscribers.TryAdd(id, ws) |> ignore 126 126 + 127 127 + try 128 128 + while ws.State = WebSocketState.Open do 129 129 + do! Task.Delay 1000 130 130 + finally 131 131 + firehose.Subscribers.TryRemove(id) |> ignore 132 132 + 133 133 + return Some ctx 134 134 + else 135 135 + ctx.SetStatusCode 400 136 136 + return! text "WebSocket upgrade required" next ctx 137 137 + }

+7 -1

PDSharp/PDSharp.fsproj

··· 6 6 </PropertyGroup> 7 7 8 8 <ItemGroup> 9 9 - <Compile Include="Program.fs" /> 9 9 + <Compile Include="Handlers/Common.fs" /> 10 10 + <Compile Include="Handlers/Server.fs" /> 11 11 + <Compile Include="Handlers/Auth.fs" /> 12 12 + <Compile Include="Handlers/Repo.fs" /> 13 13 + <Compile Include="Handlers/Sync.fs" /> 14 14 + <Compile Include="Handlers/Health.fs" /> 15 15 + <Compile Include="Program.fs" /> 10 16 </ItemGroup> 11 17 12 18 <ItemGroup>

+90 -26

PDSharp/Program.fs

··· 1 1 open System 2 2 - open System.IO 3 2 open Microsoft.AspNetCore.Builder 4 3 open Microsoft.AspNetCore.Hosting 5 4 open Microsoft.Extensions.Hosting 6 5 open Microsoft.Extensions.DependencyInjection 7 7 - open Microsoft.Extensions.Configuration 8 6 open Giraffe 9 9 - open PDSharp.Core.Models 7 7 + open PDSharp.Core 8 8 + open PDSharp.Core.Auth 9 9 + open PDSharp.Core.BlockStore 10 10 + open PDSharp.Core.SqliteStore 11 11 + open PDSharp.Core.BlobStore 10 12 open PDSharp.Core.Config 13 13 + open PDSharp.Core.Health 14 14 + open PDSharp.Handlers 11 15 12 12 - module App = 16 16 + let getConfig () = 17 17 + let env (k : string) (def : string) = 18 18 + match Environment.GetEnvironmentVariable k with 19 19 + | null -> def 20 20 + | v -> v 13 21 14 14 - let describeServerHandler : HttpHandler = 15 15 - fun next ctx -> 16 16 - let config = ctx.GetService<AppConfig>() 22 22 + let publicUrl = env "PDSHARP_PublicUrl" "http://localhost:5000" 23 23 + let dbPath = env "PDSHARP_DbPath" "pdsharp.db" 17 24 18 18 - // TODO: add to config 19 19 - let response = { 20 20 - availableUserDomains = [] 21 21 - did = config.DidHost 22 22 - inviteCodeRequired = true 25 25 + let disableWalAutoCheckpoint = 26 26 + env "PDSHARP_SQLITE_DISABLE_WAL_AUTO_CHECKPOINT" "false" |> bool.Parse 27 27 + 28 28 + let blobStoreConfig = 29 29 + match env "PDSHARP_BLOBSTORE_TYPE" "disk" with 30 30 + | "s3" -> 31 31 + S3 { 32 32 + Bucket = env "PDSHARP_S3_BUCKET" "pdsharp-blobs" 33 33 + Region = env "PDSHARP_S3_REGION" "us-east-1" 34 34 + AccessKey = Option.ofObj (Environment.GetEnvironmentVariable "PDSHARP_S3_ACCESS_KEY") 35 35 + SecretKey = Option.ofObj (Environment.GetEnvironmentVariable "PDSHARP_S3_SECRET_KEY") 36 36 + ServiceUrl = Option.ofObj (Environment.GetEnvironmentVariable "PDSHARP_S3_SERVICE_URL") 37 37 + ForcePathStyle = env "PDSHARP_S3_FORCE_PATH_STYLE" "false" |> bool.Parse 23 38 } 39 39 + | _ -> Disk "blobs" 24 40 25 25 - json response next ctx 41 41 + { 42 42 + PublicUrl = publicUrl 43 43 + DidHost = env "PDSHARP_DidHost" "did:web:localhost" 44 44 + JwtSecret = env "PDSHARP_JwtSecret" "development-secret-do-not-use-in-prod" 45 45 + SqliteConnectionString = $"Data Source={dbPath}" 46 46 + DisableWalAutoCheckpoint = disableWalAutoCheckpoint 47 47 + BlobStore = blobStoreConfig 48 48 + } 26 49 27 27 - let webApp = 50 50 + let config = getConfig () 51 51 + 52 52 + SqliteStore.initialize config 53 53 + 54 54 + module App = 55 55 + let appRouter = 28 56 choose [ 29 29 - route "/xrpc/com.atproto.server.describeServer" >=> describeServerHandler 57 57 + GET 58 58 + >=> choose [ 59 59 + route "/" >=> Server.indexHandler 60 60 + route "/xrpc/com.atproto.server.describeServer" >=> Server.describeServerHandler 61 61 + route "/xrpc/_health" >=> HealthHandler.healthHandler 62 62 + ] 63 63 + POST 64 64 + >=> route "/xrpc/com.atproto.server.createAccount" 65 65 + >=> Auth.createAccountHandler 66 66 + POST 67 67 + >=> route "/xrpc/com.atproto.server.createSession" 68 68 + >=> Auth.createSessionHandler 69 69 + POST 70 70 + >=> route "/xrpc/com.atproto.server.refreshSession" 71 71 + >=> Auth.refreshSessionHandler 72 72 + POST 73 73 + >=> route "/xrpc/com.atproto.repo.createRecord" 74 74 + >=> Repo.createRecordHandler 75 75 + GET >=> route "/xrpc/com.atproto.repo.getRecord" >=> Repo.getRecordHandler 76 76 + POST >=> route "/xrpc/com.atproto.repo.putRecord" >=> Repo.putRecordHandler 77 77 + GET >=> route "/xrpc/com.atproto.sync.getRepo" >=> Sync.getRepoHandler 78 78 + GET >=> route "/xrpc/com.atproto.sync.getBlocks" >=> Sync.getBlocksHandler 79 79 + GET >=> route "/xrpc/com.atproto.sync.getBlob" >=> Sync.getBlobHandler 80 80 + GET 81 81 + >=> route "/xrpc/com.atproto.sync.subscribeRepos" 82 82 + >=> Sync.subscribeReposHandler 30 83 route "/" >=> text "PDSharp PDS is running." 31 84 RequestErrors.NOT_FOUND "Not Found" 32 85 ] 33 86 34 34 - let configureApp (app : IApplicationBuilder) = app.UseGiraffe webApp 87 87 + let webApp (app : IApplicationBuilder) = 88 88 + app.UseWebSockets() |> ignore 89 89 + app.UseGiraffe appRouter 35 90 36 91 let configureServices (config : AppConfig) (services : IServiceCollection) = 37 92 services.AddGiraffe() |> ignore 38 93 services.AddSingleton<AppConfig>(config) |> ignore 39 94 95 95 + let blockStore = new SqliteBlockStore(config.SqliteConnectionString) 96 96 + let accountStore = new SqliteAccountStore(config.SqliteConnectionString) 97 97 + let repoStore = new SqliteRepoStore(config.SqliteConnectionString) 98 98 + 99 99 + services.AddSingleton<IBlockStore> blockStore |> ignore 100 100 + services.AddSingleton<IAccountStore> accountStore |> ignore 101 101 + services.AddSingleton<IRepoStore> repoStore |> ignore 102 102 + 103 103 + let blobStore : IBlobStore = 104 104 + match config.BlobStore with 105 105 + | Disk path -> new DiskBlobStore(path) :> IBlobStore 106 106 + | S3 s3Config -> new S3BlobStore(s3Config) :> IBlobStore 107 107 + 108 108 + services.AddSingleton<IBlobStore> blobStore |> ignore 109 109 + services.AddSingleton<FirehoseState>(new FirehoseState()) |> ignore 110 110 + services.AddSingleton<SigningKeyStore>(new SigningKeyStore()) |> ignore 111 111 + services.AddSingleton<HealthState>(new HealthState()) |> ignore 112 112 + 40 113 [<EntryPoint>] 41 114 let main args = 42 42 - let configBuilder = 43 43 - ConfigurationBuilder() 44 44 - .SetBasePath(AppContext.BaseDirectory) 45 45 - .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) 46 46 - .AddEnvironmentVariables(prefix = "PDSHARP_") 47 47 - .Build() 48 48 - 49 49 - let appConfig = configBuilder.Get<AppConfig>() 50 50 - 51 115 Host 52 116 .CreateDefaultBuilder(args) 53 117 .ConfigureWebHostDefaults(fun webHostBuilder -> 54 54 - webHostBuilder.Configure(configureApp).ConfigureServices(configureServices appConfig) 118 118 + webHostBuilder.Configure(webApp).ConfigureServices(configureServices config) 55 119 |> ignore) 56 120 .Build() 57 121 .Run()

+2 -1

PDSharp/appsettings.json

··· 1 1 { 2 2 "PublicUrl": "http://localhost:5000", 3 3 - "DidHost": "did:web:localhost" 3 3 + "DidHost": "did:web:localhost", 4 4 + "JwtSecret": "change-this-secret-in-production-minimum-32-chars" 4 5 }

+41

PDSharp.Core/AtUri.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Text.RegularExpressions 5 5 + 6 6 + /// AT-URI parsing and validation 7 7 + module AtUri = 8 8 + /// Represents an AT Protocol URI: at://did/collection/rkey 9 9 + type AtUri = { Did : string; Collection : string; Rkey : string } 10 10 + 11 11 + let private didPattern = @"^did:[a-z]+:[a-zA-Z0-9._:%-]+$" 12 12 + let private nsidPattern = @"^[a-z][a-z0-9]*(\.[a-z][a-z0-9]*)+$" 13 13 + let private rkeyPattern = @"^[a-zA-Z0-9._~-]+$" 14 14 + 15 15 + /// Parse an AT-URI string into components 16 16 + let parse (uri : string) : Result<AtUri, string> = 17 17 + if not (uri.StartsWith("at://")) then 18 18 + Error "AT-URI must start with at://" 19 19 + else 20 20 + let path = uri.Substring(5) 21 21 + let parts = path.Split('/') 22 22 + 23 23 + if parts.Length < 3 then 24 24 + Error "AT-URI must have format at://did/collection/rkey" 25 25 + else 26 26 + let did = parts.[0] 27 27 + let collection = parts.[1] 28 28 + let rkey = parts.[2] 29 29 + 30 30 + if not (Regex.IsMatch(did, didPattern)) then 31 31 + Error $"Invalid DID format: {did}" 32 32 + elif not (Regex.IsMatch(collection, nsidPattern)) then 33 33 + Error $"Invalid collection NSID: {collection}" 34 34 + elif not (Regex.IsMatch(rkey, rkeyPattern)) then 35 35 + Error $"Invalid rkey format: {rkey}" 36 36 + else 37 37 + Ok { Did = did; Collection = collection; Rkey = rkey } 38 38 + 39 39 + /// Convert AtUri back to string 40 40 + let toString (uri : AtUri) : string = 41 41 + $"at://{uri.Did}/{uri.Collection}/{uri.Rkey}"

+218

PDSharp.Core/Auth.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Text 5 5 + open Org.BouncyCastle.Crypto.Digests 6 6 + open Org.BouncyCastle.Crypto.Macs 7 7 + open Org.BouncyCastle.Crypto.Parameters 8 8 + open Org.BouncyCastle.Security 9 9 + 10 10 + /// Authentication module for sessions and accounts 11 11 + /// TODO: Migrate account storage from in-memory to SQLite/Postgres for production 12 12 + module Auth = 13 13 + /// Hash a password with a random salt using SHA-256 14 14 + /// 15 15 + /// Returns: base64(salt)$base64(hash) 16 16 + let hashPassword (password : string) : string = 17 17 + let salt = Array.zeroCreate<byte> 16 18 18 + SecureRandom().NextBytes(salt) 19 19 + 20 20 + let passwordBytes = Encoding.UTF8.GetBytes(password) 21 21 + let toHash = Array.append salt passwordBytes 22 22 + 23 23 + let digest = Sha256Digest() 24 24 + digest.BlockUpdate(toHash, 0, toHash.Length) 25 25 + let hash = Array.zeroCreate<byte> (digest.GetDigestSize()) 26 26 + digest.DoFinal(hash, 0) |> ignore 27 27 + 28 28 + $"{Convert.ToBase64String(salt)}${Convert.ToBase64String(hash)}" 29 29 + 30 30 + /// Verify a password against a stored hash 31 31 + let verifyPassword (password : string) (storedHash : string) : bool = 32 32 + let parts = storedHash.Split('$') 33 33 + 34 34 + if parts.Length <> 2 then 35 35 + false 36 36 + else 37 37 + try 38 38 + let salt = Convert.FromBase64String(parts.[0]) 39 39 + let expectedHash = Convert.FromBase64String(parts.[1]) 40 40 + 41 41 + let passwordBytes = Encoding.UTF8.GetBytes(password) 42 42 + let toHash = Array.append salt passwordBytes 43 43 + 44 44 + let digest = Sha256Digest() 45 45 + digest.BlockUpdate(toHash, 0, toHash.Length) 46 46 + let actualHash = Array.zeroCreate<byte> (digest.GetDigestSize()) 47 47 + digest.DoFinal(actualHash, 0) |> ignore 48 48 + 49 49 + actualHash = expectedHash 50 50 + with _ -> 51 51 + false 52 52 + 53 53 + let private base64UrlEncode (bytes : byte[]) : string = 54 54 + Convert.ToBase64String(bytes).Replace('+', '-').Replace('/', '_').TrimEnd('=') 55 55 + 56 56 + let private base64UrlDecode (str : string) : byte[] = 57 57 + let padded = 58 58 + match str.Length % 4 with 59 59 + | 2 -> str + "==" 60 60 + | 3 -> str + "=" 61 61 + | _ -> str 62 62 + 63 63 + Convert.FromBase64String(padded.Replace('-', '+').Replace('_', '/')) 64 64 + 65 65 + let private hmacSha256 (secret : byte[]) (data : byte[]) : byte[] = 66 66 + let hmac = HMac(Sha256Digest()) 67 67 + hmac.Init(KeyParameter(secret)) 68 68 + hmac.BlockUpdate(data, 0, data.Length) 69 69 + let result = Array.zeroCreate<byte> (hmac.GetMacSize()) 70 70 + hmac.DoFinal(result, 0) |> ignore 71 71 + result 72 72 + 73 73 + /// Token type for domain separation per AT Protocol spec 74 74 + type TokenType = 75 75 + | Access // typ: at+jwt 76 76 + | Refresh // typ: refresh+jwt 77 77 + 78 78 + /// Create a JWT token 79 79 + let createToken (secret : string) (tokenType : TokenType) (did : string) (expiresIn : TimeSpan) : string = 80 80 + let now = DateTimeOffset.UtcNow 81 81 + let exp = now.Add(expiresIn) 82 82 + 83 83 + let typ = 84 84 + match tokenType with 85 85 + | Access -> "at+jwt" 86 86 + | Refresh -> "refresh+jwt" 87 87 + 88 88 + let jti = Guid.NewGuid().ToString("N") 89 89 + 90 90 + let header = $"""{{ "alg": "HS256", "typ": "{typ}" }}""" 91 91 + let headerB64 = base64UrlEncode (Encoding.UTF8.GetBytes(header)) 92 92 + 93 93 + let payload = 94 94 + $"""{{ "sub": "{did}", "iat": {now.ToUnixTimeSeconds()}, "exp": {exp.ToUnixTimeSeconds()}, "jti": "{jti}" }}""" 95 95 + 96 96 + let payloadB64 = base64UrlEncode (Encoding.UTF8.GetBytes(payload)) 97 97 + 98 98 + let signingInput = $"{headerB64}.{payloadB64}" 99 99 + let secretBytes = Encoding.UTF8.GetBytes(secret) 100 100 + let signature = hmacSha256 secretBytes (Encoding.UTF8.GetBytes(signingInput)) 101 101 + let signatureB64 = base64UrlEncode signature 102 102 + 103 103 + $"{headerB64}.{payloadB64}.{signatureB64}" 104 104 + 105 105 + /// Create an access token (short-lived) 106 106 + let createAccessToken (secret : string) (did : string) : string = 107 107 + createToken secret Access did (TimeSpan.FromMinutes(15.0)) 108 108 + 109 109 + /// Create a refresh token (longer-lived) 110 110 + let createRefreshToken (secret : string) (did : string) : string = 111 111 + createToken secret Refresh did (TimeSpan.FromDays(7.0)) 112 112 + 113 113 + /// Validation result 114 114 + type TokenValidation = 115 115 + | Valid of did : string * tokenType : TokenType * exp : int64 116 116 + | Invalid of reason : string 117 117 + 118 118 + /// Validate a JWT token and extract claims 119 119 + let validateToken (secret : string) (token : string) : TokenValidation = 120 120 + let parts = token.Split('.') 121 121 + 122 122 + if parts.Length <> 3 then 123 123 + Invalid "Invalid token format" 124 124 + else 125 125 + try 126 126 + let headerB64, payloadB64, signatureB64 = parts.[0], parts.[1], parts.[2] 127 127 + 128 128 + let signingInput = $"{headerB64}.{payloadB64}" 129 129 + let secretBytes = Encoding.UTF8.GetBytes(secret) 130 130 + let expectedSig = hmacSha256 secretBytes (Encoding.UTF8.GetBytes(signingInput)) 131 131 + let actualSig = base64UrlDecode signatureB64 132 132 + 133 133 + if expectedSig <> actualSig then 134 134 + Invalid "Invalid signature" 135 135 + else 136 136 + let payloadJson = Encoding.UTF8.GetString(base64UrlDecode payloadB64) 137 137 + let headerJson = Encoding.UTF8.GetString(base64UrlDecode headerB64) 138 138 + 139 139 + let typMatch = 140 140 + System.Text.RegularExpressions.Regex.Match(headerJson, "\"typ\"\\s*:\\s*\"([^\"]+)\"") 141 141 + 142 142 + let tokenType = 143 143 + if typMatch.Success then 144 144 + match typMatch.Groups.[1].Value with 145 145 + | "at+jwt" -> Access 146 146 + | "refresh+jwt" -> Refresh 147 147 + | _ -> Access 148 148 + else 149 149 + Access 150 150 + 151 151 + let subMatch = 152 152 + System.Text.RegularExpressions.Regex.Match(payloadJson, "\"sub\"\\s*:\\s*\"([^\"]+)\"") 153 153 + 154 154 + let expMatch = 155 155 + System.Text.RegularExpressions.Regex.Match(payloadJson, "\"exp\"\\s*:\\s*([0-9]+)") 156 156 + 157 157 + if not subMatch.Success || not expMatch.Success then 158 158 + Invalid "Missing claims" 159 159 + else 160 160 + let did = subMatch.Groups.[1].Value 161 161 + let exp = Int64.Parse(expMatch.Groups.[1].Value) 162 162 + let now = DateTimeOffset.UtcNow.ToUnixTimeSeconds() 163 163 + 164 164 + if now > exp then 165 165 + Invalid "Token expired" 166 166 + else 167 167 + Valid(did, tokenType, exp) 168 168 + with ex -> 169 169 + Invalid $"Parse error: {ex.Message}" 170 170 + 171 171 + /// Account record 172 172 + type Account = { 173 173 + Did : string 174 174 + Handle : string 175 175 + PasswordHash : string 176 176 + Email : string option 177 177 + CreatedAt : DateTimeOffset 178 178 + } 179 179 + 180 180 + /// Interface for account persistence 181 181 + type IAccountStore = 182 182 + abstract member CreateAccount : Account -> Async<Result<unit, string>> 183 183 + abstract member GetAccountByHandle : string -> Async<Account option> 184 184 + abstract member GetAccountByDid : string -> Async<Account option> 185 185 + 186 186 + /// Create a new account 187 187 + let createAccount 188 188 + (store : IAccountStore) 189 189 + (handle : string) 190 190 + (password : string) 191 191 + (email : string option) 192 192 + : Async<Result<Account, string>> = 193 193 + async { 194 194 + let! existingHandle = store.GetAccountByHandle handle 195 195 + 196 196 + match existingHandle with 197 197 + | Some _ -> return Error "Handle already taken" 198 198 + | None -> 199 199 + let did = $"did:web:{handle}" 200 200 + let! existingDid = store.GetAccountByDid did 201 201 + 202 202 + match existingDid with 203 203 + | Some _ -> return Error "Account already exists" 204 204 + | None -> 205 205 + let account = { 206 206 + Did = did 207 207 + Handle = handle 208 208 + PasswordHash = hashPassword password 209 209 + Email = email 210 210 + CreatedAt = DateTimeOffset.UtcNow 211 211 + } 212 212 + 213 213 + let! result = store.CreateAccount account 214 214 + 215 215 + match result with 216 216 + | Ok() -> return Ok account 217 217 + | Error e -> return Error e 218 218 + }

+124

PDSharp.Core/BlobStore.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System.IO 4 4 + open Amazon.S3 5 5 + open Amazon.S3.Model 6 6 + open PDSharp.Core.Config 7 7 + 8 8 + /// Interface for binary large object (blob) storage 9 9 + type IBlobStore = 10 10 + /// Store a blob by CID 11 11 + abstract member Put : Cid * byte[] -> Async<unit> 12 12 + /// Retrieve a blob by CID 13 13 + abstract member Get : Cid -> Async<byte[] option> 14 14 + /// Check if a blob exists (optional optimization) 15 15 + abstract member Has : Cid -> Async<bool> 16 16 + /// Delete a blob by CID 17 17 + abstract member Delete : Cid -> Async<unit> 18 18 + 19 19 + module BlobStore = 20 20 + 21 21 + /// File-system based blob store 22 22 + type DiskBlobStore(encodedRootPath : string) = 23 23 + let rootPath = 24 24 + if Path.IsPathRooted encodedRootPath then 25 25 + encodedRootPath 26 26 + else 27 27 + Path.Combine(Directory.GetCurrentDirectory(), encodedRootPath) 28 28 + 29 29 + do 30 30 + if not (Directory.Exists rootPath) then 31 31 + Directory.CreateDirectory(rootPath) |> ignore 32 32 + 33 33 + let getPath (cid : Cid) = Path.Combine(rootPath, cid.ToString()) 34 34 + 35 35 + interface IBlobStore with 36 36 + member _.Put(cid, data) = async { 37 37 + let path = getPath cid 38 38 + 39 39 + if not (File.Exists path) then 40 40 + do! File.WriteAllBytesAsync(path, data) |> Async.AwaitTask 41 41 + } 42 42 + 43 43 + member _.Get(cid) = async { 44 44 + let path = getPath cid 45 45 + 46 46 + if File.Exists path then 47 47 + let! data = File.ReadAllBytesAsync(path) |> Async.AwaitTask 48 48 + return Some data 49 49 + else 50 50 + return None 51 51 + } 52 52 + 53 53 + member _.Has(cid) = async { return File.Exists(getPath cid) } 54 54 + 55 55 + member _.Delete(cid) = async { 56 56 + let path = getPath cid 57 57 + 58 58 + if File.Exists path then 59 59 + File.Delete path 60 60 + } 61 61 + 62 62 + /// S3-based blob store 63 63 + type S3BlobStore(config : S3Config) = 64 64 + let client = 65 65 + let clientConfig = 66 66 + AmazonS3Config(RegionEndpoint = Amazon.RegionEndpoint.GetBySystemName config.Region) 67 67 + 68 68 + match config.ServiceUrl with 69 69 + | Some url -> clientConfig.ServiceURL <- url 70 70 + | None -> () 71 71 + 72 72 + clientConfig.ForcePathStyle <- config.ForcePathStyle 73 73 + 74 74 + match config.AccessKey, config.SecretKey with 75 75 + | Some access, Some secret -> new AmazonS3Client(access, secret, clientConfig) 76 76 + | _ -> new AmazonS3Client(clientConfig) 77 77 + 78 78 + let bucket = config.Bucket 79 79 + 80 80 + interface IBlobStore with 81 81 + member _.Put(cid, data) = async { 82 82 + let request = PutObjectRequest() 83 83 + request.BucketName <- bucket 84 84 + request.Key <- cid.ToString() 85 85 + use ms = new MemoryStream(data) 86 86 + request.InputStream <- ms 87 87 + let! _ = client.PutObjectAsync(request) |> Async.AwaitTask 88 88 + () 89 89 + } 90 90 + 91 91 + member _.Get(cid) = async { 92 92 + try 93 93 + let request = GetObjectRequest() 94 94 + request.BucketName <- bucket 95 95 + request.Key <- cid.ToString() 96 96 + 97 97 + use! response = client.GetObjectAsync(request) |> Async.AwaitTask 98 98 + use ms = new MemoryStream() 99 99 + do! response.ResponseStream.CopyToAsync(ms) |> Async.AwaitTask 100 100 + return Some(ms.ToArray()) 101 101 + with 102 102 + | :? AmazonS3Exception as ex when ex.StatusCode = System.Net.HttpStatusCode.NotFound -> return None 103 103 + | _ -> return None 104 104 + } 105 105 + 106 106 + member _.Has(cid) = async { 107 107 + try 108 108 + let request = GetObjectMetadataRequest() 109 109 + request.BucketName <- bucket 110 110 + request.Key <- cid.ToString() 111 111 + let! _ = client.GetObjectMetadataAsync(request) |> Async.AwaitTask 112 112 + return true 113 113 + with 114 114 + | :? AmazonS3Exception as ex when ex.StatusCode = System.Net.HttpStatusCode.NotFound -> return false 115 115 + | _ -> return false 116 116 + } 117 117 + 118 118 + member _.Delete(cid) = async { 119 119 + let request = DeleteObjectRequest() 120 120 + request.BucketName <- bucket 121 121 + request.Key <- cid.ToString() 122 122 + let! _ = client.DeleteObjectAsync(request) |> Async.AwaitTask 123 123 + () 124 124 + }

+50

PDSharp.Core/BlockStore.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System.Collections.Concurrent 4 4 + 5 5 + /// Block storage interface for CID → byte[] mappings 6 6 + module BlockStore = 7 7 + 8 8 + /// Interface for content-addressed block storage 9 9 + type IBlockStore = 10 10 + abstract member Get : Cid -> Async<byte[] option> 11 11 + abstract member Put : byte[] -> Async<Cid> 12 12 + abstract member Has : Cid -> Async<bool> 13 13 + abstract member GetAllCidsAndData : unit -> Async<(Cid * byte[]) list> 14 14 + 15 15 + /// In-memory implementation of IBlockStore for testing 16 16 + type MemoryBlockStore() = 17 17 + let store = ConcurrentDictionary<string, (Cid * byte[])>() 18 18 + 19 19 + let cidKey (cid : Cid) = 20 20 + System.Convert.ToBase64String(cid.Bytes) 21 21 + 22 22 + interface IBlockStore with 23 23 + member _.Get(cid : Cid) = async { 24 24 + let key = cidKey cid 25 25 + 26 26 + match store.TryGetValue(key) with 27 27 + | true, (_, data) -> return Some data 28 28 + | false, _ -> return None 29 29 + } 30 30 + 31 31 + member _.Put(data : byte[]) = async { 32 32 + let hash = Crypto.sha256 data 33 33 + let cid = Cid.FromHash hash 34 34 + let key = cidKey cid 35 35 + store.[key] <- (cid, data) 36 36 + return cid 37 37 + } 38 38 + 39 39 + member _.Has(cid : Cid) = async { 40 40 + let key = cidKey cid 41 41 + return store.ContainsKey(key) 42 42 + } 43 43 + 44 44 + member _.GetAllCidsAndData() = async { return store.Values |> Seq.toList } 45 45 + 46 46 + /// Get the number of blocks stored (for testing) 47 47 + member _.Count = store.Count 48 48 + 49 49 + /// Clear all blocks (for testing) 50 50 + member _.Clear() = store.Clear()

+85

PDSharp.Core/Car.fs

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

+111

PDSharp.Core/Cid.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Text 5 5 + 6 6 + /// Minimal Base32 (RFC 4648 Lowercase) 7 7 + module Base32Encoding = 8 8 + let private alphabet = "abcdefghijklmnopqrstuvwxyz234567" 9 9 + 10 10 + let ToString (data : byte[]) : string = 11 11 + if data.Length = 0 then 12 12 + "" 13 13 + else 14 14 + let mutable i = 0 15 15 + let mutable index = 0 16 16 + let mutable digit = 0 17 17 + let mutable currByte = 0 18 18 + let mutable nextByte = 0 19 19 + let sb = StringBuilder((data.Length + 7) * 8 / 5) 20 20 + 21 21 + while i < data.Length do 22 22 + currByte <- (int data.[i]) &&& 0xFF 23 23 + 24 24 + if index > 3 then 25 25 + if (i + 1) < data.Length then 26 26 + nextByte <- (int data.[i + 1]) &&& 0xFF 27 27 + else 28 28 + nextByte <- 0 29 29 + 30 30 + digit <- currByte &&& (0xFF >>> index) 31 31 + index <- (index + 5) % 8 32 32 + digit <- digit <<< index 33 33 + digit <- digit ||| (nextByte >>> (8 - index)) 34 34 + i <- i + 1 35 35 + else 36 36 + digit <- currByte >>> 8 - (index + 5) &&& 0x1F 37 37 + index <- (index + 5) % 8 38 38 + 39 39 + if index = 0 then 40 40 + i <- i + 1 41 41 + 42 42 + sb.Append(alphabet.[digit]) |> ignore 43 43 + 44 44 + sb.ToString() 45 45 + 46 46 + let FromString (s : string) : byte[] option = 47 47 + if String.IsNullOrEmpty s then 48 48 + Some [||] 49 49 + else 50 50 + try 51 51 + let bits = s.Length * 5 52 52 + let bytes = Array.zeroCreate<byte> (bits / 8) 53 53 + let mutable buffer = 0 54 54 + let mutable bitsInBuffer = 0 55 55 + let mutable byteIndex = 0 56 56 + 57 57 + for c in s do 58 58 + let idx = alphabet.IndexOf(Char.ToLowerInvariant c) 59 59 + 60 60 + if idx < 0 then 61 61 + failwith "Invalid base32 character" 62 62 + 63 63 + buffer <- buffer <<< 5 ||| idx 64 64 + bitsInBuffer <- bitsInBuffer + 5 65 65 + 66 66 + if bitsInBuffer >= 8 then 67 67 + bitsInBuffer <- bitsInBuffer - 8 68 68 + 69 69 + if byteIndex < bytes.Length then 70 70 + bytes.[byteIndex] <- byte ((buffer >>> bitsInBuffer) &&& 0xFF) 71 71 + byteIndex <- byteIndex + 1 72 72 + 73 73 + Some bytes 74 74 + with _ -> 75 75 + None 76 76 + 77 77 + /// Basic CID implementation for AT Protocol (CIDv1 + dag-cbor + sha2-256) 78 78 + /// 79 79 + /// Constants for ATProto defaults: 80 80 + /// - Version 1 (0x01) 81 81 + /// - Codec: dag-cbor (0x71) 82 82 + /// - Hash: sha2-256 (0x12) - Length 32 (0x20) 83 83 + [<Struct>] 84 84 + type Cid = 85 85 + val Bytes : byte[] 86 86 + new(bytes : byte[]) = { Bytes = bytes } 87 87 + 88 88 + static member FromHash(hash : byte[]) = 89 89 + if hash.Length <> 32 then 90 90 + failwith "Hash must be 32 bytes (sha2-256)" 91 91 + 92 92 + let cidBytes = Array.zeroCreate<byte> 36 93 93 + cidBytes.[0] <- 0x01uy 94 94 + cidBytes.[1] <- 0x71uy 95 95 + cidBytes.[2] <- 0x12uy 96 96 + cidBytes.[3] <- 0x20uy 97 97 + Array.Copy(hash, 0, cidBytes, 4, 32) 98 98 + Cid cidBytes 99 99 + 100 100 + static member TryParse(s : string) : Cid option = 101 101 + if String.IsNullOrWhiteSpace s then 102 102 + None 103 103 + elif s.StartsWith("b") then 104 104 + match Base32Encoding.FromString(s.Substring(1)) with 105 105 + | Some bytes when bytes.Length = 36 -> Some(Cid bytes) 106 106 + | _ -> None 107 107 + else 108 108 + None 109 109 + 110 110 + override this.ToString() = 111 111 + "b" + Base32Encoding.ToString(this.Bytes)

+25 -1

PDSharp.Core/Config.fs

··· 1 1 namespace PDSharp.Core 2 2 3 3 module Config = 4 4 - type AppConfig = { PublicUrl : string; DidHost : string } 4 4 + type AppConfig = { 5 5 + PublicUrl : string 6 6 + DidHost : string 7 7 + /// HS256 signing key for session tokens 8 8 + JwtSecret : string 9 9 + /// Connection string for SQLite 10 10 + SqliteConnectionString : string 11 11 + /// Disable SQLite WAL auto-checkpoint (for Litestream compatibility) 12 12 + DisableWalAutoCheckpoint : bool 13 13 + /// Blob storage configuration 14 14 + BlobStore : BlobStoreConfig 15 15 + } 16 16 + 17 17 + and BlobStoreConfig = 18 18 + | Disk of path : string 19 19 + | S3 of S3Config 20 20 + 21 21 + and S3Config = { 22 22 + Bucket : string 23 23 + Region : string 24 24 + AccessKey : string option 25 25 + SecretKey : string option 26 26 + ServiceUrl : string option 27 27 + ForcePathStyle : bool 28 28 + }

+108

PDSharp.Core/Crypto.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Text 5 5 + open Org.BouncyCastle.Crypto.Digests 6 6 + open Org.BouncyCastle.Crypto.Signers 7 7 + open Org.BouncyCastle.Crypto.Parameters 8 8 + open Org.BouncyCastle.Math 9 9 + open Org.BouncyCastle.Asn1.X9 10 10 + open Org.BouncyCastle.Crypto.Generators 11 11 + open Org.BouncyCastle.Security 12 12 + open Org.BouncyCastle.Asn1.Sec 13 13 + 14 14 + module Crypto = 15 15 + let sha256 (data : byte[]) : byte[] = 16 16 + let digest = Sha256Digest() 17 17 + digest.BlockUpdate(data, 0, data.Length) 18 18 + let size = digest.GetDigestSize() 19 19 + let result = Array.zeroCreate<byte> size 20 20 + digest.DoFinal(result, 0) |> ignore 21 21 + result 22 22 + 23 23 + let sha256Str (input : string) : byte[] = sha256 (Encoding.UTF8.GetBytes(input)) 24 24 + 25 25 + type Curve = 26 26 + | P256 27 27 + | K256 28 28 + 29 29 + let getCurveParams (curve : Curve) = 30 30 + match curve with 31 31 + | P256 -> ECNamedCurveTable.GetByName("secp256r1") 32 32 + | K256 -> ECNamedCurveTable.GetByName("secp256k1") 33 33 + 34 34 + let getDomainParams (curve : Curve) = 35 35 + let ecP = getCurveParams curve 36 36 + ECDomainParameters(ecP.Curve, ecP.G, ecP.N, ecP.H, ecP.GetSeed()) 37 37 + 38 38 + type EcKeyPair = { 39 39 + PrivateKey : ECPrivateKeyParameters option 40 40 + PublicKey : ECPublicKeyParameters 41 41 + Curve : Curve 42 42 + } 43 43 + 44 44 + let generateKey (curve : Curve) : EcKeyPair = 45 45 + let domainParams = getDomainParams curve 46 46 + let genParam = ECKeyGenerationParameters(domainParams, SecureRandom()) 47 47 + let generator = ECKeyPairGenerator() 48 48 + generator.Init(genParam) 49 49 + let pair = generator.GenerateKeyPair() 50 50 + 51 51 + { 52 52 + PrivateKey = Some(pair.Private :?> ECPrivateKeyParameters) 53 53 + PublicKey = (pair.Public :?> ECPublicKeyParameters) 54 54 + Curve = curve 55 55 + } 56 56 + 57 57 + let enforceLowS (s : BigInteger) (n : BigInteger) : BigInteger = 58 58 + let halfN = n.ShiftRight(1) 59 59 + if s.CompareTo(halfN) > 0 then n.Subtract(s) else s 60 60 + 61 61 + let sign (key : EcKeyPair) (digest : byte[]) : byte[] = 62 62 + match key.PrivateKey with 63 63 + | None -> failwith "Private key required for signing" 64 64 + | Some privParams -> 65 65 + let signer = ECDsaSigner() 66 66 + signer.Init(true, privParams) 67 67 + let inputs = digest 68 68 + let signature = signer.GenerateSignature(inputs) 69 69 + let r = signature.[0] 70 70 + let s = signature.[1] 71 71 + 72 72 + let n = privParams.Parameters.N 73 73 + let canonicalS = enforceLowS s n 74 74 + 75 75 + let to32Bytes (bi : BigInteger) = 76 76 + let bytes = bi.ToByteArrayUnsigned() 77 77 + 78 78 + if bytes.Length > 32 then 79 79 + failwith "Signature component too large" 80 80 + 81 81 + let padded = Array.zeroCreate<byte> 32 82 82 + Array.Copy(bytes, 0, padded, 32 - bytes.Length, bytes.Length) 83 83 + padded 84 84 + 85 85 + let rBytes = to32Bytes r 86 86 + let sBytes = to32Bytes canonicalS 87 87 + Array.append rBytes sBytes 88 88 + 89 89 + let verify (key : EcKeyPair) (digest : byte[]) (signature : byte[]) : bool = 90 90 + if signature.Length <> 64 then 91 91 + false 92 92 + else 93 93 + let rBytes = Array.sub signature 0 32 94 94 + let sBytes = Array.sub signature 32 32 95 95 + 96 96 + let r = BigInteger(1, rBytes) 97 97 + let s = BigInteger(1, sBytes) 98 98 + 99 99 + let domainParams = key.PublicKey.Parameters 100 100 + let n = domainParams.N 101 101 + let halfN = n.ShiftRight(1) 102 102 + 103 103 + if s.CompareTo(halfN) > 0 then 104 104 + false 105 105 + else 106 106 + let signer = ECDsaSigner() 107 107 + signer.Init(false, key.PublicKey) 108 108 + signer.VerifySignature(digest, r, s)

+83

PDSharp.Core/DagCbor.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Collections.Generic 5 5 + open System.Formats.Cbor 6 6 + open System.IO 7 7 + open System.Text 8 8 + 9 9 + module DagCbor = 10 10 + type SortKey = { Length : int; Bytes : byte[] } 11 11 + 12 12 + let private getSortKey (key : string) = 13 13 + let bytes = Encoding.UTF8.GetBytes(key) 14 14 + { Length = bytes.Length; Bytes = bytes } 15 15 + 16 16 + let private compareKeys (a : string) (b : string) = 17 17 + let ka = getSortKey a 18 18 + let kb = getSortKey b 19 19 + 20 20 + if ka.Length <> kb.Length then 21 21 + ka.Length.CompareTo kb.Length 22 22 + else 23 23 + let mutable res = 0 24 24 + let mutable i = 0 25 25 + 26 26 + while res = 0 && i < ka.Bytes.Length do 27 27 + res <- ka.Bytes.[i].CompareTo(kb.Bytes.[i]) 28 28 + i <- i + 1 29 29 + 30 30 + res 31 31 + 32 32 + let rec private writeItem (writer : CborWriter) (item : obj) = 33 33 + match item with 34 34 + | null -> writer.WriteNull() 35 35 + | :? bool as b -> writer.WriteBoolean(b) 36 36 + | :? int as i -> writer.WriteInt32(i) 37 37 + | :? int64 as l -> writer.WriteInt64(l) 38 38 + | :? string as s -> writer.WriteTextString(s) 39 39 + | :? (byte[]) as b -> writer.WriteByteString(b) 40 40 + | :? Cid as c -> 41 41 + let tag = LanguagePrimitives.EnumOfValue<uint64, CborTag>(42UL) 42 42 + writer.WriteTag(tag) 43 43 + let rawCid = c.Bytes 44 44 + let linkBytes = Array.zeroCreate<byte> (rawCid.Length + 1) 45 45 + linkBytes.[0] <- 0x00uy 46 46 + Array.Copy(rawCid, 0, linkBytes, 1, rawCid.Length) 47 47 + writer.WriteByteString(linkBytes) 48 48 + 49 49 + | :? Map<string, obj> as m -> 50 50 + let keys = m |> Map.toList |> List.map fst |> List.sortWith compareKeys 51 51 + writer.WriteStartMap(keys.Length) 52 52 + 53 53 + for k in keys do 54 54 + writer.WriteTextString(k) 55 55 + writeItem writer (m.[k]) 56 56 + 57 57 + writer.WriteEndMap() 58 58 + 59 59 + | :? IDictionary<string, obj> as d -> 60 60 + let keys = d.Keys |> Seq.toList |> List.sortWith compareKeys 61 61 + writer.WriteStartMap(d.Count) 62 62 + 63 63 + for k in keys do 64 64 + writer.WriteTextString(k) 65 65 + writeItem writer (d.[k]) 66 66 + 67 67 + writer.WriteEndMap() 68 68 + 69 69 + | :? seq<obj> as l -> 70 70 + let arr = l |> Seq.toArray 71 71 + writer.WriteStartArray(arr.Length) 72 72 + 73 73 + for x in arr do 74 74 + writeItem writer x 75 75 + 76 76 + writer.WriteEndArray() 77 77 + 78 78 + | _ -> failwith $"Unsupported type for DAG-CBOR: {item.GetType().Name}" 79 79 + 80 80 + let encode (data : obj) : byte[] = 81 81 + let writer = new CborWriter(CborConformanceMode.Strict, false, false) 82 82 + writeItem writer data 83 83 + writer.Encode()

+73

PDSharp.Core/DidResolver.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Net.Http 5 5 + open System.Text.Json 6 6 + open System.Text.Json.Serialization 7 7 + 8 8 + module DidResolver = 9 9 + type VerificationMethod = { 10 10 + [<JsonPropertyName("id")>] 11 11 + Id : string 12 12 + [<JsonPropertyName("type")>] 13 13 + Type : string 14 14 + [<JsonPropertyName("controller")>] 15 15 + Controller : string 16 16 + [<JsonPropertyName("publicKeyMultibase")>] 17 17 + PublicKeyMultibase : string option 18 18 + } 19 19 + 20 20 + type DidDocument = { 21 21 + [<JsonPropertyName("id")>] 22 22 + Id : string 23 23 + [<JsonPropertyName("verificationMethod")>] 24 24 + VerificationMethod : VerificationMethod list 25 25 + } 26 26 + 27 27 + let private httpClient = new HttpClient() 28 28 + 29 29 + let private fetchJson<'T> (url : string) : Async<'T option> = async { 30 30 + try 31 31 + let! response = httpClient.GetAsync url |> Async.AwaitTask 32 32 + 33 33 + if response.IsSuccessStatusCode then 34 34 + let! stream = response.Content.ReadAsStreamAsync() |> Async.AwaitTask 35 35 + let options = JsonSerializerOptions(PropertyNameCaseInsensitive = true) 36 36 + let! doc = JsonSerializer.DeserializeAsync<'T>(stream, options).AsTask() |> Async.AwaitTask 37 37 + return Some doc 38 38 + else 39 39 + return None 40 40 + with _ -> 41 41 + return None 42 42 + } 43 43 + 44 44 + let resolveDidWeb (did : string) : Async<DidDocument option> = async { 45 45 + let parts = did.Split(':') 46 46 + 47 47 + if parts.Length < 3 then 48 48 + return None 49 49 + else 50 50 + let domain = parts.[2] 51 51 + 52 52 + let url = 53 53 + if domain = "localhost" then 54 54 + "http://localhost:5000/.well-known/did.json" 55 55 + else 56 56 + $"https://{domain}/.well-known/did.json" 57 57 + 58 58 + return! fetchJson<DidDocument> url 59 59 + } 60 60 + 61 61 + let resolveDidPlc (did : string) : Async<DidDocument option> = async { 62 62 + let url = $"https://plc.directory/{did}" 63 63 + return! fetchJson<DidDocument> url 64 64 + } 65 65 + 66 66 + let resolve (did : string) : Async<DidDocument option> = async { 67 67 + if did.StartsWith("did:web:") then 68 68 + return! resolveDidWeb did 69 69 + elif did.StartsWith("did:plc:") then 70 70 + return! resolveDidPlc did 71 71 + else 72 72 + return None 73 73 + }

+56

PDSharp.Core/Firehose.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Threading 5 5 + 6 6 + /// Event stream (firehose) for com.atproto.sync.subscribeRepos 7 7 + module Firehose = 8 8 + 9 9 + /// Commit event sent to subscribers 10 10 + type CommitEvent = { 11 11 + Seq : int64 12 12 + Did : string 13 13 + Rev : string 14 14 + Commit : Cid 15 15 + Blocks : byte[] 16 16 + Time : DateTimeOffset 17 17 + } 18 18 + 19 19 + /// Mutable sequence counter for firehose events 20 20 + let private seqCounter = ref 0L 21 21 + 22 22 + /// Get the next sequence number (thread-safe, monotonic) 23 23 + let nextSeq () : int64 = Interlocked.Increment(seqCounter) 24 24 + 25 25 + /// Get current sequence without incrementing (for cursor resume) 26 26 + let currentSeq () : int64 = seqCounter.Value 27 27 + 28 28 + /// Create a commit event for a repository write 29 29 + let createCommitEvent (did : string) (rev : string) (commitCid : Cid) (carBytes : byte[]) : CommitEvent = { 30 30 + Seq = nextSeq () 31 31 + Did = did 32 32 + Rev = rev 33 33 + Commit = commitCid 34 34 + Blocks = carBytes 35 35 + Time = DateTimeOffset.UtcNow 36 36 + } 37 37 + 38 38 + /// Encode a commit event to DAG-CBOR bytes for WebSocket transmission 39 39 + /// Format follows AT Protocol #commit message structure 40 40 + let encodeEvent (event : CommitEvent) : byte[] = 41 41 + let eventMap : Map<string, obj> = 42 42 + Map.ofList [ 43 43 + "$type", box "com.atproto.sync.subscribeRepos#commit" 44 44 + "seq", box event.Seq 45 45 + "did", box event.Did 46 46 + "rev", box event.Rev 47 47 + "commit", box event.Commit 48 48 + "blocks", box event.Blocks 49 49 + "time", box (event.Time.ToString("o")) 50 50 + ] 51 51 + 52 52 + DagCbor.encode eventMap 53 53 + 54 54 + /// Reset sequence counter (for testing) 55 55 + let resetSeq () = 56 56 + Interlocked.Exchange(seqCounter, 0L) |> ignore

+157

PDSharp.Core/Health.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.IO 5 5 + open System.Runtime.InteropServices 6 6 + 7 7 + /// Health monitoring module for guardrails and uptime checks 8 8 + module Health = 9 9 + 10 10 + /// Health status response 11 11 + type HealthStatus = { 12 12 + /// Version of the PDS 13 13 + Version : string 14 14 + /// Uptime in seconds 15 15 + UptimeSeconds : int64 16 16 + /// Server start time in ISO8601 17 17 + StartTime : string 18 18 + /// Database status 19 19 + DatabaseStatus : DatabaseStatus 20 20 + /// Disk usage information 21 21 + DiskUsage : DiskUsage option 22 22 + /// Backup status 23 23 + BackupStatus : BackupStatus option 24 24 + } 25 25 + 26 26 + /// Database connectivity status 27 27 + and DatabaseStatus = { 28 28 + /// Whether the database is reachable 29 29 + IsHealthy : bool 30 30 + /// Optional error message 31 31 + Message : string option 32 32 + } 33 33 + 34 34 + /// Disk usage metrics 35 35 + and DiskUsage = { 36 36 + /// Total disk space in bytes 37 37 + TotalBytes : int64 38 38 + /// Free disk space in bytes 39 39 + FreeBytes : int64 40 40 + /// Used disk space in bytes 41 41 + UsedBytes : int64 42 42 + /// Percentage of disk used 43 43 + UsedPercent : float 44 44 + /// Whether disk pressure is critical (>90%) 45 45 + IsCritical : bool 46 46 + } 47 47 + 48 48 + /// Backup status tracking 49 49 + and BackupStatus = { 50 50 + /// Timestamp of last successful backup 51 51 + LastBackupTime : DateTimeOffset option 52 52 + /// Age of last backup in hours 53 53 + BackupAgeHours : float option 54 54 + /// Whether backup is too old (>24 hours) 55 55 + IsStale : bool 56 56 + } 57 57 + 58 58 + /// Get disk usage for a given path 59 59 + let getDiskUsage (path : string) : DiskUsage option = 60 60 + try 61 61 + let driveInfo = 62 62 + if RuntimeInformation.IsOSPlatform OSPlatform.Windows then 63 63 + let driveLetter = Path.GetPathRoot path 64 64 + DriveInfo driveLetter 65 65 + else 66 66 + DriveInfo(if Directory.Exists path then path else "/") 67 67 + 68 68 + if driveInfo.IsReady then 69 69 + let total = driveInfo.TotalSize 70 70 + let free = driveInfo.TotalFreeSpace 71 71 + let used = total - free 72 72 + let usedPercent = float used / float total * 100.0 73 73 + 74 74 + Some { 75 75 + TotalBytes = total 76 76 + FreeBytes = free 77 77 + UsedBytes = used 78 78 + UsedPercent = Math.Round(usedPercent, 2) 79 79 + IsCritical = usedPercent >= 90.0 80 80 + } 81 81 + else 82 82 + None 83 83 + with _ -> 84 84 + None 85 85 + 86 86 + 87 87 + 88 88 + /// Check if a SQLite database file is accessible 89 89 + let checkDatabaseHealth (connectionString : string) : DatabaseStatus = 90 90 + try 91 91 + let dbPath = 92 92 + connectionString.Split ';' 93 93 + |> Array.tryFind (fun s -> s.Trim().StartsWith("Data Source=", StringComparison.OrdinalIgnoreCase)) 94 94 + |> Option.map (fun s -> s.Split('=').[1].Trim()) 95 95 + 96 96 + match dbPath with 97 97 + | Some path when File.Exists path -> { IsHealthy = true; Message = None } 98 98 + | Some path -> { 99 99 + IsHealthy = false 100 100 + Message = Some $"Database file not found: {path}" 101 101 + } 102 102 + | None -> { 103 103 + IsHealthy = false 104 104 + Message = Some "Could not parse connection string" 105 105 + } 106 106 + with ex -> { IsHealthy = false; Message = Some ex.Message } 107 107 + 108 108 + /// Calculate backup status from last backup time 109 109 + let getBackupStatus (lastBackupTime : DateTimeOffset option) : BackupStatus = 110 110 + match lastBackupTime with 111 111 + | Some time -> 112 112 + let age = DateTimeOffset.UtcNow - time 113 113 + let ageHours = age.TotalHours 114 114 + 115 115 + { 116 116 + LastBackupTime = Some time 117 117 + BackupAgeHours = Some(Math.Round(ageHours, 2)) 118 118 + IsStale = ageHours > 24.0 119 119 + } 120 120 + | None -> { 121 121 + LastBackupTime = None 122 122 + BackupAgeHours = None 123 123 + IsStale = true 124 124 + } 125 125 + 126 126 + /// Mutable state for tracking server state 127 127 + type HealthState() = 128 128 + let mutable startTime = DateTimeOffset.UtcNow 129 129 + let mutable lastBackupTime : DateTimeOffset option = None 130 130 + 131 131 + member _.StartTime = startTime 132 132 + member _.SetStartTime(time : DateTimeOffset) = startTime <- time 133 133 + member _.LastBackupTime = lastBackupTime 134 134 + 135 135 + member _.RecordBackup() = 136 136 + lastBackupTime <- Some DateTimeOffset.UtcNow 137 137 + 138 138 + member _.RecordBackup(time : DateTimeOffset) = lastBackupTime <- Some time 139 139 + 140 140 + member _.GetUptime() : int64 = 141 141 + int64 (DateTimeOffset.UtcNow - startTime).TotalSeconds 142 142 + 143 143 + /// Build a complete health status 144 144 + let buildHealthStatus 145 145 + (version : string) 146 146 + (healthState : HealthState) 147 147 + (connectionString : string) 148 148 + (dataPath : string) 149 149 + : HealthStatus = 150 150 + { 151 151 + Version = version 152 152 + UptimeSeconds = healthState.GetUptime() 153 153 + StartTime = healthState.StartTime.ToString("o") 154 154 + DatabaseStatus = checkDatabaseHealth connectionString 155 155 + DiskUsage = getDiskUsage dataPath 156 156 + BackupStatus = Some(getBackupStatus healthState.LastBackupTime) 157 157 + }

+131

PDSharp.Core/Lexicon.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Text.Json 5 5 + 6 6 + module Lexicon = 7 7 + type LexiconResult = 8 8 + | Ok 9 9 + | Error of string 10 10 + 11 11 + module Validation = 12 12 + let private getProperty (p : string) (element : JsonElement) = 13 13 + match element.TryGetProperty(p) with 14 14 + | true, prop -> Some prop 15 15 + | _ -> None 16 16 + 17 17 + let private getString (p : string) (element : JsonElement) = 18 18 + match getProperty p element with 19 19 + | Some prop when prop.ValueKind = JsonValueKind.String -> Some(prop.GetString()) 20 20 + | _ -> None 21 21 + 22 22 + let private validateStringField 23 23 + (element : JsonElement) 24 24 + (fieldName : string) 25 25 + (maxLength : int option) 26 26 + (required : bool) 27 27 + : LexiconResult = 28 28 + match getProperty fieldName element with 29 29 + | Some prop -> 30 30 + if prop.ValueKind <> JsonValueKind.String then 31 31 + Error $"Field '{fieldName}' must be a string" 32 32 + else 33 33 + match maxLength with 34 34 + | Some maxLen when prop.GetString().Length > maxLen -> 35 35 + Error $"Field '{fieldName}' exceeds maximum length of {maxLen}" 36 36 + | _ -> Ok 37 37 + | None -> 38 38 + if required then 39 39 + Error $"Missing required field '{fieldName}'" 40 40 + else 41 41 + Ok 42 42 + 43 43 + let private validateIsoDate (element : JsonElement) (fieldName : string) (required : bool) : LexiconResult = 44 44 + match getProperty fieldName element with 45 45 + | Some prop -> 46 46 + if prop.ValueKind <> JsonValueKind.String then 47 47 + Error $"Field '{fieldName}' must be a string" 48 48 + else 49 49 + let s = prop.GetString() 50 50 + let mutable dt = DateTimeOffset.MinValue 51 51 + 52 52 + if DateTimeOffset.TryParse(s, &dt) then 53 53 + Ok 54 54 + else 55 55 + Error $"Field '{fieldName}' must be a valid ISO 8601 date string" 56 56 + | None -> 57 57 + if required then 58 58 + Error $"Missing required field '{fieldName}'" 59 59 + else 60 60 + Ok 61 61 + 62 62 + let private validateRef (element : JsonElement) (fieldName : string) (required : bool) : LexiconResult = 63 63 + match getProperty fieldName element with 64 64 + | Some prop -> 65 65 + if prop.ValueKind <> JsonValueKind.Object then 66 66 + Error $"Field '{fieldName}' must be an object" 67 67 + else 68 68 + match validateStringField prop "uri" None true, validateStringField prop "cid" None true with 69 69 + | Ok, Ok -> Ok 70 70 + | Error e, _ -> Error $"Field '{fieldName}': {e}" 71 71 + | _, Error e -> Error $"Field '{fieldName}': {e}" 72 72 + | None -> 73 73 + if required then 74 74 + Error $"Missing required field '{fieldName}'" 75 75 + else 76 76 + Ok 77 77 + 78 78 + let validatePost (record : JsonElement) : LexiconResult = 79 79 + let textCheck = validateStringField record "text" (Some 3000) true 80 80 + let dateCheck = validateIsoDate record "createdAt" true 81 81 + 82 82 + match textCheck, dateCheck with 83 83 + | Ok, Ok -> Ok 84 84 + | Error e, _ -> Error e 85 85 + | _, Error e -> Error e 86 86 + 87 87 + let validateLike (record : JsonElement) : LexiconResult = 88 88 + let subjectCheck = validateRef record "subject" true 89 89 + let dateCheck = validateIsoDate record "createdAt" true 90 90 + 91 91 + match subjectCheck, dateCheck with 92 92 + | Ok, Ok -> Ok 93 93 + | Error e, _ -> Error e 94 94 + | _, Error e -> Error e 95 95 + 96 96 + let validateRepost (record : JsonElement) : LexiconResult = 97 97 + let subjectCheck = validateRef record "subject" true 98 98 + let dateCheck = validateIsoDate record "createdAt" true 99 99 + 100 100 + match subjectCheck, dateCheck with 101 101 + | Ok, Ok -> Ok 102 102 + | Error e, _ -> Error e 103 103 + | _, Error e -> Error e 104 104 + 105 105 + let validateFollow (record : JsonElement) : LexiconResult = 106 106 + let subjectCheck = validateStringField record "subject" None true 107 107 + let dateCheck = validateIsoDate record "createdAt" true 108 108 + 109 109 + match subjectCheck, dateCheck with 110 110 + | Ok, Ok -> Ok 111 111 + | Error e, _ -> Error e 112 112 + | _, Error e -> Error e 113 113 + 114 114 + let validateProfile (record : JsonElement) : LexiconResult = 115 115 + let nameCheck = validateStringField record "displayName" (Some 640) false 116 116 + let descCheck = validateStringField record "description" (Some 2560) false 117 117 + 118 118 + match nameCheck, descCheck with 119 119 + | Ok, Ok -> Ok 120 120 + | Error e, _ -> Error e 121 121 + | _, Error e -> Error e 122 122 + 123 123 + /// Unknown records are valid but unvalidated. 124 124 + let validate (collection : string) (record : JsonElement) : LexiconResult = 125 125 + match collection with 126 126 + | "app.bsky.feed.post" -> Validation.validatePost record 127 127 + | "app.bsky.feed.like" -> Validation.validateLike record 128 128 + | "app.bsky.feed.repost" -> Validation.validateRepost record 129 129 + | "app.bsky.graph.follow" -> Validation.validateFollow record 130 130 + | "app.bsky.actor.profile" -> Validation.validateProfile record 131 131 + | _ -> Ok

+812

PDSharp.Core/Mst.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.Collections.Generic 5 5 + open System.Formats.Cbor 6 6 + 7 7 + module Mst = 8 8 + type MstEntry = { 9 9 + PrefixLen : int 10 10 + KeySuffix : string 11 11 + Value : Cid 12 12 + Tree : Cid option 13 13 + } 14 14 + 15 15 + type MstNode = { Left : Cid option; Entries : MstEntry list } 16 16 + 17 17 + /// Layer Calculation 18 18 + let layer (key : string) : int = 19 19 + let hash = Crypto.sha256Str key 20 20 + let mutable zeros = 0 21 21 + let mutable i = 0 22 22 + let mutable found = false 23 23 + 24 24 + while i < hash.Length && not found do 25 25 + let b = hash.[i] 26 26 + 27 27 + if b = 0uy then 28 28 + zeros <- zeros + 8 29 29 + i <- i + 1 30 30 + else 31 31 + let mutable mask = 0x80uy 32 32 + 33 33 + while b &&& mask = 0uy do 34 34 + zeros <- zeros + 1 35 35 + mask <- mask >>> 1 36 36 + 37 37 + found <- true 38 38 + 39 39 + zeros / 2 40 40 + 41 41 + let entryToCborObj (e : MstEntry) : obj = 42 42 + let arr = Array.zeroCreate<obj> 4 43 43 + arr.[0] <- e.PrefixLen :> obj 44 44 + arr.[1] <- e.KeySuffix :> obj 45 45 + arr.[2] <- e.Value :> obj 46 46 + 47 47 + arr.[3] <- 48 48 + match e.Tree with 49 49 + | Some c -> c :> obj 50 50 + | None -> null 51 51 + 52 52 + arr :> obj 53 53 + 54 54 + let nodeToCborObj (node : MstNode) : obj = 55 55 + let arr = Array.zeroCreate<obj> 2 56 56 + 57 57 + arr.[0] <- 58 58 + match node.Left with 59 59 + | Some c -> c :> obj 60 60 + | None -> null 61 61 + 62 62 + let entriesArr = node.Entries |> List.map entryToCborObj |> Seq.toArray 63 63 + arr.[1] <- entriesArr :> obj 64 64 + arr :> obj 65 65 + 66 66 + let serialize (node : MstNode) : byte[] = nodeToCborObj node |> DagCbor.encode 67 67 + 68 68 + let readCid (reader : CborReader) = 69 69 + let tag = reader.ReadTag() 70 70 + let tag42 = LanguagePrimitives.EnumOfValue<uint64, CborTag>(42UL) 71 71 + 72 72 + if tag <> tag42 then 73 73 + failwith "Expected CID tag 42" 74 74 + 75 75 + let bytes = reader.ReadByteString() 76 76 + 77 77 + if bytes.Length > 0 && bytes.[0] = 0x00uy then 78 78 + let raw = Array.zeroCreate<byte> (bytes.Length - 1) 79 79 + Array.Copy(bytes, 1, raw, 0, raw.Length) 80 80 + Cid raw 81 81 + else 82 82 + Cid bytes 83 83 + 84 84 + let deserialize (data : byte[]) : MstNode = 85 85 + let reader = new CborReader(data.AsMemory(), CborConformanceMode.Strict) 86 86 + let len = reader.ReadStartArray() 87 87 + 88 88 + if len.HasValue && len.Value <> 2 then 89 89 + failwith "MST node must be array of length 2" 90 90 + 91 91 + let left = 92 92 + match reader.PeekState() with 93 93 + | CborReaderState.Null -> 94 94 + reader.ReadNull() 95 95 + None 96 96 + | _ -> Some(readCid reader) 97 97 + 98 98 + let entriesLen = reader.ReadStartArray() 99 99 + let mutable entries = [] 100 100 + 101 101 + let count = 102 102 + if entriesLen.HasValue then 103 103 + entriesLen.Value 104 104 + else 105 105 + Int32.MaxValue 106 106 + 107 107 + let mutable i = 0 108 108 + 109 109 + while i < count && reader.PeekState() <> CborReaderState.EndArray do 110 110 + let entryLen = reader.ReadStartArray() 111 111 + 112 112 + if entryLen.HasValue && entryLen.Value <> 4 then 113 113 + failwith "MST entry must be array of length 4" 114 114 + 115 115 + let p = reader.ReadInt32() 116 116 + let k = reader.ReadTextString() 117 117 + let v = readCid reader 118 118 + 119 119 + let t = 120 120 + match reader.PeekState() with 121 121 + | CborReaderState.Null -> 122 122 + reader.ReadNull() 123 123 + None 124 124 + | _ -> Some(readCid reader) 125 125 + 126 126 + reader.ReadEndArray() 127 127 + 128 128 + entries <- entries @ [ { PrefixLen = p; KeySuffix = k; Value = v; Tree = t } ] 129 129 + i <- i + 1 130 130 + 131 131 + reader.ReadEndArray() 132 132 + reader.ReadEndArray() 133 133 + { Left = left; Entries = entries } 134 134 + 135 135 + let compareKeys (a : string) (b : string) : int = 136 136 + let bytesA = System.Text.Encoding.UTF8.GetBytes(a) 137 137 + let bytesB = System.Text.Encoding.UTF8.GetBytes(b) 138 138 + let len = min bytesA.Length bytesB.Length 139 139 + let mutable res = 0 140 140 + let mutable i = 0 141 141 + 142 142 + while res = 0 && i < len do 143 143 + res <- bytesA.[i].CompareTo(bytesB.[i]) 144 144 + i <- i + 1 145 145 + 146 146 + if res <> 0 then 147 147 + res 148 148 + else 149 149 + bytesA.Length.CompareTo bytesB.Length 150 150 + 151 151 + type NodeLoader = Cid -> Async<MstNode option> 152 152 + type NodePersister = MstNode -> Async<Cid> 153 153 + 154 154 + let storeNode (persister : NodePersister) (node : MstNode) : Async<Cid> = persister node 155 155 + 156 156 + let rec get (loader : NodeLoader) (node : MstNode) (key : string) (prevKey : string) : Async<Cid option> = async { 157 157 + let mutable currentKey = prevKey 158 158 + let mutable foundEntry : MstEntry option = None 159 159 + let mutable nextTree : Cid option = node.Left 160 160 + let mutable stop = false 161 161 + let mutable i = 0 162 162 + 163 163 + while not stop && i < node.Entries.Length do 164 164 + let e = node.Entries.[i] 165 165 + 166 166 + let prefix = 167 167 + if e.PrefixLen > currentKey.Length then 168 168 + currentKey 169 169 + else 170 170 + currentKey.Substring(0, e.PrefixLen) 171 171 + 172 172 + let fullKey = prefix + e.KeySuffix 173 173 + let cmp = compareKeys key fullKey 174 174 + 175 175 + if cmp = 0 then 176 176 + foundEntry <- Some e 177 177 + stop <- true 178 178 + elif cmp < 0 then 179 179 + stop <- true 180 180 + else 181 181 + nextTree <- e.Tree 182 182 + currentKey <- fullKey 183 183 + i <- i + 1 184 184 + 185 185 + match foundEntry with 186 186 + | Some e -> return Some e.Value 187 187 + | None -> 188 188 + match nextTree with 189 189 + | None -> return None 190 190 + | Some cid -> 191 191 + let! child = loader cid 192 192 + 193 193 + match child with 194 194 + | Some cNode -> return! get loader cNode key currentKey 195 195 + | None -> return None 196 196 + } 197 197 + 198 198 + let sharedPrefixLen (a : string) (b : string) = 199 199 + let len = min a.Length b.Length 200 200 + let mutable i = 0 201 201 + 202 202 + while i < len && a.[i] = b.[i] do 203 203 + i <- i + 1 204 204 + 205 205 + i 206 206 + 207 207 + let nodeLayer (node : MstNode) (prevKey : string) = 208 208 + match node.Entries with 209 209 + | [] -> -1 210 210 + | first :: _ -> 211 211 + let prefix = 212 212 + if first.PrefixLen > prevKey.Length then 213 213 + prevKey 214 214 + else 215 215 + prevKey.Substring(0, first.PrefixLen) 216 216 + 217 217 + let fullKey = prefix + first.KeySuffix 218 218 + layer fullKey 219 219 + 220 220 + /// Splits a node around a key (which is assumed to be higher layer than any in the node). 221 221 + /// 222 222 + /// Returns (LeftNode, RightNode). 223 223 + let rec split 224 224 + (loader : NodeLoader) 225 225 + (persister : NodePersister) 226 226 + (node : MstNode) 227 227 + (key : string) 228 228 + (prevKey : string) 229 229 + : Async<MstNode * MstNode> = 230 230 + async { 231 231 + let mutable splitIdx = -1 232 232 + let mutable found = false 233 233 + let mutable currentKey = prevKey 234 234 + let mutable i = 0 235 235 + let entries = node.Entries 236 236 + let mutable splitPrevKey = prevKey 237 237 + 238 238 + while i < entries.Length && not found do 239 239 + let e = entries.[i] 240 240 + 241 241 + let prefix = 242 242 + if e.PrefixLen > currentKey.Length then 243 243 + currentKey 244 244 + else 245 245 + currentKey.Substring(0, e.PrefixLen) 246 246 + 247 247 + let fullKey = prefix + e.KeySuffix 248 248 + 249 249 + if compareKeys key fullKey < 0 then 250 250 + splitIdx <- i 251 251 + found <- true 252 252 + else 253 253 + currentKey <- fullKey 254 254 + splitPrevKey <- currentKey 255 255 + i <- i + 1 256 256 + 257 257 + let childCidToSplit = 258 258 + if found then 259 259 + if splitIdx = 0 then 260 260 + node.Left 261 261 + else 262 262 + entries.[splitIdx - 1].Tree 263 263 + else if entries.Length = 0 then 264 264 + node.Left 265 265 + else 266 266 + entries.[entries.Length - 1].Tree 267 267 + 268 268 + let! (lChild, rChild) = async { 269 269 + match childCidToSplit with 270 270 + | None -> return ({ Left = None; Entries = [] }, { Left = None; Entries = [] }) 271 271 + | Some cid -> 272 272 + let! childNodeOpt = loader cid 273 273 + 274 274 + match childNodeOpt with 275 275 + | None -> return ({ Left = None; Entries = [] }, { Left = None; Entries = [] }) 276 276 + | Some childNode -> return! split loader persister childNode key currentKey 277 277 + } 278 278 + 279 279 + let persistOrNone (n : MstNode) = async { 280 280 + if n.Entries.IsEmpty && n.Left.IsNone then 281 281 + return None 282 282 + else 283 283 + let! c = persister n 284 284 + return Some c 285 285 + } 286 286 + 287 287 + let! lCid = persistOrNone lChild 288 288 + let! rCid = persistOrNone rChild 289 289 + let leftEntries = if found then entries |> List.take splitIdx else entries 290 290 + 291 291 + let newLeftEntries = 292 292 + if leftEntries.IsEmpty then 293 293 + [] 294 294 + else 295 295 + let last = leftEntries.[leftEntries.Length - 1] 296 296 + let newLast = { last with Tree = lCid } 297 297 + (leftEntries |> List.take (leftEntries.Length - 1)) @ [ newLast ] 298 298 + 299 299 + let leftNode = 300 300 + if leftEntries.IsEmpty then 301 301 + { Left = lCid; Entries = [] } 302 302 + else 303 303 + { Left = node.Left; Entries = newLeftEntries } 304 304 + 305 305 + let rightEntries = if found then entries |> List.skip splitIdx else [] 306 306 + 307 307 + let newRightEntries = 308 308 + match rightEntries with 309 309 + | [] -> [] 310 310 + | first :: rest -> 311 311 + let firstFullKey = 312 312 + let prefix = 313 313 + if first.PrefixLen > currentKey.Length then 314 314 + currentKey 315 315 + else 316 316 + currentKey.Substring(0, first.PrefixLen) 317 317 + 318 318 + prefix + first.KeySuffix 319 319 + 320 320 + let newP = sharedPrefixLen key firstFullKey 321 321 + let newSuffix = firstFullKey.Substring(newP) 322 322 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 323 323 + newFirst :: rest 324 324 + 325 325 + let rightNode = { Left = rCid; Entries = newRightEntries } 326 326 + return (leftNode, rightNode) 327 327 + } 328 328 + 329 329 + let rec put 330 330 + (loader : NodeLoader) 331 331 + (persister : NodePersister) 332 332 + (node : MstNode) 333 333 + (key : string) 334 334 + (value : Cid) 335 335 + (prevKey : string) 336 336 + : Async<MstNode> = 337 337 + async { 338 338 + let kLayer = layer key 339 339 + 340 340 + let nLayer = 341 341 + match node.Entries with 342 342 + | [] -> -1 343 343 + | first :: _ -> 344 344 + let prefix = 345 345 + if first.PrefixLen > prevKey.Length then 346 346 + prevKey 347 347 + else 348 348 + prevKey.Substring(0, first.PrefixLen) 349 349 + 350 350 + let fullKey = prefix + first.KeySuffix 351 351 + layer fullKey 352 352 + 353 353 + if kLayer > nLayer then 354 354 + let! (lNode, rNode) = split loader persister node key prevKey 355 355 + 356 356 + let persistOrNone (n : MstNode) = async { 357 357 + if n.Entries.IsEmpty && n.Left.IsNone then 358 358 + return None 359 359 + else 360 360 + let! c = persister n 361 361 + return Some c 362 362 + } 363 363 + 364 364 + let! lCid = persistOrNone lNode 365 365 + let! rCid = persistOrNone rNode 366 366 + 367 367 + let p = sharedPrefixLen prevKey key 368 368 + let suffix = key.Substring(p) 369 369 + 370 370 + return { 371 371 + Left = lCid 372 372 + Entries = [ 373 373 + { 374 374 + PrefixLen = p 375 375 + KeySuffix = suffix 376 376 + Value = value 377 377 + Tree = rCid 378 378 + } 379 379 + ] 380 380 + } 381 381 + 382 382 + elif kLayer < nLayer then 383 383 + let mutable nextCid = node.Left 384 384 + let mutable currentKey = prevKey 385 385 + let mutable found = false 386 386 + let mutable i = 0 387 387 + 388 388 + let entries = node.Entries 389 389 + let mutable childIdx = -1 390 390 + 391 391 + while i < entries.Length && not found do 392 392 + let e = entries.[i] 393 393 + 394 394 + let prefix = 395 395 + if e.PrefixLen > currentKey.Length then 396 396 + currentKey 397 397 + else 398 398 + currentKey.Substring(0, e.PrefixLen) 399 399 + 400 400 + let fullKey = prefix + e.KeySuffix 401 401 + 402 402 + if compareKeys key fullKey < 0 then 403 403 + found <- true 404 404 + else 405 405 + childIdx <- i 406 406 + nextCid <- e.Tree 407 407 + currentKey <- fullKey 408 408 + i <- i + 1 409 409 + 410 410 + let! childNode = 411 411 + match nextCid with 412 412 + | Some c -> loader c 413 413 + | None -> async { return Some { Left = None; Entries = [] } } 414 414 + 415 415 + match childNode with 416 416 + | None -> return failwith "Failed to load child node" 417 417 + | Some cn -> 418 418 + let! newChildNode = put loader persister cn key value currentKey 419 419 + let! newChildCid = persister newChildNode 420 420 + 421 421 + if childIdx = -1 then 422 422 + return { node with Left = Some newChildCid } 423 423 + else 424 424 + return { 425 425 + node with 426 426 + Entries = 427 427 + entries 428 428 + |> List.mapi (fun idx x -> 429 429 + if idx = childIdx then 430 430 + { entries.[childIdx] with Tree = Some newChildCid } 431 431 + else 432 432 + x) 433 433 + } 434 434 + 435 435 + else 436 436 + let mutable insertIdx = -1 437 437 + let mutable found = false 438 438 + let mutable currentKey = prevKey 439 439 + let mutable i = 0 440 440 + let mutable targetChildCid = None 441 441 + let mutable childPrevKey = prevKey 442 442 + 443 443 + let fullKeysCache = new List<string>() 444 444 + 445 445 + while i < node.Entries.Length && not found do 446 446 + let e = node.Entries.[i] 447 447 + 448 448 + let prefix = 449 449 + if e.PrefixLen > currentKey.Length then 450 450 + currentKey 451 451 + else 452 452 + currentKey.Substring(0, e.PrefixLen) 453 453 + 454 454 + let fullKey = prefix + e.KeySuffix 455 455 + fullKeysCache.Add(fullKey) 456 456 + 457 457 + let cmp = compareKeys key fullKey 458 458 + 459 459 + if cmp = 0 then 460 460 + insertIdx <- i 461 461 + found <- true 462 462 + elif cmp < 0 then 463 463 + insertIdx <- i 464 464 + targetChildCid <- if i = 0 then node.Left else node.Entries.[i - 1].Tree 465 465 + childPrevKey <- currentKey 466 466 + found <- true 467 467 + else 468 468 + currentKey <- fullKey 469 469 + i <- i + 1 470 470 + 471 471 + if not found then 472 472 + insertIdx <- node.Entries.Length 473 473 + 474 474 + targetChildCid <- 475 475 + if node.Entries.Length = 0 then 476 476 + node.Left 477 477 + else 478 478 + node.Entries.[node.Entries.Length - 1].Tree 479 479 + 480 480 + childPrevKey <- currentKey 481 481 + 482 482 + let entries = node.Entries 483 483 + 484 484 + if found && compareKeys key fullKeysCache.[insertIdx] = 0 then 485 485 + let e = entries.[insertIdx] 486 486 + let newE = { e with Value = value } 487 487 + 488 488 + let newEntries = 489 489 + entries |> List.mapi (fun idx x -> if idx = insertIdx then newE else x) 490 490 + 491 491 + return { node with Entries = newEntries } 492 492 + else 493 493 + let! (lChild, rChild) = async { 494 494 + match targetChildCid with 495 495 + | None -> return { Left = None; Entries = [] }, { Left = None; Entries = [] } 496 496 + | Some cid -> 497 497 + let! cOpt = loader cid 498 498 + 499 499 + match cOpt with 500 500 + | None -> return { Left = None; Entries = [] }, { Left = None; Entries = [] } 501 501 + | Some c -> return! split loader persister c key childPrevKey 502 502 + } 503 503 + 504 504 + let persistOrNone (n : MstNode) = async { 505 505 + if n.Entries.IsEmpty && n.Left.IsNone then 506 506 + return None 507 507 + else 508 508 + let! c = persister n 509 509 + return Some c 510 510 + } 511 511 + 512 512 + let! lCid = persistOrNone lChild 513 513 + let! rCid = persistOrNone rChild 514 514 + 515 515 + let beforeEntries = 516 516 + if insertIdx = 0 then 517 517 + [] 518 518 + else 519 519 + let prevE = entries.[insertIdx - 1] 520 520 + let newPrevE = { prevE with Tree = lCid } 521 521 + (entries |> List.take (insertIdx - 1)) @ [ newPrevE ] 522 522 + 523 523 + let newLeft = if insertIdx = 0 then lCid else node.Left 524 524 + let getFullKey idx = fullKeysCache.[idx] 525 525 + let p = sharedPrefixLen childPrevKey key 526 526 + let suffix = key.Substring(p) 527 527 + 528 528 + let newEntry = { 529 529 + PrefixLen = p 530 530 + KeySuffix = suffix 531 531 + Value = value 532 532 + Tree = rCid 533 533 + } 534 534 + 535 535 + let afterEntries = 536 536 + if insertIdx >= entries.Length then 537 537 + [] 538 538 + else 539 539 + let first = entries.[insertIdx] 540 540 + let firstFullKey = getFullKey insertIdx 541 541 + 542 542 + let newP = sharedPrefixLen key firstFullKey 543 543 + let newS = firstFullKey.Substring(newP) 544 544 + let newFirst = { first with PrefixLen = newP; KeySuffix = newS } 545 545 + 546 546 + [ newFirst ] @ (entries |> List.skip (insertIdx + 1)) 547 547 + 548 548 + let newEntries = beforeEntries @ [ newEntry ] @ afterEntries 549 549 + 550 550 + return { Left = newLeft; Entries = newEntries } 551 551 + } 552 552 + 553 553 + // --- Merge Operation --- 554 554 + let rec merge 555 555 + (loader : NodeLoader) 556 556 + (persister : NodePersister) 557 557 + (leftCid : Cid option) 558 558 + (rightCid : Cid option) 559 559 + (prevKey : string) 560 560 + : Async<MstNode> = 561 561 + async { 562 562 + match leftCid, rightCid with 563 563 + | None, None -> return { Left = None; Entries = [] } 564 564 + | Some l, None -> 565 565 + let! n = loader l 566 566 + return n |> Option.defaultValue { Left = None; Entries = [] } 567 567 + | None, Some r -> 568 568 + let! n = loader r 569 569 + return n |> Option.defaultValue { Left = None; Entries = [] } 570 570 + | Some l, Some r -> 571 571 + let! lNodeOpt = loader l 572 572 + let! rNodeOpt = loader r 573 573 + let lNode = lNodeOpt |> Option.defaultValue { Left = None; Entries = [] } 574 574 + let rNode = rNodeOpt |> Option.defaultValue { Left = None; Entries = [] } 575 575 + 576 576 + let lLayer = nodeLayer lNode prevKey 577 577 + let mutable current = prevKey 578 578 + 579 579 + for e in lNode.Entries do 580 580 + let p = 581 581 + if e.PrefixLen > current.Length then 582 582 + current 583 583 + else 584 584 + current.Substring(0, e.PrefixLen) 585 585 + 586 586 + current <- p + e.KeySuffix 587 587 + 588 588 + let rightPrevKey = current 589 589 + 590 590 + let realLLayer = nodeLayer lNode prevKey 591 591 + let realRLayer = nodeLayer rNode rightPrevKey 592 592 + 593 593 + if realLLayer > realRLayer then 594 594 + match lNode.Entries with 595 595 + | [] -> return! merge loader persister lNode.Left rightCid prevKey 596 596 + | entries -> 597 597 + let lastIdx = entries.Length - 1 598 598 + let lastEntry = entries.[lastIdx] 599 599 + 600 600 + let! mergedChild = merge loader persister lastEntry.Tree rightCid rightPrevKey 601 601 + let! mergedCid = persister mergedChild 602 602 + 603 603 + let newEntry = { lastEntry with Tree = Some mergedCid } 604 604 + let newEntries = (entries |> List.take lastIdx) @ [ newEntry ] 605 605 + return { lNode with Entries = newEntries } 606 606 + 607 607 + elif realRLayer > realLLayer then 608 608 + match rNode.Entries with 609 609 + | [] -> return! merge loader persister leftCid rNode.Left prevKey 610 610 + | _ -> 611 611 + let! mergedChild = merge loader persister leftCid rNode.Left prevKey 612 612 + let! mergedCid = persister mergedChild 613 613 + 614 614 + return { rNode with Left = Some mergedCid } 615 615 + 616 616 + else 617 617 + let boundaryL = 618 618 + match lNode.Entries with 619 619 + | [] -> lNode.Left 620 620 + | es -> es.[es.Length - 1].Tree 621 621 + 622 622 + let boundaryR = rNode.Left 623 623 + 624 624 + let! mergedBoundaryNode = merge loader persister boundaryL boundaryR rightPrevKey 625 625 + let! mergedBoundaryCid = persister mergedBoundaryNode 626 626 + 627 627 + let newEntries = 628 628 + match lNode.Entries with 629 629 + | [] -> rNode.Entries 630 630 + | lEntries -> 631 631 + let lastIdx = lEntries.Length - 1 632 632 + let lastE = lEntries.[lastIdx] 633 633 + let newLastE = { lastE with Tree = Some mergedBoundaryCid } 634 634 + (lEntries |> List.take lastIdx) @ [ newLastE ] @ rNode.Entries 635 635 + 636 636 + let newLeft = 637 637 + if lNode.Entries.IsEmpty then 638 638 + Some mergedBoundaryCid 639 639 + else 640 640 + lNode.Left 641 641 + 642 642 + return { Left = newLeft; Entries = newEntries } 643 643 + } 644 644 + 645 645 + let rec delete 646 646 + (loader : NodeLoader) 647 647 + (persister : NodePersister) 648 648 + (node : MstNode) 649 649 + (key : string) 650 650 + (prevKey : string) 651 651 + : Async<MstNode option> = 652 652 + async { 653 653 + let mutable currentKey = prevKey 654 654 + let mutable foundIdx = -1 655 655 + let mutable nextTreeIdx = -1 656 656 + let mutable i = 0 657 657 + let mutable found = false 658 658 + 659 659 + while i < node.Entries.Length && not found do 660 660 + let e = node.Entries.[i] 661 661 + 662 662 + let prefix = 663 663 + if e.PrefixLen > currentKey.Length then 664 664 + currentKey 665 665 + else 666 666 + currentKey.Substring(0, e.PrefixLen) 667 667 + 668 668 + let fullKey = prefix + e.KeySuffix 669 669 + 670 670 + let cmp = compareKeys key fullKey 671 671 + 672 672 + if cmp = 0 then 673 673 + foundIdx <- i 674 674 + found <- true 675 675 + elif cmp < 0 then 676 676 + found <- true 677 677 + nextTreeIdx <- i - 1 678 678 + else 679 679 + currentKey <- fullKey 680 680 + i <- i + 1 681 681 + 682 682 + if not found then 683 683 + nextTreeIdx <- node.Entries.Length - 1 684 684 + 685 685 + if foundIdx <> -1 then 686 686 + let e = node.Entries.[foundIdx] 687 687 + 688 688 + let leftChildCid = 689 689 + if foundIdx = 0 then 690 690 + node.Left 691 691 + else 692 692 + node.Entries.[foundIdx - 1].Tree 693 693 + 694 694 + let rightChildCid = e.Tree 695 695 + 696 696 + let mergePrevKey = if foundIdx = 0 then prevKey else currentKey 697 697 + 698 698 + let! mergedChildNode = merge loader persister leftChildCid rightChildCid mergePrevKey 699 699 + let! mergedChildCid = persister mergedChildNode 700 700 + 701 701 + let newEntries = 702 702 + if foundIdx = 0 then 703 703 + let rest = node.Entries |> List.skip 1 704 704 + 705 705 + match rest with 706 706 + | [] -> [] 707 707 + | first :: rs -> 708 708 + let firstFullKey = 709 709 + let oldP = 710 710 + if first.PrefixLen > key.Length then 711 711 + key 712 712 + else 713 713 + key.Substring(0, first.PrefixLen) 714 714 + 715 715 + oldP + first.KeySuffix 716 716 + 717 717 + let newP = sharedPrefixLen prevKey firstFullKey 718 718 + let newSuffix = firstFullKey.Substring(newP) 719 719 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 720 720 + newFirst :: rs 721 721 + else 722 722 + let before = node.Entries |> List.take (foundIdx - 1) 723 723 + let prevE = node.Entries.[foundIdx - 1] 724 724 + let newPrevE = { prevE with Tree = Some mergedChildCid } 725 725 + 726 726 + let rest = node.Entries |> List.skip (foundIdx + 1) 727 727 + 728 728 + let newRest = 729 729 + match rest with 730 730 + | [] -> [] 731 731 + | first :: rs -> 732 732 + let firstFullKey = 733 733 + let oldP = 734 734 + if first.PrefixLen > key.Length then 735 735 + key 736 736 + else 737 737 + key.Substring(0, first.PrefixLen) 738 738 + 739 739 + oldP + first.KeySuffix 740 740 + 741 741 + let newP = sharedPrefixLen mergePrevKey firstFullKey 742 742 + let newSuffix = firstFullKey.Substring(newP) 743 743 + let newFirst = { first with PrefixLen = newP; KeySuffix = newSuffix } 744 744 + newFirst :: rs 745 745 + 746 746 + before @ [ newPrevE ] @ newRest 747 747 + 748 748 + let newLeft = if foundIdx = 0 then Some mergedChildCid else node.Left 749 749 + 750 750 + let newNode = { Left = newLeft; Entries = newEntries } 751 751 + 752 752 + if newNode.Entries.IsEmpty && newNode.Left.IsNone then 753 753 + return None 754 754 + else 755 755 + return Some newNode 756 756 + 757 757 + else 758 758 + let childCid = 759 759 + if nextTreeIdx = -1 then 760 760 + node.Left 761 761 + else 762 762 + node.Entries.[nextTreeIdx].Tree 763 763 + 764 764 + match childCid with 765 765 + | None -> return Some node 766 766 + | Some cid -> 767 767 + let! childNodeOpt = loader cid 768 768 + 769 769 + match childNodeOpt with 770 770 + | None -> return Some node 771 771 + | Some childNode -> 772 772 + let! newChildOpt = delete loader persister childNode key currentKey 773 773 + 774 774 + match newChildOpt with 775 775 + | None -> 776 776 + if nextTreeIdx = -1 then 777 777 + return Some { node with Left = None } 778 778 + else 779 779 + let prevE = node.Entries.[nextTreeIdx] 780 780 + let newPrevE = { prevE with Tree = None } 781 781 + 782 782 + let newEntries = 783 783 + node.Entries 784 784 + |> List.mapi (fun idx x -> if idx = nextTreeIdx then newPrevE else x) 785 785 + 786 786 + return Some { node with Entries = newEntries } 787 787 + | Some newChild -> 788 788 + let! newChildCid = persister newChild 789 789 + 790 790 + if nextTreeIdx = -1 then 791 791 + return Some { node with Left = Some newChildCid } 792 792 + else 793 793 + let prevE = node.Entries.[nextTreeIdx] 794 794 + let newPrevE = { prevE with Tree = Some newChildCid } 795 795 + 796 796 + let newEntries = 797 797 + node.Entries 798 798 + |> List.mapi (fun idx x -> if idx = nextTreeIdx then newPrevE else x) 799 799 + 800 800 + return Some { node with Entries = newEntries } 801 801 + } 802 802 + 803 803 + let fromEntries (loader : NodeLoader) (persister : NodePersister) (entries : (string * Cid) list) : Async<MstNode> = async { 804 804 + let mutable root = { Left = None; Entries = [] } 805 805 + let sortedEntries = entries |> List.sortBy fst 806 806 + 807 807 + for k, v in sortedEntries do 808 808 + let! newRoot = put loader persister root k v "" 809 809 + root <- newRoot 810 810 + 811 811 + return root 812 812 + }

+24 -3

PDSharp.Core/PDSharp.Core.fsproj

··· 1 1 <Project Sdk="Microsoft.NET.Sdk"> 2 2 - 3 2 <PropertyGroup> 4 3 <TargetFramework>net9.0</TargetFramework> 5 4 <GenerateDocumentationFile>true</GenerateDocumentationFile> 6 5 </PropertyGroup> 7 6 8 7 <ItemGroup> 9 9 - <Compile Include="Config.fs"/> 10 10 - <Compile Include="Library.fs"/> 8 8 + <Compile Include="Config.fs" /> 9 9 + <Compile Include="Cid.fs" /> 10 10 + <Compile Include="DagCbor.fs" /> 11 11 + <Compile Include="Crypto.fs" /> 12 12 + <Compile Include="Mst.fs" /> 13 13 + <Compile Include="BlockStore.fs" /> 14 14 + <Compile Include="BlobStore.fs" /> 15 15 + <Compile Include="Car.fs" /> 16 16 + <Compile Include="AtUri.fs" /> 17 17 + <Compile Include="Repository.fs" /> 18 18 + <Compile Include="Auth.fs" /> 19 19 + <Compile Include="SqliteStore.fs" /> 20 20 + <Compile Include="Firehose.fs" /> 21 21 + <Compile Include="DidResolver.fs" /> 22 22 + <Compile Include="Lexicon.fs" /> 23 23 + <Compile Include="Health.fs" /> 24 24 + <Compile Include="Library.fs" /> 11 25 </ItemGroup> 12 26 27 27 + <ItemGroup> 28 28 + <PackageReference Include="AWSSDK.S3" Version="4.0.16" /> 29 29 + <PackageReference Include="BouncyCastle.Cryptography" Version="2.6.2" /> 30 30 + <PackageReference Include="Dapper" Version="2.1.66" /> 31 31 + <PackageReference Include="Microsoft.Data.Sqlite" Version="10.0.1" /> 32 32 + <PackageReference Include="System.Formats.Cbor" Version="10.0.1" /> 33 33 + </ItemGroup> 13 34 </Project>

+123

PDSharp.Core/Repository.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + 5 5 + /// Repository commit signing and management 6 6 + module Repository = 7 7 + /// TID (Timestamp ID) generation for revision IDs 8 8 + module Tid = 9 9 + let private chars = "234567abcdefghijklmnopqrstuvwxyz" 10 10 + let private clockIdBits = 10 11 11 + let private timestampBits = 53 12 12 + 13 13 + /// Generate a random clock ID component 14 14 + let private randomClockId () = 15 15 + let rng = Random() 16 16 + rng.Next(1 <<< clockIdBits) 17 17 + 18 18 + /// Encode a number to base32 sortable string 19 19 + let private encode (value : int64) (length : int) = 20 20 + let mutable v = value 21 21 + let arr = Array.zeroCreate<char> length 22 22 + 23 23 + for i in (length - 1) .. -1 .. 0 do 24 24 + arr.[i] <- chars.[int (v &&& 0x1FL)] 25 25 + v <- v >>> 5 26 26 + 27 27 + String(arr) 28 28 + 29 29 + /// Generate a new TID based on current timestamp 30 30 + let generate () : string = 31 31 + let timestamp = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds() 32 32 + let clockId = randomClockId () 33 33 + let combined = (timestamp <<< clockIdBits) ||| int64 clockId 34 34 + encode combined 13 35 35 + 36 36 + /// Unsigned commit record (before signing) 37 37 + type UnsignedCommit = { 38 38 + Did : string 39 39 + Version : int 40 40 + Data : Cid 41 41 + Rev : string 42 42 + Prev : Cid option 43 43 + } 44 44 + 45 45 + /// Signed commit record 46 46 + type SignedCommit = { 47 47 + Did : string 48 48 + Version : int 49 49 + Data : Cid 50 50 + Rev : string 51 51 + Prev : Cid option 52 52 + Sig : byte[] 53 53 + } 54 54 + 55 55 + /// Convert unsigned commit to CBOR-encodable map 56 56 + let private unsignedToCborMap (commit : UnsignedCommit) : Map<string, obj> = 57 57 + let baseMap = 58 58 + Map.ofList [ 59 59 + ("did", box commit.Did) 60 60 + ("version", box commit.Version) 61 61 + ("data", box commit.Data) 62 62 + ("rev", box commit.Rev) 63 63 + ] 64 64 + 65 65 + match commit.Prev with 66 66 + | Some prev -> baseMap |> Map.add "prev" (box prev) 67 67 + | None -> baseMap 68 68 + 69 69 + /// Sign an unsigned commit 70 70 + let signCommit (key : Crypto.EcKeyPair) (commit : UnsignedCommit) : SignedCommit = 71 71 + let cborMap = unsignedToCborMap commit 72 72 + let cborBytes = DagCbor.encode cborMap 73 73 + let hash = Crypto.sha256 cborBytes 74 74 + let signature = Crypto.sign key hash 75 75 + 76 76 + { 77 77 + Did = commit.Did 78 78 + Version = commit.Version 79 79 + Data = commit.Data 80 80 + Rev = commit.Rev 81 81 + Prev = commit.Prev 82 82 + Sig = signature 83 83 + } 84 84 + 85 85 + /// Verify a signed commit's signature 86 86 + let verifyCommit (key : Crypto.EcKeyPair) (commit : SignedCommit) : bool = 87 87 + let unsigned = { 88 88 + Did = commit.Did 89 89 + Version = commit.Version 90 90 + Data = commit.Data 91 91 + Rev = commit.Rev 92 92 + Prev = commit.Prev 93 93 + } 94 94 + 95 95 + let cborMap = unsignedToCborMap unsigned 96 96 + let cborBytes = DagCbor.encode cborMap 97 97 + let hash = Crypto.sha256 cborBytes 98 98 + Crypto.verify key hash commit.Sig 99 99 + 100 100 + /// Convert signed commit to CBOR-encodable map 101 101 + let signedToCborMap (commit : SignedCommit) : Map<string, obj> = 102 102 + let baseMap = 103 103 + Map.ofList [ 104 104 + ("did", box commit.Did) 105 105 + ("version", box commit.Version) 106 106 + ("data", box commit.Data) 107 107 + ("rev", box commit.Rev) 108 108 + ("sig", box commit.Sig) 109 109 + ] 110 110 + 111 111 + match commit.Prev with 112 112 + | Some prev -> baseMap |> Map.add "prev" (box prev) 113 113 + | None -> baseMap 114 114 + 115 115 + /// Serialize a signed commit to DAG-CBOR bytes 116 116 + let serializeCommit (commit : SignedCommit) : byte[] = 117 117 + signedToCborMap commit |> DagCbor.encode 118 118 + 119 119 + /// Get CID for a signed commit 120 120 + let commitCid (commit : SignedCommit) : Cid = 121 121 + let bytes = serializeCommit commit 122 122 + let hash = Crypto.sha256 bytes 123 123 + Cid.FromHash hash

+256

PDSharp.Core/SqliteStore.fs

··· 1 1 + namespace PDSharp.Core 2 2 + 3 3 + open System 4 4 + open System.IO 5 5 + open Microsoft.Data.Sqlite 6 6 + open Dapper 7 7 + open PDSharp.Core.BlockStore 8 8 + open PDSharp.Core.Auth 9 9 + open System.Threading.Tasks 10 10 + open PDSharp.Core.Config 11 11 + 12 12 + /// SQLite persistence layer 13 13 + module SqliteStore = 14 14 + 15 15 + /// Initialize the database schema 16 16 + let initialize (config : AppConfig) = 17 17 + use conn = new SqliteConnection(config.SqliteConnectionString) 18 18 + 19 19 + conn.Open() 20 20 + conn.Execute("PRAGMA journal_mode=WAL;") |> ignore 21 21 + 22 22 + if config.DisableWalAutoCheckpoint then 23 23 + conn.Execute("PRAGMA wal_autocheckpoint=0;") |> ignore 24 24 + 25 25 + // TODO: fast, slightly less safe. Keep default (FULL) for now. 26 26 + // conn.Execute("PRAGMA synchronous=NORMAL;") |> ignore 27 27 + 28 28 + conn.Execute( 29 29 + """ 30 30 + CREATE TABLE IF NOT EXISTS blocks ( 31 31 + cid TEXT PRIMARY KEY, 32 32 + data BLOB NOT NULL 33 33 + ); 34 34 + """ 35 35 + ) 36 36 + |> ignore 37 37 + 38 38 + 39 39 + conn.Execute( 40 40 + """ 41 41 + CREATE TABLE IF NOT EXISTS accounts ( 42 42 + did TEXT PRIMARY KEY, 43 43 + handle TEXT NOT NULL UNIQUE, 44 44 + password_hash TEXT NOT NULL, 45 45 + email TEXT, 46 46 + created_at TEXT NOT NULL 47 47 + ); 48 48 + """ 49 49 + ) 50 50 + |> ignore 51 51 + 52 52 + conn.Execute( 53 53 + """ 54 54 + CREATE TABLE IF NOT EXISTS repos ( 55 55 + did TEXT PRIMARY KEY, 56 56 + rev TEXT NOT NULL, 57 57 + mst_root_cid TEXT NOT NULL, 58 58 + head_cid TEXT, 59 59 + collections_json TEXT -- Just store serialized collection map for now 60 60 + ); 61 61 + """ 62 62 + ) 63 63 + |> ignore 64 64 + 65 65 + conn.Execute( 66 66 + """ 67 67 + CREATE TABLE IF NOT EXISTS signing_keys ( 68 68 + did TEXT PRIMARY KEY, 69 69 + k TEXT NOT NULL -- Hex encoded private key D 70 70 + ); 71 71 + """ 72 72 + ) 73 73 + |> ignore 74 74 + 75 75 + /// DTOs for Sqlite Mapping 76 76 + type RepoRow = { 77 77 + did : string 78 78 + rev : string 79 79 + mst_root_cid : string 80 80 + head_cid : string 81 81 + collections_json : string 82 82 + } 83 83 + 84 84 + type BlockRow = { cid : string; data : byte[] } 85 85 + 86 86 + /// DTO for account rows with nullable email 87 87 + [<CLIMutable>] 88 88 + type AccountRow = { 89 89 + did : string 90 90 + handle : string 91 91 + password_hash : string 92 92 + email : string // Nullable in DB, null becomes null here 93 93 + created_at : string 94 94 + } 95 95 + 96 96 + let private toAccount (row : AccountRow) : Account = { 97 97 + Did = row.did 98 98 + Handle = row.handle 99 99 + PasswordHash = row.password_hash 100 100 + Email = if isNull row.email then None else Some row.email 101 101 + CreatedAt = DateTimeOffset.Parse row.created_at 102 102 + } 103 103 + 104 104 + type IRepoStore = 105 105 + abstract member GetRepo : string -> Async<RepoRow option> 106 106 + abstract member SaveRepo : RepoRow -> Async<unit> 107 107 + 108 108 + type SqliteBlockStore(connectionString : string) = 109 109 + interface IBlockStore with 110 110 + member _.Put(data : byte[]) = async { 111 111 + let hash = Crypto.sha256 data 112 112 + let cid = Cid.FromHash hash 113 113 + let cidStr = cid.ToString() 114 114 + 115 115 + use conn = new SqliteConnection(connectionString) 116 116 + 117 117 + let! _ = 118 118 + conn.ExecuteAsync( 119 119 + "INSERT OR IGNORE INTO blocks (cid, data) VALUES (@cid, @data)", 120 120 + {| cid = cidStr; data = data |} 121 121 + ) 122 122 + |> Async.AwaitTask 123 123 + 124 124 + return cid 125 125 + } 126 126 + 127 127 + member _.Get(cid : Cid) = async { 128 128 + use conn = new SqliteConnection(connectionString) 129 129 + 130 130 + let! result = 131 131 + conn.QuerySingleOrDefaultAsync<byte[]>("SELECT data FROM blocks WHERE cid = @cid", {| cid = cid.ToString() |}) 132 132 + |> Async.AwaitTask 133 133 + 134 134 + if isNull result then return None else return Some result 135 135 + } 136 136 + 137 137 + member _.Has(cid : Cid) = async { 138 138 + use conn = new SqliteConnection(connectionString) 139 139 + 140 140 + let! count = 141 141 + conn.ExecuteScalarAsync<int>("SELECT COUNT(1) FROM blocks WHERE cid = @cid", {| cid = cid.ToString() |}) 142 142 + |> Async.AwaitTask 143 143 + 144 144 + return count > 0 145 145 + } 146 146 + 147 147 + member _.GetAllCidsAndData() = async { 148 148 + use conn = new SqliteConnection(connectionString) 149 149 + let! rows = conn.QueryAsync<BlockRow>("SELECT cid, data FROM blocks") |> Async.AwaitTask 150 150 + 151 151 + return 152 152 + rows 153 153 + |> Seq.map (fun r -> (r.cid, r.data)) 154 154 + |> Seq.choose (fun (cidStr, data) -> 155 155 + match Cid.TryParse cidStr with 156 156 + | Some c -> Some(c, data) 157 157 + | None -> None) 158 158 + |> Seq.toList 159 159 + } 160 160 + 161 161 + type SqliteAccountStore(connectionString : string) = 162 162 + interface IAccountStore with 163 163 + member _.CreateAccount(account : Account) = async { 164 164 + use conn = new SqliteConnection(connectionString) 165 165 + 166 166 + try 167 167 + let emailValue = account.Email |> Option.toObj 168 168 + let createdAtStr = account.CreatedAt.ToString "o" 169 169 + 170 170 + let! _ = 171 171 + conn.ExecuteAsync( 172 172 + """ 173 173 + INSERT INTO accounts (did, handle, password_hash, email, created_at) 174 174 + VALUES (@Did, @Handle, @PasswordHash, @Email, @CreatedAt) 175 175 + """, 176 176 + {| 177 177 + Did = account.Did 178 178 + Handle = account.Handle 179 179 + PasswordHash = account.PasswordHash 180 180 + Email = emailValue 181 181 + CreatedAt = createdAtStr 182 182 + |} 183 183 + ) 184 184 + |> Async.AwaitTask 185 185 + 186 186 + return Ok() 187 187 + with 188 188 + | :? SqliteException as ex when ex.SqliteErrorCode = 19 -> // Constraint violation 189 189 + return Error "Account already exists (handle or DID taken)" 190 190 + | ex -> return Error ex.Message 191 191 + } 192 192 + 193 193 + member _.GetAccountByHandle(handle : string) = async { 194 194 + use conn = new SqliteConnection(connectionString) 195 195 + 196 196 + let! result = 197 197 + conn.QuerySingleOrDefaultAsync<AccountRow>( 198 198 + "SELECT * FROM accounts WHERE handle = @handle", 199 199 + {| handle = handle |} 200 200 + ) 201 201 + |> Async.AwaitTask 202 202 + 203 203 + if isNull (box result) then 204 204 + return None 205 205 + else 206 206 + return Some(toAccount result) 207 207 + } 208 208 + 209 209 + member _.GetAccountByDid(did : string) = async { 210 210 + use conn = new SqliteConnection(connectionString) 211 211 + 212 212 + let! result = 213 213 + conn.QuerySingleOrDefaultAsync<AccountRow>("SELECT * FROM accounts WHERE did = @did", {| did = did |}) 214 214 + |> Async.AwaitTask 215 215 + 216 216 + if isNull (box result) then 217 217 + return None 218 218 + else 219 219 + return Some(toAccount result) 220 220 + } 221 221 + 222 222 + type SqliteRepoStore(connectionString : string) = 223 223 + interface IRepoStore with 224 224 + member _.GetRepo(did : string) : Async<RepoRow option> = async { 225 225 + use conn = new SqliteConnection(connectionString) 226 226 + 227 227 + let! result = 228 228 + conn.QuerySingleOrDefaultAsync<RepoRow>("SELECT * FROM repos WHERE did = @did", {| did = did |}) 229 229 + |> Async.AwaitTask 230 230 + 231 231 + if isNull (box result) then 232 232 + return None 233 233 + else 234 234 + return Some result 235 235 + } 236 236 + 237 237 + member _.SaveRepo(repo : RepoRow) : Async<unit> = async { 238 238 + use conn = new SqliteConnection(connectionString) 239 239 + 240 240 + let! _ = 241 241 + conn.ExecuteAsync( 242 242 + """ 243 243 + INSERT INTO repos (did, rev, mst_root_cid, head_cid, collections_json) 244 244 + VALUES (@did, @rev, @mst_root_cid, @head_cid, @collections_json) 245 245 + ON CONFLICT(did) DO UPDATE SET 246 246 + rev = @rev, 247 247 + mst_root_cid = @mst_root_cid, 248 248 + head_cid = @head_cid, 249 249 + collections_json = @collections_json 250 250 + """, 251 251 + repo 252 252 + ) 253 253 + |> Async.AwaitTask 254 254 + 255 255 + () 256 256 + }

+77

PDSharp.Docs/auth.md

··· 1 1 + # AT Protocol Session & Account Authentication 2 2 + 3 3 + ## Session Authentication (Legacy Bearer JWT) 4 4 + 5 5 + Based on the [XRPC Spec](https://atproto.com/specs/xrpc#authentication): 6 6 + 7 7 + ### Token Types 8 8 + 9 9 + | Token | JWT `typ` Header | Lifetime | Purpose | 10 10 + | ------------- | ---------------- | --------------------------- | ------------------------------ | 11 11 + | Access Token | `at+jwt` | Short (~2min refresh cycle) | Authenticate most API requests | 12 12 + | Refresh Token | `refresh+jwt` | Longer (~2 months) | Obtain new access tokens | 13 13 + 14 14 + ### Endpoints 15 15 + 16 16 + - **`createSession`**: Login with identifier (handle/email) + password → returns `{accessJwt, refreshJwt, handle, did}` 17 17 + - **`refreshSession`**: Uses refresh JWT in Bearer header → returns new `{accessJwt, refreshJwt, handle, did}` 18 18 + - **`createAccount`**: Register new account → returns session tokens + creates DID 19 19 + 20 20 + ### JWT Claims (Server-Generated) 21 21 + 22 22 + Servers should implement **domain separation** using the `typ` header field: 23 23 + 24 24 + - Access: `typ: at+jwt` (per [RFC 9068](https://www.rfc-editor.org/rfc/rfc9068.html)) 25 25 + - Refresh: `typ: refresh+jwt` 26 26 + 27 27 + Standard JWT claims: `sub` (DID), `iat`, `exp`, `jti` (nonce) 28 28 + 29 29 + ### Configuration Required 30 30 + 31 31 + Yes, JWT signing requires a **secret key** for HMAC-SHA256 (HS256). This should be: 32 32 + 33 33 + - Loaded from configuration/environment variable (e.g., `PDS_JWT_SECRET`) 34 34 + - At least 32 bytes of cryptographically random data 35 35 + - Never hardcoded or committed to source control 36 36 + 37 37 + ## Account Storage 38 38 + 39 39 + ### Reference PDS Approach 40 40 + 41 41 + The Bluesky reference PDS uses: 42 42 + 43 43 + - **SQLite database per user** (recent architecture) 44 44 + - `account.sqlite` contains: handle, email, DID, password hash 45 45 + - Accounts indexed by DID (primary) and handle (unique) 46 46 + 47 47 + ## App Passwords 48 48 + 49 49 + App passwords are a security feature allowing restricted access: 50 50 + 51 51 + - Format: `xxxx-xxxx-xxxx-xxxx` 52 52 + - Created/revoked independently from main password 53 53 + - Grants limited permissions (no auth settings changes) 54 54 + 55 55 + ## Inter-Service Auth (Different from Session Auth) 56 56 + 57 57 + For service-to-service requests, different mechanism: 58 58 + 59 59 + - Uses **asymmetric signing** (ES256/ES256K) with account's signing key 60 60 + - Short-lived tokens (~60sec) 61 61 + - Validated against DID document 62 62 + 63 63 + ## Summary: Implementation Decisions 64 64 + 65 65 + | Aspect | Decision | Rationale | 66 66 + | --------------- | -------------------------- | ------------------------------------ | 67 67 + | Token signing | HS256 (symmetric) | Simpler, standard for session tokens | 68 68 + | Secret storage | Config/env var | Required for security | 69 69 + | Account storage | In-memory (initial) | Matches existing patterns | 70 70 + | Password hash | SHA-256 + salt | Uses existing Crypto.fs | 71 71 + | Token lifetimes | Access: 15min, Refresh: 7d | Conservative defaults | 72 72 + 73 73 + ## References 74 74 + 75 75 + - [XRPC Authentication Spec](https://atproto.com/specs/xrpc#authentication) 76 76 + - [RFC 9068 - JWT Access Tokens](https://www.rfc-editor.org/rfc/rfc9068.html) 77 77 + - [Bluesky PDS GitHub](https://github.com/bluesky-social/pds)

+50

PDSharp.Docs/car.md

··· 1 1 + # CAR Format Implementation Notes 2 2 + 3 3 + The **Content Addressable aRchives (CAR)** format is used to store content-addressable objects (IPLD blocks) as a sequence of bytes. 4 4 + It is the standard format for repository export (`sync.getRepo`) and block transfer (`sync.getBlocks`) in the AT Protocol. 5 5 + 6 6 + ## 1. Format Overview (v1) 7 7 + 8 8 + A CAR file consists of a **Header** followed by a sequence of **Data** sections. 9 9 + 10 10 + ```text 11 11 + |--------- Header --------| |--------------- Data Section 1 ---------------| |--------------- Data Section 2 ---------------| ... 12 12 + [ varint | DAG-CBOR block ] [ varint | CID bytes | Block Data bytes ] [ varint | CID bytes | Block Data bytes ] ... 13 13 + ``` 14 14 + 15 15 + ### LEB128 Varints 16 16 + 17 17 + All length prefixes in CAR are encoded as **unsigned LEB128 (UVarint)** integers. 18 18 + 19 19 + - Used to prefix the Header block. 20 20 + - Used to prefix each Data section. 21 21 + 22 22 + ## 2. Header 23 23 + 24 24 + The header is a single DAG-CBOR encoded block describing the archive. 25 25 + 26 26 + **Encoding:** 27 27 + 28 28 + 1. Construct the CBOR map: `{ "version": 1, "roots": [<cid>, ...] }`. 29 29 + 2. Encode as DAG-CBOR bytes. 30 30 + 3. Prefix with the length of those bytes (as UVarint). 31 31 + 32 32 + ## 3. Data Sections 33 33 + 34 34 + Following the header, the file contains a concatenated sequence of data sections. Each section represents one IPLD block. 35 35 + 36 36 + ```text 37 37 + [ Section Length (UVarint) ] [ CID (raw bytes) ] [ Binary Data ] 38 38 + ``` 39 39 + 40 40 + - **Section Length**: The total length of the *CID bytes* + *Binary Data*. 41 41 + - **CID**: The raw binary representation of the block's CID (usually CIDv1 + DAG-CBOR + SHA2-256). 42 42 + - **Binary Data**: The actual content of the block. 43 43 + 44 44 + The Section Length *includes* the length of the CID. 45 45 + 46 46 + This is slightly different from some other framing formats where length might only cover the payload. 47 47 + 48 48 + ## 4. References 49 49 + 50 50 + - [IPLD CARv1 Specification](https://ipld.io/specs/transport/car/carv1/)

+46

PDSharp.Docs/cbor.md

··· 1 1 + # DAG-CBOR Implementation Notes 2 2 + 3 3 + DAG-CBOR is the canonical data serialization format for the AT Protocol. 4 4 + It is a strict subset of CBOR (RFC 8949) with specific rules for determinism and linking. 5 5 + 6 6 + ## 1. Canonicalization Rules 7 7 + 8 8 + To ensure consistent Content IDs (CIDs) for the same data, specific canonicalization rules must be followed during encoding. 9 9 + 10 10 + ### Map Key Sorting 11 11 + 12 12 + Maps must be sorted by keys. The sorting order is **NOT** standard lexicographical order. 13 13 + 14 14 + 1. **Length**: Shorter keys come first. 15 15 + 2. **Bytes**: keys of the same length are sorted lexicographically by their UTF-8 byte representation. 16 16 + 17 17 + **Example:** 18 18 + 19 19 + - `"a"` (len 1) comes before `"aa"` (len 2). 20 20 + - `"b"` (len 1) comes before `"aa"` (len 2). 21 21 + - `"a"` comes before `"b"`. 22 22 + 23 23 + ### Integer Encoding 24 24 + 25 25 + Integers must be encoded using the smallest possible representation. 26 26 + 27 27 + `System.Formats.Cbor` (in Strict mode) generally handles this, but care must be taken to treat `int`, `int64`, and `uint64` consistently. 28 28 + 29 29 + ## 2. Content Addressing (CIDs) 30 30 + 31 31 + Links to other nodes (CIDs) are encoded using **CBOR Tag 42**. 32 32 + 33 33 + ### Format 34 34 + 35 35 + 1. **Tag**: `42` (Major type 6, value 42). 36 36 + 2. **Payload**: A byte string containing: 37 37 + - The `0x00` byte (Multibase identity prefix, required by IPLD specs for binary CID inclusion). 38 38 + - The raw bytes of the CID. 39 39 + 40 40 + ## 3. Known Gotchas 41 41 + 42 42 + - **Float vs Int**: 43 43 + AT Protocol generally discourages floats where integers suffice. 44 44 + F# types must be matched carefully to avoid encoding `2.0` instead of `2`. 45 45 + - **String Encoding**: 46 46 + Must be UTF-8. Indefinite length strings are prohibited in DAG-CBOR.

+69

PDSharp.Docs/mst.md

··· 1 1 + # Merkle Search Tree (MST) Implementation Notes 2 2 + 3 3 + The Merkle Search Tree (MST) is a probabilistic, balanced search tree used by the AT Protocol to store repository records. 4 4 + 5 5 + ## Overview 6 6 + 7 7 + MSTs combine properties of B-trees and Merkle trees to ensure: 8 8 + 9 9 + 1. **Determinism**: The tree structure is determined by the keys (and their hashes), not insertion order. 10 10 + 2. **Verifyability**: Every node is content-addressed (CID), allowing the entire state to be verified via a single root hash. 11 11 + 3. **Efficiency**: Efficient key-value lookups and delta-based sync (subtrees that haven't changed share the same CIDs). 12 12 + 13 13 + ## Core Concepts 14 14 + 15 15 + ### Layering (Probabilistic Balance) 16 16 + 17 17 + MSTs do not use rotation for balancing. Instead, they assign every key a "layer" based on its hash. 18 18 + 19 19 + - **Formula**: 20 20 + `Layer(key) = countLeadingZeros(SHA256(key)) / 2`. 21 21 + - **Fanout**: 22 22 + The divisor `2` implies a fanout of roughly 4 (2 bits per layer increment). 23 23 + - Keys with higher layers appear higher in the tree, splitting the range of keys below them. 24 24 + 25 25 + ### Data Structure (`MstNode`) 26 26 + 27 27 + An MST node consists of: 28 28 + 29 29 + - **Left Child (`l`)**: Use to traverse to keys lexicographically smaller than the first entry in this node. 30 30 + - **Entries (`e`)**: A sorted list of entries. Each entry contains: 31 31 + - **Prefix Length (`p`)**: Length of the shared prefix with the *previous* key in the node (or the split key). 32 32 + - **Key Suffix (`k`)**: The remaining bytes of the key. 33 33 + - **Value (`v`)**: The CID of the record data. 34 34 + - **Tree (`t`)**: (Optional) CID of the subtree containing keys between this entry and the next. 35 35 + 36 36 + **Serialization**: The node is serialized as a DAG-CBOR array: `[l, [e1, e2, ...]]`. 37 37 + 38 38 + ## Algorithms 39 39 + 40 40 + ### Insertion (`Put`) 41 41 + 42 42 + Insertion relies on the "Layer" property: 43 43 + 44 44 + 1. Calculate `Layer(newKey)`. 45 45 + 2. Traverse the tree from the root. 46 46 + 3. **Split Condition**: If `Layer(newKey)` is **greater** than the layer of the current node, the new key belongs *above* this node. 47 47 + - The current node is **split** into two children (Left and Right) based on the `newKey`. 48 48 + - The `newKey` becomes a new node pointing to these two children. 49 49 + 4. **Recurse**: If `Layer(newKey)` is **less** than the current node, find the correct child subtree (based on key comparison) and recurse. 50 50 + 5. **Same Layer**: If `Layer(newKey)` equals the current node's layer: 51 51 + - Insert perfectly into the sorted entries list. 52 52 + - Any existing child pointer at that position must be split and redistributed if necessary (though spec usually implies layers are unique enough or handled by standard BST insert at that level). 53 53 + 54 54 + ### Deletion 55 55 + 56 56 + 1. Locate the key. 57 57 + 2. Remove the entry. 58 58 + 3. **Merge**: 59 59 + Since the key acted as a separator for two subtrees (its "Left" previous child and its "Tree" child), removing it requires merging these two adjacent subtrees into a single valid MST node to preserve the tree's density and structure. 60 60 + 61 61 + ### Determinism & Prefix Compression 62 62 + 63 63 + - **Canonical Order**: Keys must always be sorted. 64 64 + - **Prefix Compression**: 65 65 + Crucial for space saving. 66 66 + The prefix length `p` is calculated relative to the *immediately preceding key* in the node. 67 67 + - **Issues**: 68 68 + Insertion order *should not* matter (commutativity). 69 69 + However, implementations must be careful with `Split` and `Merge` operations to ensure exactly the same node boundaries are created regardless of history.

+74

PDSharp.Tests/AtUri.Tests.fs

··· 1 1 + module AtUriTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core.AtUri 5 5 + 6 6 + [<Fact>] 7 7 + let ``Parse valid AT-URI`` () = 8 8 + let uri = "at://did:plc:abcd1234/app.bsky.feed.post/3kbq5vk4beg2f" 9 9 + let result = parse uri 10 10 + 11 11 + match result with 12 12 + | Ok parsed -> 13 13 + Assert.Equal("did:plc:abcd1234", parsed.Did) 14 14 + Assert.Equal("app.bsky.feed.post", parsed.Collection) 15 15 + Assert.Equal("3kbq5vk4beg2f", parsed.Rkey) 16 16 + | Error msg -> Assert.Fail(msg) 17 17 + 18 18 + [<Fact>] 19 19 + let ``Parse did:web AT-URI`` () = 20 20 + let uri = "at://did:web:example.com/app.bsky.actor.profile/self" 21 21 + let result = parse uri 22 22 + 23 23 + match result with 24 24 + | Ok parsed -> 25 25 + Assert.Equal("did:web:example.com", parsed.Did) 26 26 + Assert.Equal("app.bsky.actor.profile", parsed.Collection) 27 27 + Assert.Equal("self", parsed.Rkey) 28 28 + | Error msg -> Assert.Fail(msg) 29 29 + 30 30 + [<Fact>] 31 31 + let ``Parse fails without at:// prefix`` () = 32 32 + let uri = "http://did:plc:abcd/app.bsky.feed.post/123" 33 33 + let result = parse uri 34 34 + 35 35 + Assert.True(Result.isError result) 36 36 + 37 37 + [<Fact>] 38 38 + let ``Parse fails with invalid DID`` () = 39 39 + let uri = "at://not-a-did/app.bsky.feed.post/123" 40 40 + let result = parse uri 41 41 + 42 42 + Assert.True(Result.isError result) 43 43 + 44 44 + [<Fact>] 45 45 + let ``Parse fails with invalid collection`` () = 46 46 + let uri = "at://did:plc:abcd/NotAnNsid/123" 47 47 + let result = parse uri 48 48 + 49 49 + Assert.True(Result.isError result) 50 50 + 51 51 + [<Fact>] 52 52 + let ``Parse fails with missing parts`` () = 53 53 + let uri = "at://did:plc:abcd/app.bsky.feed.post" 54 54 + let result = parse uri 55 55 + 56 56 + Assert.True(Result.isError result) 57 57 + 58 58 + [<Fact>] 59 59 + let ``ToString roundtrip`` () = 60 60 + let original = { 61 61 + Did = "did:plc:abcd" 62 62 + Collection = "app.bsky.feed.post" 63 63 + Rkey = "123" 64 64 + } 65 65 + 66 66 + let str = toString original 67 67 + let parsed = parse str 68 68 + 69 69 + match parsed with 70 70 + | Ok p -> 71 71 + Assert.Equal(original.Did, p.Did) 72 72 + Assert.Equal(original.Collection, p.Collection) 73 73 + Assert.Equal(original.Rkey, p.Rkey) 74 74 + | Error msg -> Assert.Fail(msg)

+147

PDSharp.Tests/Auth.Tests.fs

··· 1 1 + module Auth.Tests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core.Auth 5 5 + open System 6 6 + open System.Collections.Concurrent 7 7 + 8 8 + /// Mock in-memory store for testing 9 9 + type VolatileAccountStore() = 10 10 + let accounts = ConcurrentDictionary<string, Account>() 11 11 + let handles = ConcurrentDictionary<string, string>() 12 12 + 13 13 + interface IAccountStore with 14 14 + member _.CreateAccount(account : Account) = async { 15 15 + if handles.ContainsKey(account.Handle) then 16 16 + return Error "Handle already taken" 17 17 + elif accounts.ContainsKey(account.Did) then 18 18 + return Error "Account already exists" 19 19 + else 20 20 + accounts.TryAdd(account.Did, account) |> ignore 21 21 + handles.TryAdd(account.Handle, account.Did) |> ignore 22 22 + return Ok() 23 23 + } 24 24 + 25 25 + member _.GetAccountByHandle(handle : string) = async { 26 26 + match handles.TryGetValue(handle) with 27 27 + | true, did -> 28 28 + match accounts.TryGetValue(did) with 29 29 + | true, acc -> return Some acc 30 30 + | _ -> return None 31 31 + | _ -> return None 32 32 + } 33 33 + 34 34 + member _.GetAccountByDid(did : string) = async { 35 35 + match accounts.TryGetValue(did) with 36 36 + | true, acc -> return Some acc 37 37 + | _ -> return None 38 38 + } 39 39 + 40 40 + [<Fact>] 41 41 + let ``Password hashing produces salt$hash format`` () = 42 42 + let hash = hashPassword "mypassword" 43 43 + Assert.Contains("$", hash) 44 44 + let parts = hash.Split('$') 45 45 + Assert.Equal(2, parts.Length) 46 46 + 47 47 + [<Fact>] 48 48 + let ``Password verification succeeds for correct password`` () = 49 49 + let hash = hashPassword "mypassword" 50 50 + Assert.True(verifyPassword "mypassword" hash) 51 51 + 52 52 + [<Fact>] 53 53 + let ``Password verification fails for wrong password`` () = 54 54 + let hash = hashPassword "mypassword" 55 55 + Assert.False(verifyPassword "wrongpassword" hash) 56 56 + 57 57 + [<Fact>] 58 58 + let ``Password verification fails for invalid hash format`` () = 59 59 + Assert.False(verifyPassword "password" "invalidhash") 60 60 + Assert.False(verifyPassword "password" "") 61 61 + 62 62 + [<Fact>] 63 63 + let ``JWT access token creation and validation`` () = 64 64 + let secret = "test-secret-key-minimum-32-chars!" 65 65 + let did = "did:web:test.example" 66 66 + 67 67 + let token = createAccessToken secret did 68 68 + 69 69 + let parts = token.Split('.') 70 70 + Assert.Equal(3, parts.Length) 71 71 + 72 72 + match validateToken secret token with 73 73 + | Valid(extractedDid, tokenType, _) -> 74 74 + Assert.Equal(did, extractedDid) 75 75 + Assert.Equal(Access, tokenType) 76 76 + | Invalid reason -> Assert.Fail $"Token should be valid, got: {reason}" 77 77 + 78 78 + [<Fact>] 79 79 + let ``JWT refresh token has correct type`` () = 80 80 + let secret = "test-secret-key-minimum-32-chars!" 81 81 + let did = "did:web:test.example" 82 82 + 83 83 + let token = createRefreshToken secret did 84 84 + 85 85 + match validateToken secret token with 86 86 + | Valid(_, tokenType, _) -> Assert.Equal(Refresh, tokenType) 87 87 + | Invalid reason -> Assert.Fail $"Token should be valid, got: {reason}" 88 88 + 89 89 + [<Fact>] 90 90 + let ``JWT validation fails with wrong secret`` () = 91 91 + let secret = "test-secret-key-minimum-32-chars!" 92 92 + let wrongSecret = "wrong-secret-key-minimum-32-chars!" 93 93 + let did = "did:web:test.example" 94 94 + 95 95 + let token = createAccessToken secret did 96 96 + 97 97 + match validateToken wrongSecret token with 98 98 + | Invalid _ -> Assert.True(true) 99 99 + | Valid _ -> Assert.Fail "Token should be invalid with wrong secret" 100 100 + 101 101 + [<Fact>] 102 102 + let ``Account creation and lookup by handle`` () = 103 103 + let store = VolatileAccountStore() 104 104 + 105 105 + match 106 106 + createAccount store "test.user" "password123" (Some "test@example.com") 107 107 + |> Async.RunSynchronously 108 108 + with 109 109 + | Error msg -> Assert.Fail msg 110 110 + | Ok account -> 111 111 + Assert.Equal("test.user", account.Handle) 112 112 + Assert.Equal("did:web:test.user", account.Did) 113 113 + Assert.Equal(Some "test@example.com", account.Email) 114 114 + 115 115 + let found = 116 116 + (store :> IAccountStore).GetAccountByHandle "test.user" 117 117 + |> Async.RunSynchronously 118 118 + 119 119 + match found with 120 120 + | None -> Assert.Fail "Account should be found" 121 121 + | Some foundAcc -> Assert.Equal(account.Did, foundAcc.Did) 122 122 + 123 123 + [<Fact>] 124 124 + let ``Account creation fails for duplicate handle`` () = 125 125 + let store = VolatileAccountStore() 126 126 + 127 127 + createAccount store "duplicate.user" "password" None 128 128 + |> Async.RunSynchronously 129 129 + |> ignore 130 130 + 131 131 + match createAccount store "duplicate.user" "password2" None |> Async.RunSynchronously with 132 132 + | Error msg -> Assert.Contains("already", msg.ToLower()) 133 133 + | Ok _ -> Assert.Fail "Should fail for duplicate handle" 134 134 + 135 135 + [<Fact>] 136 136 + let ``Account lookup by DID`` () = 137 137 + let store = VolatileAccountStore() 138 138 + 139 139 + match createAccount store "did.user" "password123" None |> Async.RunSynchronously with 140 140 + | Error msg -> Assert.Fail msg 141 141 + | Ok account -> 142 142 + let found = 143 143 + (store :> IAccountStore).GetAccountByDid account.Did |> Async.RunSynchronously 144 144 + 145 145 + match found with 146 146 + | None -> Assert.Fail "Account should be found by DID" 147 147 + | Some foundAcc -> Assert.Equal(account.Handle, foundAcc.Handle)

+52

PDSharp.Tests/BlockStore.Tests.fs

··· 1 1 + module BlockStoreTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.BlockStore 6 6 + 7 7 + [<Fact>] 8 8 + let ``MemoryBlockStore Put and Get roundtrip`` () = 9 9 + let store = MemoryBlockStore() :> IBlockStore 10 10 + let data = System.Text.Encoding.UTF8.GetBytes("hello world") 11 11 + 12 12 + let cid = store.Put(data) |> Async.RunSynchronously 13 13 + let retrieved = store.Get(cid) |> Async.RunSynchronously 14 14 + 15 15 + Assert.True(Option.isSome retrieved) 16 16 + Assert.Equal<byte[]>(data, Option.get retrieved) 17 17 + 18 18 + [<Fact>] 19 19 + let ``MemoryBlockStore Has returns true for existing`` () = 20 20 + let store = MemoryBlockStore() :> IBlockStore 21 21 + let data = System.Text.Encoding.UTF8.GetBytes("test data") 22 22 + 23 23 + let cid = store.Put(data) |> Async.RunSynchronously 24 24 + let exists = store.Has(cid) |> Async.RunSynchronously 25 25 + 26 26 + Assert.True(exists) 27 27 + 28 28 + [<Fact>] 29 29 + let ``MemoryBlockStore Has returns false for missing`` () = 30 30 + let store = MemoryBlockStore() :> IBlockStore 31 31 + let fakeCid = Cid.FromHash(Crypto.sha256Str "nonexistent") 32 32 + 33 33 + let exists = store.Has(fakeCid) |> Async.RunSynchronously 34 34 + 35 35 + Assert.False(exists) 36 36 + 37 37 + [<Fact>] 38 38 + let ``MemoryBlockStore Get returns None for missing`` () = 39 39 + let store = MemoryBlockStore() :> IBlockStore 40 40 + let fakeCid = Cid.FromHash(Crypto.sha256Str "nonexistent") 41 41 + 42 42 + let result = store.Get(fakeCid) |> Async.RunSynchronously 43 43 + 44 44 + Assert.True(Option.isNone result) 45 45 + 46 46 + [<Fact>] 47 47 + let ``MemoryBlockStore CID is content-addressed`` () = 48 48 + let store = MemoryBlockStore() :> IBlockStore 49 49 + let data = System.Text.Encoding.UTF8.GetBytes("same content") 50 50 + let cid1 = store.Put data |> Async.RunSynchronously 51 51 + let cid2 = store.Put data |> Async.RunSynchronously 52 52 + Assert.Equal<byte[]>(cid1.Bytes, cid2.Bytes)

+71

PDSharp.Tests/Car.Tests.fs

··· 1 1 + module CarTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.Car 6 6 + open PDSharp.Core.Crypto 7 7 + 8 8 + [<Fact>] 9 9 + let ``Varint encodes zero correctly`` () = 10 10 + let result = encodeVarint 0 11 11 + Assert.Equal<byte[]>([| 0uy |], result) 12 12 + 13 13 + [<Fact>] 14 14 + let ``Varint encodes single byte values correctly`` () = 15 15 + let result1 = encodeVarint 1 16 16 + Assert.Equal<byte[]>([| 1uy |], result1) 17 17 + 18 18 + let result127 = encodeVarint 127 19 19 + Assert.Equal<byte[]>([| 127uy |], result127) 20 20 + 21 21 + [<Fact>] 22 22 + let ``Varint encodes multi-byte values correctly`` () = 23 23 + let result128 = encodeVarint 128 24 24 + Assert.Equal<byte[]>([| 0x80uy; 0x01uy |], result128) 25 25 + 26 26 + let result300 = encodeVarint 300 27 27 + Assert.Equal<byte[]>([| 0xACuy; 0x02uy |], result300) 28 28 + 29 29 + let result16384 = encodeVarint 16384 30 30 + Assert.Equal<byte[]>([| 0x80uy; 0x80uy; 0x01uy |], result16384) 31 31 + 32 32 + [<Fact>] 33 33 + let ``CAR header starts with version and roots`` () = 34 34 + let hash = sha256Str "test-root" 35 35 + let root = Cid.FromHash hash 36 36 + let header = createHeader [ root ] 37 37 + 38 38 + Assert.True(header.Length > 0, "Header should not be empty") 39 39 + Assert.True(header.[0] >= 0xa0uy && header.[0] <= 0xbfuy, "Header should be a CBOR map") 40 40 + 41 41 + [<Fact>] 42 42 + let ``CAR block section is varint + CID + data`` () = 43 43 + let hash = sha256Str "test-block" 44 44 + let cid = Cid.FromHash hash 45 45 + let data = [| 1uy; 2uy; 3uy; 4uy |] 46 46 + 47 47 + let block = encodeBlock cid data 48 48 + 49 49 + Assert.Equal(40uy, block.[0]) 50 50 + Assert.Equal(41, block.Length) 51 51 + 52 52 + [<Fact>] 53 53 + let ``Full CAR creation produces valid structure`` () = 54 54 + let hash = sha256Str "root-data" 55 55 + let rootCid = Cid.FromHash hash 56 56 + let blocks = [ (rootCid, [| 1uy; 2uy; 3uy |]) ] 57 57 + let car = createCar [ rootCid ] blocks 58 58 + 59 59 + Assert.True(car.Length > 0, "CAR should not be empty") 60 60 + Assert.True(car.[0] < 128uy, "Header length should fit in one varint byte for small headers") 61 61 + 62 62 + [<Fact>] 63 63 + let ``CAR with multiple blocks`` () = 64 64 + let hash1 = sha256Str "block1" 65 65 + let hash2 = sha256Str "block2" 66 66 + let cid1 = Cid.FromHash hash1 67 67 + let cid2 = Cid.FromHash hash2 68 68 + 69 69 + let blocks = [ cid1, [| 1uy; 2uy; 3uy |]; cid2, [| 4uy; 5uy; 6uy; 7uy |] ] 70 70 + let car = createCar [ cid1 ] blocks 71 71 + Assert.True(car.Length > 80, "CAR with two blocks should be substantial")

+145

PDSharp.Tests/Conformance.Tests.fs

··· 1 1 + module PDSharp.Tests.Conformance 2 2 + 3 3 + open Xunit 4 4 + open System 5 5 + open System.Text.Json 6 6 + open PDSharp.Core 7 7 + 8 8 + module LexiconTests = 9 9 + 10 10 + let parse (json : string) = 11 11 + JsonSerializer.Deserialize<JsonElement>(json) 12 12 + 13 13 + [<Fact>] 14 14 + let ``Valid Post passes validation`` () = 15 15 + let json = 16 16 + """{ 17 17 + "$type": "app.bsky.feed.post", 18 18 + "text": "Hello, world!", 19 19 + "createdAt": "2023-10-27T10:00:00Z" 20 20 + }""" 21 21 + 22 22 + let element = parse json 23 23 + let result = Lexicon.validate "app.bsky.feed.post" element 24 24 + Assert.Equal(Lexicon.Ok, result) 25 25 + 26 26 + [<Fact>] 27 27 + let ``Post missing text fails validation`` () = 28 28 + let json = 29 29 + """{ 30 30 + "$type": "app.bsky.feed.post", 31 31 + "createdAt": "2023-10-27T10:00:00Z" 32 32 + }""" 33 33 + 34 34 + let element = parse json 35 35 + let result = Lexicon.validate "app.bsky.feed.post" element 36 36 + 37 37 + match result with 38 38 + | Lexicon.Error msg -> Assert.Contains("text", msg) 39 39 + | _ -> Assert.Fail("Should have failed validation") 40 40 + 41 41 + [<Fact>] 42 42 + let ``Post text too long passes validation`` () = 43 43 + let longText = String('a', 3001) 44 44 + 45 45 + let template = 46 46 + """{ 47 47 + "$type": "app.bsky.feed.post", 48 48 + "text": "TEXT_PLACEHOLDER", 49 49 + "createdAt": "2023-10-27T10:00:00Z" 50 50 + }""" 51 51 + 52 52 + let json = template.Replace("TEXT_PLACEHOLDER", longText) 53 53 + let element = parse json 54 54 + let result = Lexicon.validate "app.bsky.feed.post" element 55 55 + 56 56 + match result with 57 57 + | Lexicon.Error msg -> Assert.Contains("exceeds maximum length", msg) 58 58 + | _ -> Assert.Fail("Should have failed validation") 59 59 + 60 60 + [<Fact>] 61 61 + let ``Valid Like passes validation`` () = 62 62 + let json = 63 63 + """{ 64 64 + "$type": "app.bsky.feed.like", 65 65 + "subject": { 66 66 + "uri": "at://did:plc:123/app.bsky.feed.post/3k5", 67 67 + "cid": "bafyreih..." 68 68 + }, 69 69 + "createdAt": "2023-10-27T10:00:00Z" 70 70 + }""" 71 71 + 72 72 + let element = parse json 73 73 + let result = Lexicon.validate "app.bsky.feed.like" element 74 74 + Assert.Equal(Lexicon.Ok, result) 75 75 + 76 76 + [<Fact>] 77 77 + let ``Like missing subject fails validation`` () = 78 78 + let json = 79 79 + """{ 80 80 + "$type": "app.bsky.feed.like", 81 81 + "createdAt": "2023-10-27T10:00:00Z" 82 82 + }""" 83 83 + 84 84 + let element = parse json 85 85 + let result = Lexicon.validate "app.bsky.feed.like" element 86 86 + 87 87 + match result with 88 88 + | Lexicon.Error msg -> Assert.Contains("subject", msg) 89 89 + | _ -> Assert.Fail("Should have failed validation") 90 90 + 91 91 + [<Fact>] 92 92 + let ``Like subject missing uri passes validation (should fail)`` () = 93 93 + let json = 94 94 + """{ 95 95 + "$type": "app.bsky.feed.like", 96 96 + "subject": { 97 97 + "cid": "bafyreih..." 98 98 + }, 99 99 + "createdAt": "2023-10-27T10:00:00Z" 100 100 + }""" 101 101 + 102 102 + let element = parse json 103 103 + let result = Lexicon.validate "app.bsky.feed.like" element 104 104 + 105 105 + match result with 106 106 + | Lexicon.Error msg -> Assert.Contains("uri", msg) 107 107 + | _ -> Assert.Fail("Should have failed validation") 108 108 + 109 109 + [<Fact>] 110 110 + let ``Valid Profile passes validation`` () = 111 111 + let json = 112 112 + """{ 113 113 + "$type": "app.bsky.actor.profile", 114 114 + "displayName": "Alice", 115 115 + "description": "Bob's friend" 116 116 + }""" 117 117 + 118 118 + let element = parse json 119 119 + let result = Lexicon.validate "app.bsky.actor.profile" element 120 120 + Assert.Equal(Lexicon.Ok, result) 121 121 + 122 122 + [<Fact>] 123 123 + let ``Profile description check length`` () = 124 124 + let longDesc = String('a', 2561) 125 125 + 126 126 + let template = 127 127 + """{ 128 128 + "$type": "app.bsky.actor.profile", 129 129 + "description": "DESC_PLACEHOLDER" 130 130 + }""" 131 131 + 132 132 + let json = template.Replace("DESC_PLACEHOLDER", longDesc) 133 133 + let element = parse json 134 134 + let result = Lexicon.validate "app.bsky.actor.profile" element 135 135 + 136 136 + match result with 137 137 + | Lexicon.Error msg -> Assert.Contains("exceeds maximum length", msg) 138 138 + | _ -> Assert.Fail("Should have failed validation") 139 139 + 140 140 + [<Fact>] 141 141 + let ``Unknown type validation is lax`` () = 142 142 + let json = """{ "random": "stuff" }""" 143 143 + let element = parse json 144 144 + let result = Lexicon.validate "com.unknown.record" element 145 145 + Assert.Equal(Lexicon.Ok, result)

+55

PDSharp.Tests/Firehose.Tests.fs

··· 1 1 + module Firehose.Tests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.Firehose 6 6 + open PDSharp.Core.Crypto 7 7 + 8 8 + [<Fact>] 9 9 + let ``nextSeq monotonically increases`` () = 10 10 + resetSeq () 11 11 + let seq1 = nextSeq () 12 12 + let seq2 = nextSeq () 13 13 + let seq3 = nextSeq () 14 14 + 15 15 + Assert.Equal(1L, seq1) 16 16 + Assert.Equal(2L, seq2) 17 17 + Assert.Equal(3L, seq3) 18 18 + 19 19 + [<Fact>] 20 20 + let ``currentSeq returns without incrementing`` () = 21 21 + resetSeq () 22 22 + let _ = nextSeq () // 1 23 23 + let _ = nextSeq () // 2 24 24 + let current = currentSeq () 25 25 + let next = nextSeq () 26 26 + 27 27 + Assert.Equal(2L, current) 28 28 + Assert.Equal(3L, next) 29 29 + 30 30 + [<Fact>] 31 31 + let ``createCommitEvent has correct fields`` () = 32 32 + resetSeq () 33 33 + let hash = sha256Str "test" 34 34 + let cid = Cid.FromHash hash 35 35 + let carBytes = [| 0x01uy; 0x02uy |] 36 36 + 37 37 + let event = createCommitEvent "did:web:test" "rev123" cid carBytes 38 38 + 39 39 + Assert.Equal(1L, event.Seq) 40 40 + Assert.Equal("did:web:test", event.Did) 41 41 + Assert.Equal("rev123", event.Rev) 42 42 + Assert.Equal<byte[]>(cid.Bytes, event.Commit.Bytes) 43 43 + Assert.Equal<byte[]>(carBytes, event.Blocks) 44 44 + 45 45 + [<Fact>] 46 46 + let ``encodeEvent produces valid CBOR`` () = 47 47 + resetSeq () 48 48 + let hash = sha256Str "test" 49 49 + let cid = Cid.FromHash hash 50 50 + let carBytes = [| 0x01uy; 0x02uy |] 51 51 + let event = createCommitEvent "did:web:test" "rev123" cid carBytes 52 52 + let encoded = encodeEvent event 53 53 + 54 54 + Assert.True(encoded.Length > 0) 55 55 + Assert.True(encoded.[0] >= 0xa0uy, "Should encode as CBOR map")

+179

PDSharp.Tests/Handlers.Tests.fs

··· 1 1 + module Handlers.Tests 2 2 + 3 3 + open System 4 4 + open System.IO 5 5 + open System.Text 6 6 + open System.Text.Json 7 7 + open System.Threading.Tasks 8 8 + open System.Collections.Generic 9 9 + open Xunit 10 10 + open Microsoft.AspNetCore.Http 11 11 + open Giraffe 12 12 + open PDSharp.Core.Config 13 13 + open PDSharp.Core.BlockStore 14 14 + open PDSharp.Core 15 15 + open PDSharp.Core.SqliteStore 16 16 + open PDSharp.Core.Auth 17 17 + 18 18 + type MockAccountStore() = 19 19 + let mutable accounts = Map.empty<string, Account> 20 20 + 21 21 + interface IAccountStore with 22 22 + member _.CreateAccount(account) = async { 23 23 + if accounts.ContainsKey account.Did then 24 24 + return Error "Exists" 25 25 + else 26 26 + accounts <- accounts.Add(account.Did, account) 27 27 + return Ok() 28 28 + } 29 29 + 30 30 + member _.GetAccountByHandle(handle) = async { 31 31 + return accounts |> Map.tryPick (fun _ v -> if v.Handle = handle then Some v else None) 32 32 + } 33 33 + 34 34 + member _.GetAccountByDid did = async { return accounts.TryFind did } 35 35 + 36 36 + type MockBlockStore() = 37 37 + let mutable blocks = Map.empty<string, byte[]> 38 38 + 39 39 + interface IBlockStore with 40 40 + member _.Put(data) = async { 41 41 + let hash = Crypto.sha256 data 42 42 + let cid = Cid.FromHash hash 43 43 + blocks <- blocks.Add(cid.ToString(), data) 44 44 + return cid 45 45 + } 46 46 + 47 47 + member _.Get cid = async { return blocks.TryFind(cid.ToString()) } 48 48 + member _.Has cid = async { return blocks.ContainsKey(cid.ToString()) } 49 49 + 50 50 + member _.GetAllCidsAndData() = async { 51 51 + return 52 52 + blocks 53 53 + |> Map.toList 54 54 + |> List.choose (fun (k, v) -> Cid.TryParse k |> Option.map (fun c -> (c, v))) 55 55 + } 56 56 + 57 57 + type MockRepoStore() = 58 58 + let mutable repos = Map.empty<string, RepoRow> 59 59 + 60 60 + interface IRepoStore with 61 61 + member _.GetRepo(did) = async { return repos.TryFind did } 62 62 + member _.SaveRepo(repo) = async { repos <- repos.Add(repo.did, repo) } 63 63 + 64 64 + type MockJsonSerializer() = 65 65 + interface Giraffe.Json.ISerializer with 66 66 + member _.SerializeToString x = JsonSerializer.Serialize x 67 67 + member _.SerializeToBytes x = JsonSerializer.SerializeToUtf8Bytes x 68 68 + member _.Deserialize<'T>(json : string) = JsonSerializer.Deserialize<'T> json 69 69 + 70 70 + member _.Deserialize<'T>(bytes : byte[]) = 71 71 + JsonSerializer.Deserialize<'T>(ReadOnlySpan bytes) 72 72 + 73 73 + member _.DeserializeAsync<'T>(stream : Stream) = task { return! JsonSerializer.DeserializeAsync<'T>(stream) } 74 74 + 75 75 + member _.SerializeToStreamAsync<'T> (x : 'T) (stream : Stream) = task { 76 76 + do! JsonSerializer.SerializeAsync<'T>(stream, x) 77 77 + } 78 78 + 79 79 + let mockContext (services : (Type * obj) list) (body : string) (query : Map<string, string>) = 80 80 + let ctx = new DefaultHttpContext() 81 81 + let serializer = MockJsonSerializer() 82 82 + let allServices = (typeof<Giraffe.Json.ISerializer>, box serializer) :: services 83 83 + 84 84 + let sp = 85 85 + { new IServiceProvider with 86 86 + member _.GetService(serviceType) = 87 87 + allServices 88 88 + |> List.tryPick (fun (t, s) -> if t = serviceType then Some s else None) 89 89 + |> Option.toObj 90 90 + } 91 91 + 92 92 + ctx.RequestServices <- sp 93 93 + 94 94 + if not (String.IsNullOrEmpty body) then 95 95 + let stream = new MemoryStream(Encoding.UTF8.GetBytes(body)) 96 96 + ctx.Request.Body <- stream 97 97 + ctx.Request.ContentLength <- stream.Length 98 98 + 99 99 + if not query.IsEmpty then 100 100 + let dict = Dictionary<string, Microsoft.Extensions.Primitives.StringValues>() 101 101 + 102 102 + for kvp in query do 103 103 + dict.Add(kvp.Key, Microsoft.Extensions.Primitives.StringValues(kvp.Value)) 104 104 + 105 105 + ctx.Request.Query <- QueryCollection dict 106 106 + 107 107 + ctx 108 108 + 109 109 + [<Fact>] 110 110 + let ``Auth.createAccountHandler creates account successfully`` () = task { 111 111 + let accountStore = MockAccountStore() 112 112 + 113 113 + let config = { 114 114 + PublicUrl = "https://pds.example.com" 115 115 + DidHost = "did:web:pds.example.com" 116 116 + JwtSecret = "secret" 117 117 + SqliteConnectionString = "" 118 118 + DisableWalAutoCheckpoint = false 119 119 + BlobStore = Disk "blobs" 120 120 + } 121 121 + 122 122 + let services = [ typeof<AppConfig>, box config; typeof<IAccountStore>, box accountStore ] 123 123 + 124 124 + let req : PDSharp.Handlers.Auth.CreateAccountRequest = { 125 125 + handle = "alice.test" 126 126 + email = Some "alice@test.com" 127 127 + password = "password123" 128 128 + inviteCode = None 129 129 + } 130 130 + 131 131 + let body = JsonSerializer.Serialize req 132 132 + let ctx = mockContext services body Map.empty 133 133 + let next : HttpFunc = fun _ -> Task.FromResult(None) 134 134 + let! result = PDSharp.Handlers.Auth.createAccountHandler next ctx 135 135 + Assert.Equal(200, ctx.Response.StatusCode) 136 136 + 137 137 + let store = accountStore :> IAccountStore 138 138 + let! accountOpt = store.GetAccountByHandle "alice.test" 139 139 + Assert.True accountOpt.IsSome 140 140 + } 141 141 + 142 142 + [<Fact>] 143 143 + let ``Server.indexHandler returns HTML`` () = task { 144 144 + let ctx = new DefaultHttpContext() 145 145 + let next : HttpFunc = fun _ -> Task.FromResult(None) 146 146 + let! result = PDSharp.Handlers.Server.indexHandler next ctx 147 147 + Assert.Equal(200, ctx.Response.StatusCode) 148 148 + Assert.Equal("text/html", ctx.Response.ContentType) 149 149 + } 150 150 + 151 151 + [<Fact>] 152 152 + let ``Repo.createRecordHandler invalid collection returns error`` () = task { 153 153 + let blockStore = MockBlockStore() 154 154 + let repoStore = MockRepoStore() 155 155 + let keyStore = PDSharp.Handlers.SigningKeyStore() 156 156 + let firehose = PDSharp.Handlers.FirehoseState() 157 157 + 158 158 + let services = [ 159 159 + typeof<IBlockStore>, box blockStore 160 160 + typeof<IRepoStore>, box repoStore 161 161 + typeof<PDSharp.Handlers.SigningKeyStore>, box keyStore 162 162 + typeof<PDSharp.Handlers.FirehoseState>, box firehose 163 163 + ] 164 164 + 165 165 + let record = JsonSerializer.Deserialize<JsonElement> "{\"text\":\"hello\"}" 166 166 + 167 167 + let req : PDSharp.Handlers.Repo.CreateRecordRequest = { 168 168 + repo = "did:web:alice.test" 169 169 + collection = "app.bsky.feed.post" 170 170 + record = record 171 171 + rkey = None 172 172 + } 173 173 + 174 174 + let body = JsonSerializer.Serialize(req) 175 175 + let ctx = mockContext services body Map.empty 176 176 + let next : HttpFunc = fun _ -> Task.FromResult(None) 177 177 + let! result = PDSharp.Handlers.Repo.createRecordHandler next ctx 178 178 + Assert.Equal(400, ctx.Response.StatusCode) 179 179 + }

+116

PDSharp.Tests/Health.Tests.fs

··· 1 1 + module PDSharp.Tests.Health 2 2 + 3 3 + open System 4 4 + open Xunit 5 5 + open PDSharp.Core.Health 6 6 + 7 7 + [<Fact>] 8 8 + let ``getDiskUsage returns disk info for valid path`` () = 9 9 + let result = getDiskUsage "." 10 10 + 11 11 + match result with 12 12 + | Some usage -> 13 13 + Assert.True(usage.TotalBytes > 0L) 14 14 + Assert.True(usage.FreeBytes >= 0L) 15 15 + Assert.True(usage.UsedBytes >= 0L) 16 16 + Assert.True(usage.UsedPercent >= 0.0 && usage.UsedPercent <= 100.0) 17 17 + | None -> Assert.True(true) 18 18 + 19 19 + [<Fact>] 20 20 + let ``getDiskUsage UsedPercent is calculated correctly`` () = 21 21 + let result = getDiskUsage "." 22 22 + 23 23 + match result with 24 24 + | Some usage -> 25 25 + let expectedUsed = usage.TotalBytes - usage.FreeBytes 26 26 + Assert.Equal(expectedUsed, usage.UsedBytes) 27 27 + let expectedPercent = float usage.UsedBytes / float usage.TotalBytes * 100.0 28 28 + Assert.True(abs (usage.UsedPercent - expectedPercent) < 0.1) 29 29 + | None -> Assert.True(true) 30 30 + 31 31 + [<Fact>] 32 32 + let ``getDiskUsage IsCritical is true when usage > 90 percent`` () = 33 33 + let result = getDiskUsage "." 34 34 + 35 35 + match result with 36 36 + | Some usage -> Assert.Equal(usage.UsedPercent >= 90.0, usage.IsCritical) 37 37 + | None -> Assert.True(true) 38 38 + 39 39 + [<Fact>] 40 40 + let ``checkDatabaseHealth returns healthy for existing file`` () = 41 41 + let tempPath = System.IO.Path.GetTempFileName() 42 42 + 43 43 + try 44 44 + let connStr = $"Data Source={tempPath}" 45 45 + let result = checkDatabaseHealth connStr 46 46 + Assert.True result.IsHealthy 47 47 + Assert.True result.Message.IsNone 48 48 + finally 49 49 + System.IO.File.Delete tempPath 50 50 + 51 51 + [<Fact>] 52 52 + let ``checkDatabaseHealth returns unhealthy for missing file`` () = 53 53 + let connStr = "Data Source=/nonexistent/path/to/database.db" 54 54 + let result = checkDatabaseHealth connStr 55 55 + Assert.False result.IsHealthy 56 56 + Assert.True result.Message.IsSome 57 57 + 58 58 + [<Fact>] 59 59 + let ``checkDatabaseHealth handles invalid connection string`` () = 60 60 + let connStr = "invalid" 61 61 + let result = checkDatabaseHealth connStr 62 62 + Assert.False result.IsHealthy 63 63 + Assert.True result.Message.IsSome 64 64 + 65 65 + [<Fact>] 66 66 + let ``getBackupStatus returns stale when no backup`` () = 67 67 + let result = getBackupStatus None 68 68 + Assert.True result.IsStale 69 69 + Assert.True result.LastBackupTime.IsNone 70 70 + Assert.True result.BackupAgeHours.IsNone 71 71 + 72 72 + [<Fact>] 73 73 + let ``getBackupStatus returns not stale for recent backup`` () = 74 74 + let recentTime = DateTimeOffset.UtcNow.AddHours(-1.0) 75 75 + let result = getBackupStatus (Some recentTime) 76 76 + Assert.False result.IsStale 77 77 + Assert.True result.LastBackupTime.IsSome 78 78 + Assert.True result.BackupAgeHours.IsSome 79 79 + Assert.True(result.BackupAgeHours.Value < 24.0) 80 80 + 81 81 + [<Fact>] 82 82 + let ``getBackupStatus returns stale for old backup`` () = 83 83 + let oldTime = DateTimeOffset.UtcNow.AddHours(-25.0) 84 84 + let result = getBackupStatus (Some oldTime) 85 85 + Assert.True result.IsStale 86 86 + Assert.True(result.BackupAgeHours.Value > 24.0) 87 87 + 88 88 + [<Fact>] 89 89 + let ``HealthState tracks uptime correctly`` () = 90 90 + let state = HealthState() 91 91 + state.SetStartTime(DateTimeOffset.UtcNow.AddSeconds(-10.0)) 92 92 + let uptime = state.GetUptime() 93 93 + Assert.True(uptime >= 9L && uptime <= 12L) 94 94 + 95 95 + [<Fact>] 96 96 + let ``HealthState records backup time`` () = 97 97 + let state = HealthState() 98 98 + Assert.True state.LastBackupTime.IsNone 99 99 + state.RecordBackup() 100 100 + Assert.True state.LastBackupTime.IsSome 101 101 + 102 102 + [<Fact>] 103 103 + let ``buildHealthStatus constructs complete status`` () = 104 104 + let state = HealthState() 105 105 + let tempPath = System.IO.Path.GetTempFileName() 106 106 + 107 107 + try 108 108 + let connStr = $"Data Source={tempPath}" 109 109 + let status = buildHealthStatus "1.0.0" state connStr "." 110 110 + 111 111 + Assert.Equal("1.0.0", status.Version) 112 112 + Assert.True(status.UptimeSeconds >= 0L) 113 113 + Assert.True status.DatabaseStatus.IsHealthy 114 114 + Assert.True status.BackupStatus.IsSome 115 115 + finally 116 116 + System.IO.File.Delete tempPath

+264

PDSharp.Tests/Mst.Tests.fs

··· 1 1 + module MstTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.Mst 6 6 + 7 7 + [<Fact>] 8 8 + let ``Serialization Roundtrip`` () = 9 9 + let cid1 = Cid(Crypto.sha256Str "val1") 10 10 + 11 11 + let e1 = { 12 12 + PrefixLen = 0 13 13 + KeySuffix = "apple" 14 14 + Value = cid1 15 15 + Tree = None 16 16 + } 17 17 + 18 18 + let e2 = { 19 19 + PrefixLen = 2 20 20 + KeySuffix = "ricot" 21 21 + Value = cid1 22 22 + Tree = None 23 23 + } 24 24 + 25 25 + let node = { Left = None; Entries = [ e1; e2 ] } 26 26 + 27 27 + let bytes = Mst.serialize node 28 28 + let node2 = Mst.deserialize bytes 29 29 + 30 30 + Assert.Equal(node.Entries.Length, node2.Entries.Length) 31 31 + Assert.Equal("apple", node2.Entries.[0].KeySuffix) 32 32 + Assert.Equal("ricot", node2.Entries.[1].KeySuffix) 33 33 + Assert.Equal(2, node2.Entries.[1].PrefixLen) 34 34 + 35 35 + [<Fact>] 36 36 + let ``Get Operation Linear Scan`` () = 37 37 + let cid1 = Cid(Crypto.sha256Str "val1") 38 38 + let cid2 = Cid(Crypto.sha256Str "val2") 39 39 + 40 40 + let e1 = { 41 41 + PrefixLen = 0 42 42 + KeySuffix = "apple" 43 43 + Value = cid1 44 44 + Tree = None 45 45 + } 46 46 + 47 47 + let e2 = { 48 48 + PrefixLen = 0 49 49 + KeySuffix = "banana" 50 50 + Value = cid2 51 51 + Tree = None 52 52 + } 53 53 + 54 54 + let node = { Left = None; Entries = [ e1; e2 ] } 55 55 + 56 56 + let loader (c : Cid) = async { return None } 57 57 + 58 58 + let res1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 59 59 + Assert.Equal(Some cid1, res1) 60 60 + 61 61 + let res2 = Mst.get loader node "banana" "" |> Async.RunSynchronously 62 62 + Assert.Equal(Some cid2, res2) 63 63 + 64 64 + let res3 = Mst.get loader node "cherry" "" |> Async.RunSynchronously 65 65 + Assert.True(Option.isNone res3) 66 66 + 67 67 + [<Fact>] 68 68 + let ``Get Operation With Prefix Compression`` () = 69 69 + let cid1 = Cid(Crypto.sha256Str "val1") 70 70 + let cid2 = Cid(Crypto.sha256Str "val2") 71 71 + 72 72 + let e1 = { 73 73 + PrefixLen = 0 74 74 + KeySuffix = "apple" 75 75 + Value = cid1 76 76 + Tree = None 77 77 + } 78 78 + 79 79 + let e2 = { 80 80 + PrefixLen = 2 81 81 + KeySuffix = "ricot" 82 82 + Value = cid2 83 83 + Tree = None 84 84 + } 85 85 + 86 86 + let node = { Left = None; Entries = [ e1; e2 ] } 87 87 + let loader (c : Cid) = async { return None } 88 88 + 89 89 + let res1 = Mst.get loader node "apricot" "" |> Async.RunSynchronously 90 90 + Assert.Equal(Some cid2, res1) 91 91 + 92 92 + [<Fact>] 93 93 + let ``Put Operation Simple Insert`` () = 94 94 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 95 95 + 96 96 + let loader (c : Cid) = async { 97 97 + let key = System.Convert.ToBase64String(c.Bytes) 98 98 + let success, node = store.TryGetValue(key) 99 99 + return if success then Some node else None 100 100 + } 101 101 + 102 102 + let persister (n : MstNode) = async { 103 103 + let bytes = Mst.serialize n 104 104 + let cid = Cid(Crypto.sha256 bytes) 105 105 + let key = System.Convert.ToBase64String(cid.Bytes) 106 106 + store.[key] <- n 107 107 + return cid 108 108 + } 109 109 + 110 110 + let node = { Left = None; Entries = [] } 111 111 + let cid1 = Cid(Crypto.sha256Str "v1") 112 112 + let node2 = Mst.put loader persister node "apple" cid1 "" |> Async.RunSynchronously 113 113 + 114 114 + Assert.Equal(1, node2.Entries.Length) 115 115 + Assert.Equal("apple", node2.Entries.[0].KeySuffix) 116 116 + Assert.Equal(0, node2.Entries.[0].PrefixLen) 117 117 + Assert.Equal(cid1, node2.Entries.[0].Value) 118 118 + 119 119 + let res = Mst.get loader node2 "apple" "" |> Async.RunSynchronously 120 120 + Assert.Equal(Some cid1, res) 121 121 + 122 122 + [<Fact>] 123 123 + let ``Put Operation Multiple Sorted`` () = 124 124 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 125 125 + 126 126 + let loader (c : Cid) = async { 127 127 + let key = System.Convert.ToBase64String(c.Bytes) 128 128 + let success, node = store.TryGetValue(key) 129 129 + return if success then Some node else None 130 130 + } 131 131 + 132 132 + let persister (n : MstNode) = async { 133 133 + let bytes = Mst.serialize n 134 134 + let cid = Cid(Crypto.sha256 bytes) 135 135 + let key = System.Convert.ToBase64String(cid.Bytes) 136 136 + store.[key] <- n 137 137 + return cid 138 138 + } 139 139 + 140 140 + let mutable node = { Left = None; Entries = [] } 141 141 + 142 142 + let k1, v1 = "apple", Cid(Crypto.sha256Str "1") 143 143 + let k2, v2 = "banana", Cid(Crypto.sha256Str "2") 144 144 + let k3, v3 = "cherry", Cid(Crypto.sha256Str "3") 145 145 + 146 146 + node <- Mst.put loader persister node k1 v1 "" |> Async.RunSynchronously 147 147 + node <- Mst.put loader persister node k2 v2 "" |> Async.RunSynchronously 148 148 + node <- Mst.put loader persister node k3 v3 "" |> Async.RunSynchronously 149 149 + 150 150 + let g1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 151 151 + let g2 = Mst.get loader node "banana" "" |> Async.RunSynchronously 152 152 + let g3 = Mst.get loader node "cherry" "" |> Async.RunSynchronously 153 153 + 154 154 + Assert.Equal(Some v1, g1) 155 155 + Assert.Equal(Some v2, g2) 156 156 + Assert.Equal(Some v3, g3) 157 157 + 158 158 + [<Fact>] 159 159 + let ``Put Operation Multiple Reverse`` () = 160 160 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 161 161 + 162 162 + let loader (c : Cid) = async { 163 163 + let key = System.Convert.ToBase64String(c.Bytes) 164 164 + let success, node = store.TryGetValue(key) 165 165 + return if success then Some node else None 166 166 + } 167 167 + 168 168 + let persister (n : MstNode) = async { 169 169 + let bytes = Mst.serialize n 170 170 + let cid = Cid(Crypto.sha256 bytes) 171 171 + let key = System.Convert.ToBase64String(cid.Bytes) 172 172 + store.[key] <- n 173 173 + return cid 174 174 + } 175 175 + 176 176 + let mutable node = { Left = None; Entries = [] } 177 177 + 178 178 + let data = [ "zebra"; "yak"; "xylophone" ] 179 179 + 180 180 + for k in data do 181 181 + let v = Cid(Crypto.sha256Str k) 182 182 + node <- Mst.put loader persister node k v "" |> Async.RunSynchronously 183 183 + 184 184 + for k in data do 185 185 + let expected = Cid(Crypto.sha256Str k) 186 186 + let actual = Mst.get loader node k "" |> Async.RunSynchronously 187 187 + Assert.Equal(Some expected, actual) 188 188 + 189 189 + [<Fact>] 190 190 + let ``Delete Operation Simple`` () = 191 191 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 192 192 + 193 193 + let loader (c : Cid) = async { 194 194 + let key = System.Convert.ToBase64String(c.Bytes) 195 195 + let success, node = store.TryGetValue(key) 196 196 + return if success then Some node else None 197 197 + } 198 198 + 199 199 + let persister (n : MstNode) = async { 200 200 + let bytes = Mst.serialize n 201 201 + let cid = Cid(Crypto.sha256 bytes) 202 202 + let key = System.Convert.ToBase64String(cid.Bytes) 203 203 + store.[key] <- n 204 204 + return cid 205 205 + } 206 206 + 207 207 + let mutable node = { Left = None; Entries = [] } 208 208 + let cid1 = Cid(Crypto.sha256Str "val1") 209 209 + 210 210 + node <- Mst.put loader persister node "apple" cid1 "" |> Async.RunSynchronously 211 211 + 212 212 + let res1 = Mst.get loader node "apple" "" |> Async.RunSynchronously 213 213 + Assert.Equal(Some cid1, res1) 214 214 + 215 215 + // Delete 216 216 + let nodeOpt = Mst.delete loader persister node "apple" "" |> Async.RunSynchronously 217 217 + 218 218 + match nodeOpt with 219 219 + | None -> () 220 220 + | Some n -> 221 221 + let res2 = Mst.get loader n "apple" "" |> Async.RunSynchronously 222 222 + Assert.True(Option.isNone res2) 223 223 + 224 224 + [<Fact>] 225 225 + let ``Determinism From Entries`` () = 226 226 + let store = System.Collections.Concurrent.ConcurrentDictionary<string, MstNode>() 227 227 + 228 228 + let loader (c : Cid) = async { 229 229 + let key = System.Convert.ToBase64String(c.Bytes) 230 230 + let success, node = store.TryGetValue(key) 231 231 + return if success then Some node else None 232 232 + } 233 233 + 234 234 + let persister (n : MstNode) = async { 235 235 + let bytes = Mst.serialize n 236 236 + let cid = Cid(Crypto.sha256 bytes) 237 237 + let key = System.Convert.ToBase64String(cid.Bytes) 238 238 + store.[key] <- n 239 239 + return cid 240 240 + } 241 241 + 242 242 + let data = [ 243 243 + "apple", Cid(Crypto.sha256Str "1") 244 244 + "banana", Cid(Crypto.sha256Str "2") 245 245 + "cherry", Cid(Crypto.sha256Str "3") 246 246 + "date", Cid(Crypto.sha256Str "4") 247 247 + "elderberry", Cid(Crypto.sha256Str "5") 248 248 + ] 249 249 + 250 250 + 251 251 + let node1 = Mst.fromEntries loader persister data |> Async.RunSynchronously 252 252 + let cid1 = persister node1 |> Async.RunSynchronously 253 253 + 254 254 + let node2 = 255 255 + Mst.fromEntries loader persister (List.rev data) |> Async.RunSynchronously 256 256 + 257 257 + let cid2 = persister node2 |> Async.RunSynchronously 258 258 + let data3 = [ data.[2]; data.[0]; data.[4]; data.[1]; data.[3] ] 259 259 + let node3 = Mst.fromEntries loader persister data3 |> Async.RunSynchronously 260 260 + let cid3 = persister node3 |> Async.RunSynchronously 261 261 + 262 262 + Assert.Equal(cid1, cid2) 263 263 + Assert.Equal(cid1, cid3) 264 264 + ()

+13 -5

PDSharp.Tests/PDSharp.Tests.fsproj

··· 1 1 <Project Sdk="Microsoft.NET.Sdk"> 2 2 - 3 2 <PropertyGroup> 4 3 <TargetFramework>net9.0</TargetFramework> 5 4 <IsPackable>false</IsPackable> ··· 8 7 9 8 <ItemGroup> 10 9 <Compile Include="Tests.fs" /> 10 10 + <Compile Include="Mst.Tests.fs" /> 11 11 + <Compile Include="BlockStore.Tests.fs" /> 12 12 + <Compile Include="AtUri.Tests.fs" /> 13 13 + <Compile Include="Repository.Tests.fs" /> 14 14 + <Compile Include="Car.Tests.fs" /> 15 15 + <Compile Include="Firehose.Tests.fs" /> 16 16 + <Compile Include="Auth.Tests.fs" /> 17 17 + <Compile Include="Conformance.Tests.fs" /> 18 18 + <Compile Include="Handlers.Tests.fs" /> 19 19 + <Compile Include="Health.Tests.fs" /> 11 20 <Compile Include="Program.fs" /> 12 21 </ItemGroup> 13 22 ··· 18 27 <PackageReference Include="xunit.runner.visualstudio" Version="2.8.2" /> 19 28 </ItemGroup> 20 29 21 21 - <ItemGroup> 22 22 - <ProjectReference Include="..\PDSharp\PDSharp.fsproj" /> 23 23 - <ProjectReference Include="..\PDSharp.Core\PDSharp.Core.fsproj" /> 30 30 + <ItemGroup> 31 31 + <ProjectReference Include="..\PDSharp\PDSharp.fsproj" /> 32 32 + <ProjectReference Include="..\PDSharp.Core\PDSharp.Core.fsproj" /> 24 33 </ItemGroup> 25 25 - 26 34 </Project>

+128

PDSharp.Tests/Repository.Tests.fs

··· 1 1 + module RepositoryTests 2 2 + 3 3 + open Xunit 4 4 + open PDSharp.Core 5 5 + open PDSharp.Core.Crypto 6 6 + open PDSharp.Core.Repository 7 7 + 8 8 + [<Fact>] 9 9 + let ``TID generation produces 13 character string`` () = 10 10 + let tid = Tid.generate () 11 11 + Assert.Equal(13, tid.Length) 12 12 + 13 13 + [<Fact>] 14 14 + let ``TID generation is sortable by time`` () = 15 15 + let tid1 = Tid.generate () 16 16 + System.Threading.Thread.Sleep(2) 17 17 + let tid2 = Tid.generate () 18 18 + Assert.True(tid2 > tid1, $"Expected {tid2} > {tid1}") 19 19 + 20 20 + [<Fact>] 21 21 + let ``Commit signing produces valid signature`` () = 22 22 + let keyPair = generateKey P256 23 23 + let mstRoot = Cid.FromHash(sha256Str "mst-root") 24 24 + 25 25 + let unsigned = { 26 26 + Did = "did:plc:test1234" 27 27 + Version = 3 28 28 + Data = mstRoot 29 29 + Rev = Tid.generate () 30 30 + Prev = None 31 31 + } 32 32 + 33 33 + let signed = signCommit keyPair unsigned 34 34 + 35 35 + Assert.Equal(64, signed.Sig.Length) 36 36 + Assert.Equal(unsigned.Did, signed.Did) 37 37 + Assert.Equal(unsigned.Data, signed.Data) 38 38 + 39 39 + [<Fact>] 40 40 + let ``Commit verification succeeds for valid commit`` () = 41 41 + let keyPair = generateKey P256 42 42 + let mstRoot = Cid.FromHash(sha256Str "data") 43 43 + 44 44 + let unsigned = { 45 45 + Did = "did:plc:abc" 46 46 + Version = 3 47 47 + Data = mstRoot 48 48 + Rev = Tid.generate () 49 49 + Prev = None 50 50 + } 51 51 + 52 52 + let signed = signCommit keyPair unsigned 53 53 + 54 54 + Assert.True(verifyCommit keyPair signed) 55 55 + 56 56 + [<Fact>] 57 57 + let ``Commit verification fails for tampered data`` () = 58 58 + let keyPair = generateKey P256 59 59 + let mstRoot = Cid.FromHash(sha256Str "original") 60 60 + 61 61 + let unsigned = { 62 62 + Did = "did:plc:abc" 63 63 + Version = 3 64 64 + Data = mstRoot 65 65 + Rev = Tid.generate () 66 66 + Prev = None 67 67 + } 68 68 + 69 69 + let signed = signCommit keyPair unsigned 70 70 + let tampered = { signed with Did = "did:plc:different" } 71 71 + 72 72 + Assert.False(verifyCommit keyPair tampered) 73 73 + 74 74 + [<Fact>] 75 75 + let ``Commit with prev CID`` () = 76 76 + let keyPair = generateKey P256 77 77 + let mstRoot = Cid.FromHash(sha256Str "new-data") 78 78 + let prevCid = Cid.FromHash(sha256Str "prev-commit") 79 79 + 80 80 + let unsigned = { 81 81 + Did = "did:plc:abc" 82 82 + Version = 3 83 83 + Data = mstRoot 84 84 + Rev = Tid.generate () 85 85 + Prev = Some prevCid 86 86 + } 87 87 + 88 88 + let signed = signCommit keyPair unsigned 89 89 + Assert.True(verifyCommit keyPair signed) 90 90 + Assert.True(Option.isSome signed.Prev) 91 91 + 92 92 + [<Fact>] 93 93 + let ``Commit CID is deterministic`` () = 94 94 + let keyPair = generateKey P256 95 95 + let mstRoot = Cid.FromHash(sha256Str "data") 96 96 + 97 97 + let unsigned = { 98 98 + Did = "did:plc:abc" 99 99 + Version = 3 100 100 + Data = mstRoot 101 101 + Rev = "abcdefghijklm" 102 102 + Prev = None 103 103 + } 104 104 + 105 105 + let signed = signCommit keyPair unsigned 106 106 + let cid1 = commitCid signed 107 107 + let cid2 = commitCid signed 108 108 + 109 109 + Assert.Equal<byte[]>(cid1.Bytes, cid2.Bytes) 110 110 + 111 111 + [<Fact>] 112 112 + let ``Commit serialization produces valid DAG-CBOR`` () = 113 113 + let keyPair = generateKey P256 114 114 + let mstRoot = Cid.FromHash(sha256Str "test") 115 115 + 116 116 + let unsigned = { 117 117 + Did = "did:plc:test" 118 118 + Version = 3 119 119 + Data = mstRoot 120 120 + Rev = Tid.generate () 121 121 + Prev = None 122 122 + } 123 123 + 124 124 + let signed = signCommit keyPair unsigned 125 125 + let bytes = serializeCommit signed 126 126 + 127 127 + Assert.True(bytes.Length > 0) 128 128 + Assert.True(bytes.[0] >= 0xa0uy && bytes.[0] <= 0xbfuy)

+114 -4

PDSharp.Tests/Tests.fs

··· 1 1 module Tests 2 2 3 3 - open System 4 3 open Xunit 5 4 open PDSharp.Core.Models 6 5 open PDSharp.Core.Config 7 7 - 8 8 - [<Fact>] 9 9 - let ``My test`` () = Assert.True(true) 6 6 + open PDSharp.Core.Crypto 7 7 + open PDSharp.Core 8 8 + open PDSharp.Core.DidResolver 9 9 + open Org.BouncyCastle.Utilities.Encoders 10 10 + open System.Text 11 11 + open System.Text.Json 12 12 + open Org.BouncyCastle.Math 10 13 11 14 [<Fact>] 12 15 let ``Can instantiate AppConfig`` () = 13 16 let config = { 14 17 PublicUrl = "https://example.com" 15 18 DidHost = "did:web:example.com" 19 19 + JwtSecret = "test-secret-key-for-testing-only" 20 20 + SqliteConnectionString = "Data Source=:memory:" 21 21 + DisableWalAutoCheckpoint = false 22 22 + BlobStore = Disk "blobs" 16 23 } 17 24 18 25 Assert.Equal("did:web:example.com", config.DidHost) 19 26 20 27 [<Fact>] 28 28 + let ``CID TryParse roundtrip`` () = 29 29 + let hash = Crypto.sha256Str "test-data" 30 30 + let cid = Cid.FromHash hash 31 31 + let cidStr = cid.ToString() 32 32 + 33 33 + match Cid.TryParse cidStr with 34 34 + | Some parsed -> Assert.Equal<byte[]>(cid.Bytes, parsed.Bytes) 35 35 + | None -> Assert.Fail "TryParse should succeed for valid CID" 36 36 + 37 37 + [<Fact>] 38 38 + let ``CID TryParse returns None for invalid`` () = 39 39 + Assert.True(Cid.TryParse("invalid").IsNone) 40 40 + Assert.True(Cid.TryParse("").IsNone) 41 41 + Assert.True(Cid.TryParse("btooshort").IsNone) 42 42 + 43 43 + [<Fact>] 21 44 let ``Can instantiate DescribeServerResponse`` () = 22 45 let response = { 23 46 availableUserDomains = [ "example.com" ] ··· 27 50 28 51 Assert.Equal("did:web:example.com", response.did) 29 52 Assert.Equal(1, response.availableUserDomains.Length) 53 53 + 54 54 + [<Fact>] 55 55 + let ``SHA-256 Hashing correct`` () = 56 56 + let input = "hello world" 57 57 + let hash = sha256Str input 58 58 + let expected = "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9" 59 59 + let actual = Hex.ToHexString(hash) 60 60 + Assert.Equal(expected, actual) 61 61 + 62 62 + [<Fact>] 63 63 + let ``ECDSA P-256 Sign and Verify`` () = 64 64 + let keyPair = generateKey P256 65 65 + let data = Encoding.UTF8.GetBytes("test message") 66 66 + let hash = sha256 data 67 67 + let signature = sign keyPair hash 68 68 + Assert.True(signature.Length = 64, "Signature should be 64 bytes (R|S)") 69 69 + 70 70 + let valid = verify keyPair hash signature 71 71 + Assert.True(valid, "Signature verification failed") 72 72 + 73 73 + [<Fact>] 74 74 + let ``ECDSA K-256 Sign and Verify`` () = 75 75 + let keyPair = generateKey K256 76 76 + let data = Encoding.UTF8.GetBytes("test k256") 77 77 + let hash = sha256 data 78 78 + let signature = sign keyPair hash 79 79 + Assert.True(signature.Length = 64, "Signature should be 64 bytes") 80 80 + 81 81 + let valid = verify keyPair hash signature 82 82 + Assert.True(valid, "Signature verification failed") 83 83 + 84 84 + [<Fact>] 85 85 + let ``Low-S Enforcement Logic`` () = 86 86 + let n = 87 87 + BigInteger("FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141", 16) // secp256k1 N 88 88 + 89 89 + let halfN = n.ShiftRight(1) 90 90 + let highS = halfN.Add(BigInteger.One) 91 91 + 92 92 + let lowS = enforceLowS highS n 93 93 + Assert.True(lowS.CompareTo halfN <= 0, "S value should be <= N/2") 94 94 + Assert.Equal(n.Subtract highS, lowS) 95 95 + 96 96 + [<Fact>] 97 97 + let ``DidDocument JSON deserialization`` () = 98 98 + let json = 99 99 + """{ 100 100 + "id": "did:web:example.com", 101 101 + "verificationMethod": [{ 102 102 + "id": "did:web:example.com#atproto", 103 103 + "type": "Multikey", 104 104 + "controller": "did:web:example.com", 105 105 + "publicKeyMultibase": "zQ3sh..." 106 106 + }] 107 107 + }""" 108 108 + 109 109 + let doc = 110 110 + JsonSerializer.Deserialize<DidDocument>(json, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 111 111 + 112 112 + Assert.Equal("did:web:example.com", doc.Id) 113 113 + Assert.Single doc.VerificationMethod |> ignore 114 114 + Assert.Equal("Multikey", doc.VerificationMethod.Head.Type) 115 115 + 116 116 + [<Fact>] 117 117 + let ``CID Generation from Hash`` () = 118 118 + let hash = 119 119 + Hex.Decode "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9" 120 120 + 121 121 + let cid = Cid.FromHash hash 122 122 + Assert.Equal<byte>(0x01uy, cid.Bytes.[0]) 123 123 + Assert.Equal<byte>(0x71uy, cid.Bytes.[1]) 124 124 + Assert.Equal<byte>(0x12uy, cid.Bytes.[2]) 125 125 + Assert.Equal<byte>(0x20uy, cid.Bytes.[3]) 126 126 + 127 127 + [<Fact>] 128 128 + let ``DAG-CBOR Canonical Sorting`` () = 129 129 + let m = Map.ofList [ "b", box 1; "a", box 2 ] 130 130 + let encoded = DagCbor.encode m 131 131 + let hex = Hex.ToHexString encoded 132 132 + Assert.Equal("a2616102616201", hex) 133 133 + 134 134 + [<Fact>] 135 135 + let ``DAG-CBOR Sorting Length vs Bytes`` () = 136 136 + let m = Map.ofList [ "aa", box 1; "b", box 2 ] 137 137 + let encoded = DagCbor.encode m 138 138 + let hex = Hex.ToHexString encoded 139 139 + Assert.Equal("a261620262616101", hex)

+115 -14

README.md

··· 1 1 + <!-- markdownlint-disable MD033 --> 1 2 # PDSharp 2 3 3 3 - > A Personal Data Server (PDS) for the AT Protocol, written in F# with Giraffe. 4 4 + A Personal Data Server (PDS) for the AT Protocol, written in F# with Giraffe. 4 5 5 6 ## Goal 6 7 ··· 8 9 9 10 ## Requirements 10 11 11 11 - - .NET 9.0 SDK 12 12 - - [Just](https://github.com/casey/just) (optional, for potential future task running) 12 12 + .NET 9.0 SDK 13 13 14 14 ## Getting Started 15 15 ··· 34 34 35 35 The server will start at `http://localhost:5000`. 36 36 37 37 - ### Verify 38 38 - 39 39 - Check the `describeServer` endpoint: 40 40 - 41 41 - ```bash 42 42 - curl http://localhost:5000/xrpc/com.atproto.server.describeServer 43 43 - ``` 44 44 - 45 37 ## Configuration 46 38 47 39 The application uses `appsettings.json` and supports Environment Variable overrides. ··· 60 52 } 61 53 ``` 62 54 55 55 + ## API Testing 56 56 + 57 57 + <details> 58 58 + <summary>Server Info</summary> 59 59 + 60 60 + ```bash 61 61 + curl http://localhost:5000/xrpc/com.atproto.server.describeServer 62 62 + ``` 63 63 + 64 64 + </details> 65 65 + 66 66 + ### Record Operations 67 67 + 68 68 + <details> 69 69 + <summary>Create a record</summary> 70 70 + 71 71 + ```bash 72 72 + curl -X POST http://localhost:5000/xrpc/com.atproto.repo.createRecord \ 73 73 + -H "Content-Type: application/json" \ 74 74 + -d '{"repo":"did:web:test","collection":"app.bsky.feed.post","record":{"text":"Hello, ATProto!"}}' 75 75 + ``` 76 76 + 77 77 + </details> 78 78 + 79 79 + <details> 80 80 + <summary>Get a record</summary> 81 81 + 82 82 + ```bash 83 83 + curl "http://localhost:5000/xrpc/com.atproto.repo.getRecord?repo=did:web:test&collection=app.bsky.feed.post&rkey=<RKEY>" 84 84 + ``` 85 85 + 86 86 + </details> 87 87 + 88 88 + <details> 89 89 + <summary>Put a record</summary> 90 90 + 91 91 + ```bash 92 92 + curl -X POST http://localhost:5000/xrpc/com.atproto.repo.putRecord \ 93 93 + -H "Content-Type: application/json" \ 94 94 + -d '{"repo":"did:web:test","collection":"app.bsky.feed.post","rkey":"my-post","record":{"text":"Updated!"}}' 95 95 + ``` 96 96 + 97 97 + </details> 98 98 + 99 99 + ### Sync & CAR Export 100 100 + 101 101 + <details> 102 102 + <summary>Get entire repository as CAR</summary> 103 103 + 104 104 + ```bash 105 105 + curl "http://localhost:5000/xrpc/com.atproto.sync.getRepo?did=did:web:test" -o repo.car 106 106 + ``` 107 107 + 108 108 + </details> 109 109 + 110 110 + <details> 111 111 + <summary>Get specific blocks</summary> 112 112 + 113 113 + ```bash 114 114 + curl "http://localhost:5000/xrpc/com.atproto.sync.getBlocks?did=did:web:test&cids=<CID1>,<CID2>" -o blocks.car 115 115 + ``` 116 116 + 117 117 + </details> 118 118 + 119 119 + <details> 120 120 + <summary>Get a blob by CID</summary> 121 121 + 122 122 + ```bash 123 123 + curl "http://localhost:5000/xrpc/com.atproto.sync.getBlob?did=did:web:test&cid=<BLOB_CID>" 124 124 + ``` 125 125 + 126 126 + </details> 127 127 + 128 128 + ### Firehose (WebSocket) 129 129 + 130 130 + Subscribe to real-time commit events using [websocat](https://github.com/vi/websocat): 131 131 + 132 132 + <details> 133 133 + <summary>Open a WebSocket connection</summary> 134 134 + 135 135 + ```bash 136 136 + websocat ws://localhost:5000/xrpc/com.atproto.sync.subscribeRepos 137 137 + ``` 138 138 + 139 139 + </details> 140 140 + 141 141 + <br /> 142 142 + Then create/update records in another terminal to see CBOR-encoded commit events stream in real-time. 143 143 + 144 144 + <br /> 145 145 + 146 146 + <details> 147 147 + <summary>Open a WebSocket connection with cursor for resumption</summary> 148 148 + 149 149 + ```bash 150 150 + websocat "ws://localhost:5000/xrpc/com.atproto.sync.subscribeRepos?cursor=5" 151 151 + ``` 152 152 + 153 153 + </details> 154 154 + 63 155 ## Architecture 64 156 65 65 - ### App (Giraffe) 157 157 + <details> 158 158 + <summary>App (Giraffe)</summary> 66 159 67 160 - `XrpcRouter`: `/xrpc/<NSID>` routing 68 161 - `Auth`: Session management (JWTs) 69 162 - `RepoApi`: Write/Read records (`putRecord`, `getRecord`) 70 163 - `ServerApi`: Server meta (`describeServer`) 71 164 72 72 - ### Core (Pure F#) 165 165 + </details> 166 166 + 167 167 + <details> 168 168 + <summary>Core (Pure F#)</summary> 73 169 74 170 - `DidResolver`: Identity resolution 75 171 - `RepoEngine`: MST, DAG-CBOR, CIDs, Blocks 76 172 - `Models`: Data types for XRPC/Database 77 173 78 78 - ### Infra 174 174 + </details> 175 175 + 176 176 + <details> 177 177 + <summary>Infra</summary> 79 178 80 179 - SQLite/Postgres for persistence 81 180 - S3/Disk for blob storage 181 181 + 182 182 + </details>

+59 -44

roadmap.txt

··· 11 11 -------------------------------------------------------------------------------- 12 12 Milestone B: Identity + Crypto Primitives 13 13 -------------------------------------------------------------------------------- 14 14 - - DID document fetch/parse for signing key and PDS endpoint 15 15 - - SHA-256 hashing, ECDSA sign/verify (p256 + k256), low-S enforcement 14 14 + - [x] DID document fetch/parse for signing key and PDS endpoint 15 15 + - [x] SHA-256 hashing, ECDSA sign/verify (p256 + k256), low-S enforcement 16 16 DoD: Sign and verify atproto commit hash with low-S 17 17 -------------------------------------------------------------------------------- 18 18 Milestone C: DAG-CBOR + CID 19 19 -------------------------------------------------------------------------------- 20 20 - - Canonical DAG-CBOR encode/decode with IPLD link tagging 21 21 - - CID creation/parsing (multicodec dag-cbor, sha2-256) 20 20 + - [x] Canonical DAG-CBOR encode/decode with IPLD link tagging 21 21 + - [x] CID creation/parsing (multicodec dag-cbor, sha2-256) 22 22 DoD: Record JSON → stable DAG-CBOR bytes → deterministic CID 23 23 -------------------------------------------------------------------------------- 24 24 Milestone D: MST Implementation 25 25 -------------------------------------------------------------------------------- 26 26 - - Merkle Search Tree per repository spec 27 27 - - Key depth = leading zero bits in SHA-256(key) counted in 2-bit chunks 28 28 - - Node encoding: (l, e[p,k,v,t]) with key prefix compression 26 26 + - [x] Merkle Search Tree per repository spec 27 27 + - [x] Key depth = leading zero bits in SHA-256(key) counted in 2-bit chunks 28 28 + - [x] Node encoding: (l, e[p,k,v,t]) with key prefix compression 29 29 DoD: Insert/update/delete yields reproducible root CID 30 30 -------------------------------------------------------------------------------- 31 31 Milestone E: Commit + BlockStore + putRecord 32 32 -------------------------------------------------------------------------------- 33 33 - - BlockStore: cid → bytes, indexed by DID/rev/head 34 34 - - Commit signing: UnsignedCommit → DAG-CBOR → sha256 → ECDSA sign 35 35 - - Implement com.atproto.repo.putRecord/createRecord 33 33 + - [x] BlockStore: cid → bytes, indexed by DID/rev/head 34 34 + - [x] Commit signing: UnsignedCommit → DAG-CBOR → sha256 → ECDSA sign 35 35 + - [x] Implement com.atproto.repo.putRecord/createRecord 36 36 DoD: Write and read records by path/AT-URI 37 37 -------------------------------------------------------------------------------- 38 38 Milestone F: CAR Export + Sync Endpoints 39 39 -------------------------------------------------------------------------------- 40 40 - - CARv1 writer (roots = commit CID, blocks stream) 41 41 - - Implement: sync.getRepo, sync.getBlocks, sync.getBlob 40 40 + - [x] CARv1 writer (roots = commit CID, blocks stream) 41 41 + - [x] Implement: sync.getRepo, sync.getBlocks, sync.getBlob 42 42 DoD: External services can fetch repo snapshot + blocks 43 43 -------------------------------------------------------------------------------- 44 44 Milestone G: subscribeRepos Firehose 45 45 -------------------------------------------------------------------------------- 46 46 - - Monotonic sequence number + commit event generation 47 47 - - WebSocket streaming for subscribeRepos 46 46 + - [x] Monotonic sequence number + commit event generation 47 47 + - [x] WebSocket streaming for subscribeRepos 48 48 DoD: Relay/client receives commit events after writes 49 49 -------------------------------------------------------------------------------- 50 50 Milestone H: Account + Sessions 51 51 -------------------------------------------------------------------------------- 52 52 - - Implement: server.createAccount, server.createSession, refreshSession 53 53 - - Password/app-password hashing + JWT issuance 52 52 + - [x] Implement: server.createAccount, server.createSession, refreshSession 53 53 + - [x] Password/app-password hashing + JWT issuance 54 54 DoD: Authenticate and write records with accessJwt 55 55 -------------------------------------------------------------------------------- 56 56 Milestone I: Lexicon Validation + Conformance 57 57 -------------------------------------------------------------------------------- 58 58 - - Lexicon validation for writes (app.bsky.* records) 59 59 - - Conformance testing: diff CIDs/CARs/signatures vs reference PDS 58 58 + - [x] Lexicon validation for writes (app.bsky.* records) 59 59 + - [x] Conformance testing: diff CIDs/CARs/signatures vs reference PDS 60 60 DoD: Same inputs → same outputs for repo/sync surfaces 61 61 + -------------------------------------------------------------------------------- 62 62 + Milestone J: Storage Backend Configuration 63 63 + -------------------------------------------------------------------------------- 64 64 + - [x] Configure SQLite WAL mode (PDS_SQLITE_DISABLE_WAL_AUTO_CHECKPOINT=true) 65 65 + - [x] Implement S3-compatible blobstore adapter (optional via config) 66 66 + - [x] Configure disk-based vs S3-based blob storage selection 67 67 + DoD: PDS runs with S3 blobs (if configured) and SQLite passes Litestream checks 68 68 + -------------------------------------------------------------------------------- 69 69 + Milestone K: Backup Automation + Guardrails 70 70 + -------------------------------------------------------------------------------- 71 71 + - [ ] Implement BackupOps module (scheduler/cron logic) 72 72 + - [ ] Automated backup jobs: 73 73 + - [ ] Databases (Litestream or raw copy) + /pds/actors backup 74 74 + - [ ] Local disk blobs (if applicable) 75 75 + - [ ] Guardrails & Monitoring: 76 76 + - [x] Uptime check endpoint: /xrpc/_health with JSON status 77 77 + - [x] Alerts: "Latest backup" too old, Disk pressure > 90% 78 78 + - [ ] Log retention policies 79 79 + DoD: 80 80 + - Backups run automatically and report status 81 81 + - Health checks indicate system state 82 82 + - Restore drill: Restore backups onto a fresh host passes verification 83 83 + - Backup set is explicitly documented 61 84 ================================================================================ 62 85 PHASE 2: DEPLOYMENT (Self-Host) 63 86 ================================================================================ 64 64 - Milestone J: Topology + Domain Planning 87 87 + Milestone L: Topology + Domain Planning 65 88 -------------------------------------------------------------------------------- 66 89 - Choose PDS hostname (pds.example.com) vs handle domain (example.com) 67 90 - Obtain domain, DNS access, VPS with static IP, reverse proxy 68 91 DoD: Clear plan for PDS location, handle, and DID resolution 69 92 -------------------------------------------------------------------------------- 70 70 - Milestone K: DNS + TLS + Reverse Proxy 93 93 + Milestone M: DNS + TLS + Reverse Proxy 71 94 -------------------------------------------------------------------------------- 72 95 - DNS A/AAAA records for PDS hostname 73 73 - - TLS certs (ACME) via Caddy/Nginx/Traefik 96 96 + - TLS certs (ACME) via Caddy 74 97 DoD: https://<pds-hostname> responds with valid cert 75 98 -------------------------------------------------------------------------------- 76 76 - Milestone L: Deploy PDSharp 99 99 + Milestone N: Deploy PDSharp 77 100 -------------------------------------------------------------------------------- 78 101 - Deploy built PDS with persistence (SQLite/Postgres + blob storage) 79 102 - Verify /xrpc/com.atproto.server.describeServer 80 103 DoD: describeServer returns capabilities payload 81 104 -------------------------------------------------------------------------------- 82 82 - Milestone M: Account Creation 105 105 + Milestone O: Account Creation 83 106 -------------------------------------------------------------------------------- 84 107 - Create account using admin tooling 85 108 - Verify authentication: createSession 86 109 DoD: Obtain session and perform authenticated write 87 110 -------------------------------------------------------------------------------- 88 88 - Milestone N: Smoke Test Repo + Blobs 111 111 + Milestone P: Smoke Test Repo + Blobs 89 112 -------------------------------------------------------------------------------- 90 113 - Write record via putRecord 91 114 - Upload blob, verify retrieval via sync.getBlob 92 115 DoD: Posts appear in clients, media loads reliably 93 116 -------------------------------------------------------------------------------- 94 94 - Milestone O: Account Migration (Optional) 117 117 + Milestone Q: Account Migration 95 118 -------------------------------------------------------------------------------- 96 119 - Export/import from bsky.social 97 120 - Update DID service endpoint 98 121 - Verify handle/DID resolution 99 122 DoD: Handle unchanged, DID points to your PDS 100 123 -------------------------------------------------------------------------------- 101 101 - Milestone P: Reliability 102 102 - -------------------------------------------------------------------------------- 103 103 - - Backups: repo storage + database + blobs 104 104 - - Restore drill on fresh instance 105 105 - - Monitoring: uptime checks for describeServer + getBlob 106 106 - DoD: Restore from backup passes smoke tests 107 107 - -------------------------------------------------------------------------------- 108 108 - Milestone Q: Updates + Security 124 124 + Milestone R: Updates + Security 109 125 -------------------------------------------------------------------------------- 110 126 - Update cadence with rollback plan 111 127 - Rate limits and access controls at proxy 112 112 - - Log retention and disk growth alerts 113 128 DoD: Update smoothly, maintain stable federation 114 129 ================================================================================ 115 130 QUICK CHECKLIST 116 131 ================================================================================ 117 117 - [ ] describeServer endpoint working 118 118 - [ ] Crypto primitives (sha256, ECDSA p256/k256, low-S) 119 119 - [ ] DAG-CBOR + CID generation correct 120 120 - [ ] MST producing deterministic root CIDs 121 121 - [ ] putRecord + blockstore operational 122 122 - [ ] CAR export + sync endpoints 123 123 - [ ] subscribeRepos firehose 124 124 - [ ] Authentication (createAccount, createSession) 125 125 - [ ] Lexicon validation 132 132 + [x] describeServer endpoint working 133 133 + [x] Crypto primitives (sha256, ECDSA p256/k256, low-S) 134 134 + [x] DAG-CBOR + CID generation correct 135 135 + [x] MST producing deterministic root CIDs 136 136 + [x] putRecord + blockstore operational 137 137 + [x] CAR export + sync endpoints 138 138 + [x] subscribeRepos firehose 139 139 + [x] Authentication (createAccount, createSession) 140 140 + [x] Lexicon validation 126 141 [ ] Domain + TLS configured 127 142 [ ] PDS deployed and reachable 128 143 [ ] Account created, session works 129 144 [ ] Writes + blobs verified 130 130 - [ ] Backups + monitoring in place 145 145 + [/] Backups + monitoring in place (health endpoint done, backup automation pending) 131 146 ================================================================================ 132 147 REFERENCES 133 148 ================================================================================