feat: define persistence contracts and implementations, · desertthunder.dev/PDSharp@7c3c906

+3 -1

.gitignore

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

+34 -32

PDSharp.Core/Auth.fs

··· 177 177 CreatedAt : DateTimeOffset 178 178 } 179 179 180 - let mutable private accounts : Map<string, Account> = Map.empty 181 - let mutable private handleIndex : Map<string, string> = Map.empty 180 + /// Interface for account persistence 181 + type IAccountStore = 182 + abstract member CreateAccount : Account -> Async<Result<unit, string>> 183 + abstract member GetAccountByHandle : string -> Async<Account option> 184 + abstract member GetAccountByDid : string -> Async<Account option> 182 185 183 - let createAccount (handle : string) (password : string) (email : string option) : Result<Account, string> = 184 - if Map.containsKey handle handleIndex then 185 - Error "Handle already taken" 186 - else 187 - let did = $"did:web:{handle}" 186 + /// Create a new account 187 + let createAccount 188 + (store : IAccountStore) 189 + (handle : string) 190 + (password : string) 191 + (email : string option) 192 + : Async<Result<Account, string>> = 193 + async { 194 + let! existingHandle = store.GetAccountByHandle handle 188 195 189 - if Map.containsKey did accounts then 190 - Error "Account already exists" 191 - else 192 - let account = { 193 - Did = did 194 - Handle = handle 195 - PasswordHash = hashPassword password 196 - Email = email 197 - CreatedAt = DateTimeOffset.UtcNow 198 - } 199 - 200 - accounts <- Map.add did account accounts 201 - handleIndex <- Map.add handle did handleIndex 202 - Ok account 196 + match existingHandle with 197 + | Some _ -> return Error "Handle already taken" 198 + | None -> 199 + let did = $"did:web:{handle}" 200 + let! existingDid = store.GetAccountByDid did 203 201 204 - /// Get account by handle 205 - let getAccountByHandle (handle : string) : Account option = 206 - handleIndex 207 - |> Map.tryFind handle 208 - |> Option.bind (fun did -> Map.tryFind did accounts) 202 + match existingDid with 203 + | Some _ -> return Error "Account already exists" 204 + | None -> 205 + let account = { 206 + Did = did 207 + Handle = handle 208 + PasswordHash = hashPassword password 209 + Email = email 210 + CreatedAt = DateTimeOffset.UtcNow 211 + } 209 212 210 - /// Get account by DID 211 - let getAccountByDid (did : string) : Account option = Map.tryFind did accounts 213 + let! result = store.CreateAccount account 212 214 213 - /// Clear all accounts (for testing) 214 - let resetAccounts () = 215 - accounts <- Map.empty 216 - handleIndex <- Map.empty 215 + match result with 216 + | Ok() -> return Ok account 217 + | Error e -> return Error e 218 + }

+124

PDSharp.Core/BlobStore.fs

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

+17

PDSharp.Core/Config.fs

··· 6 6 DidHost : string 7 7 /// HS256 signing key for session tokens 8 8 JwtSecret : string 9 + /// Connection string for SQLite 10 + SqliteConnectionString : string 11 + /// Blob storage configuration 12 + BlobStore : BlobStoreConfig 13 + } 14 + 15 + and BlobStoreConfig = 16 + | Disk of path : string 17 + | S3 of S3Config 18 + 19 + and S3Config = { 20 + Bucket : string 21 + Region : string 22 + AccessKey : string option 23 + SecretKey : string option 24 + ServiceUrl : string option 25 + ForcePathStyle : bool 9 26 }

+5

PDSharp.Core/PDSharp.Core.fsproj

··· 11 11 <Compile Include="Crypto.fs" /> 12 12 <Compile Include="Mst.fs" /> 13 13 <Compile Include="BlockStore.fs" /> 14 + <Compile Include="BlobStore.fs" /> 14 15 <Compile Include="Car.fs" /> 15 16 <Compile Include="AtUri.fs" /> 16 17 <Compile Include="Repository.fs" /> 17 18 <Compile Include="Auth.fs" /> 19 + <Compile Include="SqliteStore.fs" /> 18 20 <Compile Include="Firehose.fs" /> 19 21 <Compile Include="DidResolver.fs" /> 20 22 <Compile Include="Lexicon.fs" /> ··· 22 24 </ItemGroup> 23 25 24 26 <ItemGroup> 27 + <PackageReference Include="AWSSDK.S3" Version="4.0.16" /> 25 28 <PackageReference Include="BouncyCastle.Cryptography" Version="2.6.2" /> 29 + <PackageReference Include="Dapper" Version="2.1.66" /> 30 + <PackageReference Include="Microsoft.Data.Sqlite" Version="10.0.1" /> 26 31 <PackageReference Include="System.Formats.Cbor" Version="10.0.1" /> 27 32 </ItemGroup> 28 33 </Project>

+225

PDSharp.Core/SqliteStore.fs

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

+57 -11

PDSharp.Tests/Auth.Tests.fs

··· 2 2 3 3 open Xunit 4 4 open PDSharp.Core.Auth 5 + open System 6 + open System.Collections.Concurrent 7 + 8 + /// Mock in-memory store for testing 9 + type VolatileAccountStore() = 10 + let accounts = ConcurrentDictionary<string, Account>() 11 + let handles = ConcurrentDictionary<string, string>() 12 + 13 + interface IAccountStore with 14 + member _.CreateAccount(account : Account) = async { 15 + if handles.ContainsKey(account.Handle) then 16 + return Error "Handle already taken" 17 + elif accounts.ContainsKey(account.Did) then 18 + return Error "Account already exists" 19 + else 20 + accounts.TryAdd(account.Did, account) |> ignore 21 + handles.TryAdd(account.Handle, account.Did) |> ignore 22 + return Ok() 23 + } 24 + 25 + member _.GetAccountByHandle(handle : string) = async { 26 + match handles.TryGetValue(handle) with 27 + | true, did -> 28 + match accounts.TryGetValue(did) with 29 + | true, acc -> return Some acc 30 + | _ -> return None 31 + | _ -> return None 32 + } 33 + 34 + member _.GetAccountByDid(did : string) = async { 35 + match accounts.TryGetValue(did) with 36 + | true, acc -> return Some acc 37 + | _ -> return None 38 + } 5 39 6 40 [<Fact>] 7 41 let ``Password hashing produces salt$hash format`` () = ··· 66 100 67 101 [<Fact>] 68 102 let ``Account creation and lookup by handle`` () = 69 - resetAccounts () 103 + let store = VolatileAccountStore() 70 104 71 - match createAccount "test.user" "password123" (Some "test@example.com") with 105 + match 106 + createAccount store "test.user" "password123" (Some "test@example.com") 107 + |> Async.RunSynchronously 108 + with 72 109 | Error msg -> Assert.Fail msg 73 110 | Ok account -> 74 111 Assert.Equal("test.user", account.Handle) 75 112 Assert.Equal("did:web:test.user", account.Did) 76 113 Assert.Equal(Some "test@example.com", account.Email) 77 114 78 - match getAccountByHandle "test.user" with 115 + let found = 116 + (store :> IAccountStore).GetAccountByHandle "test.user" 117 + |> Async.RunSynchronously 118 + 119 + match found with 79 120 | None -> Assert.Fail "Account should be found" 80 - | Some found -> Assert.Equal(account.Did, found.Did) 121 + | Some foundAcc -> Assert.Equal(account.Did, foundAcc.Did) 81 122 82 123 [<Fact>] 83 124 let ``Account creation fails for duplicate handle`` () = 84 - resetAccounts () 125 + let store = VolatileAccountStore() 85 126 86 - createAccount "duplicate.user" "password" None |> ignore 127 + createAccount store "duplicate.user" "password" None 128 + |> Async.RunSynchronously 129 + |> ignore 87 130 88 - match createAccount "duplicate.user" "password2" None with 131 + match createAccount store "duplicate.user" "password2" None |> Async.RunSynchronously with 89 132 | Error msg -> Assert.Contains("already", msg.ToLower()) 90 133 | Ok _ -> Assert.Fail "Should fail for duplicate handle" 91 134 92 135 [<Fact>] 93 136 let ``Account lookup by DID`` () = 94 - resetAccounts () 137 + let store = VolatileAccountStore() 95 138 96 - match createAccount "did.user" "password123" None with 139 + match createAccount store "did.user" "password123" None |> Async.RunSynchronously with 97 140 | Error msg -> Assert.Fail msg 98 141 | Ok account -> 99 - match getAccountByDid account.Did with 142 + let found = 143 + (store :> IAccountStore).GetAccountByDid account.Did |> Async.RunSynchronously 144 + 145 + match found with 100 146 | None -> Assert.Fail "Account should be found by DID" 101 - | Some found -> Assert.Equal(account.Handle, found.Handle) 147 + | Some foundAcc -> Assert.Equal(account.Handle, foundAcc.Handle)

+185

PDSharp.Tests/Handlers.Tests.fs

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

+1

PDSharp.Tests/PDSharp.Tests.fsproj

··· 15 15 <Compile Include="Firehose.Tests.fs" /> 16 16 <Compile Include="Auth.Tests.fs" /> 17 17 <Compile Include="Conformance.Tests.fs" /> 18 + <Compile Include="Handlers.Tests.fs" /> 18 19 <Compile Include="Program.fs" /> 19 20 </ItemGroup> 20 21

+2

PDSharp.Tests/Tests.fs

··· 17 17 PublicUrl = "https://example.com" 18 18 DidHost = "did:web:example.com" 19 19 JwtSecret = "test-secret-key-for-testing-only" 20 + SqliteConnectionString = "Data Source=:memory:" 21 + BlobStore = Disk "blobs" 20 22 } 21 23 22 24 Assert.Equal("did:web:example.com", config.DidHost)

+221

PDSharp/Handlers/Auth.fs

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

+149

PDSharp/Handlers/Common.fs

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

+261

PDSharp/Handlers/Repo.fs

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

+66

PDSharp/Handlers/Server.fs

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

+137

PDSharp/Handlers/Sync.fs

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

+6 -1

PDSharp/PDSharp.fsproj

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

+59 -848

PDSharp/Program.fs

··· 1 1 open System 2 - open System.Text 3 - open System.Text.Json 4 2 open Microsoft.AspNetCore.Builder 5 3 open Microsoft.AspNetCore.Hosting 6 - open Microsoft.AspNetCore.Http 7 4 open Microsoft.Extensions.Hosting 8 5 open Microsoft.Extensions.DependencyInjection 9 - open Microsoft.Extensions.Configuration 10 6 open Giraffe 11 7 open PDSharp.Core 12 - open PDSharp.Core.Models 13 - open PDSharp.Core.Config 14 - open PDSharp.Core.BlockStore 15 - open PDSharp.Core.Repository 16 - open PDSharp.Core.Mst 17 - open PDSharp.Core.Crypto 18 - open PDSharp.Core.Firehose 19 8 open PDSharp.Core.Auth 20 - 21 - module App = 22 - /// Repo state per DID: MST root, collections, current rev, head commit CID 23 - type RepoData = { 24 - MstRoot : MstNode 25 - Collections : Map<string, Map<string, Cid>> 26 - Rev : string 27 - Head : Cid option 28 - Prev : Cid option 29 - } 30 - 31 - let emptyRepo = { 32 - MstRoot = { Left = None; Entries = [] } 33 - Collections = Map.empty 34 - Rev = "" 35 - Head = None 36 - Prev = None 37 - } 38 - 39 - let mutable repos : Map<string, RepoData> = Map.empty 40 - let blockStore = MemoryBlockStore() 41 - let mutable signingKeys : Map<string, EcKeyPair> = Map.empty 42 - 43 - // Firehose subscriber management 44 - open System.Net.WebSockets 45 - open System.Collections.Concurrent 46 - 47 - /// Connected WebSocket subscribers 48 - let subscribers = ConcurrentDictionary<Guid, WebSocket>() 49 - 50 - /// Broadcast a commit event to all connected subscribers 51 - let broadcastEvent (event : CommitEvent) = 52 - let eventBytes = encodeEvent event 53 - let segment = ArraySegment<byte>(eventBytes) 54 - 55 - for kvp in subscribers do 56 - let ws = kvp.Value 57 - 58 - if ws.State = WebSocketState.Open then 59 - try 60 - ws.SendAsync(segment, WebSocketMessageType.Binary, true, Threading.CancellationToken.None) 61 - |> Async.AwaitTask 62 - |> Async.RunSynchronously 63 - with _ -> 64 - subscribers.TryRemove(kvp.Key) |> ignore 65 - 66 - let getOrCreateKey (did : string) = 67 - match Map.tryFind did signingKeys with 68 - | Some k -> k 69 - | None -> 70 - let k = generateKey P256 71 - signingKeys <- Map.add did k signingKeys 72 - k 9 + open PDSharp.Core.BlockStore 10 + open PDSharp.Core.SqliteStore 11 + open PDSharp.Core.BlobStore 12 + open PDSharp.Core.Config 13 + open PDSharp.Handlers 73 14 74 - let loader (c : Cid) = async { 75 - let! bytesOpt = (blockStore :> IBlockStore).Get(c) 15 + let getConfig () = 16 + let env (k : string) (def : string) = 17 + match Environment.GetEnvironmentVariable k with 18 + | null -> def 19 + | v -> v 76 20 77 - match bytesOpt with 78 - | Some bytes -> return Some(Mst.deserialize bytes) 79 - | None -> return None 80 - } 21 + let publicUrl = env "PDSHARP_PublicUrl" "http://localhost:5000" 22 + let dbPath = env "PDSHARP_DbPath" "pdsharp.db" 81 23 82 - let persister (n : MstNode) = async { 83 - let bytes = Mst.serialize n 84 - return! (blockStore :> IBlockStore).Put(bytes) 85 - } 86 - 87 - let signAndStoreCommit (did : string) (mstRootCid : Cid) (rev : string) (prev : Cid option) = async { 88 - let key = getOrCreateKey did 89 - 90 - let unsigned : UnsignedCommit = { 91 - Did = did 92 - Version = 3 93 - Data = mstRootCid 94 - Rev = rev 95 - Prev = prev 96 - } 97 - 98 - let signed = signCommit key unsigned 99 - let commitBytes = serializeCommit signed 100 - let! commitCid = (blockStore :> IBlockStore).Put(commitBytes) 101 - return signed, commitCid 24 + { 25 + PublicUrl = publicUrl 26 + DidHost = env "PDSHARP_DidHost" "did:web:localhost" 27 + JwtSecret = env "PDSHARP_JwtSecret" "development-secret-do-not-use-in-prod" 28 + SqliteConnectionString = $"Data Source={dbPath}" 29 + BlobStore = Disk "blobs" // Default to disk for now 102 30 } 103 31 104 - [<CLIMutable>] 105 - type CreateRecordRequest = { 106 - repo : string 107 - collection : string 108 - record : JsonElement 109 - rkey : string option 110 - } 111 - 112 - [<CLIMutable>] 113 - type CreateRecordResponse = { 114 - uri : string 115 - cid : string 116 - commit : {| rev : string; cid : string |} 117 - } 118 - 119 - [<CLIMutable>] 120 - type GetRecordResponse = { uri : string; cid : string; value : JsonElement } 121 - 122 - [<CLIMutable>] 123 - type ErrorResponse = { error : string; message : string } 124 - 125 - let describeServerHandler : HttpHandler = 126 - fun next ctx -> 127 - let config = ctx.GetService<AppConfig>() 128 - 129 - let response = { 130 - availableUserDomains = [] 131 - did = config.DidHost 132 - inviteCodeRequired = true 133 - } 134 - 135 - json response next ctx 136 - 137 - [<CLIMutable>] 138 - type CreateAccountRequest = { 139 - handle : string 140 - email : string option 141 - password : string 142 - inviteCode : string option 143 - } 144 - 145 - [<CLIMutable>] 146 - type CreateSessionRequest = { 147 - /// Handle or email 148 - identifier : string 149 - password : string 150 - } 151 - 152 - type SessionResponse = { 153 - accessJwt : string 154 - refreshJwt : string 155 - handle : string 156 - did : string 157 - email : string option 158 - } 159 - 160 - /// POST /xrpc/com.atproto.server.createAccount 161 - let createAccountHandler : HttpHandler = 162 - fun next ctx -> task { 163 - let config = ctx.GetService<AppConfig>() 164 - let! body = ctx.ReadBodyFromRequestAsync() 165 - 166 - let request = 167 - JsonSerializer.Deserialize<CreateAccountRequest>( 168 - body, 169 - JsonSerializerOptions(PropertyNameCaseInsensitive = true) 170 - ) 171 - 172 - if 173 - String.IsNullOrWhiteSpace(request.handle) 174 - || String.IsNullOrWhiteSpace(request.password) 175 - then 176 - ctx.SetStatusCode 400 177 - 178 - return! 179 - json 180 - { 181 - error = "InvalidRequest" 182 - message = "handle and password are required" 183 - } 184 - next 185 - ctx 186 - else 187 - match createAccount request.handle request.password request.email with 188 - | Error msg -> 189 - ctx.SetStatusCode 400 190 - return! json { error = "AccountExists"; message = msg } next ctx 191 - | Ok account -> 192 - let accessJwt = createAccessToken config.JwtSecret account.Did 193 - let refreshJwt = createRefreshToken config.JwtSecret account.Did 194 - 195 - ctx.SetStatusCode 200 196 - 197 - return! 198 - json 199 - { 200 - accessJwt = accessJwt 201 - refreshJwt = refreshJwt 202 - handle = account.Handle 203 - did = account.Did 204 - email = account.Email 205 - } 206 - next 207 - ctx 208 - } 209 - 210 - /// POST /xrpc/com.atproto.server.createSession 211 - let createSessionHandler : HttpHandler = 212 - fun next ctx -> task { 213 - let config = ctx.GetService<AppConfig>() 214 - let! body = ctx.ReadBodyFromRequestAsync() 215 - 216 - let request = 217 - JsonSerializer.Deserialize<CreateSessionRequest>( 218 - body, 219 - JsonSerializerOptions(PropertyNameCaseInsensitive = true) 220 - ) 221 - 222 - if 223 - String.IsNullOrWhiteSpace(request.identifier) 224 - || String.IsNullOrWhiteSpace(request.password) 225 - then 226 - ctx.SetStatusCode 400 227 - 228 - return! 229 - json 230 - { 231 - error = "InvalidRequest" 232 - message = "identifier and password are required" 233 - } 234 - next 235 - ctx 236 - else 237 - match getAccountByHandle request.identifier with 238 - | None -> 239 - ctx.SetStatusCode 401 240 - 241 - return! 242 - json 243 - { 244 - error = "AuthenticationRequired" 245 - message = "Invalid identifier or password" 246 - } 247 - next 248 - ctx 249 - | Some account -> 250 - if not (verifyPassword request.password account.PasswordHash) then 251 - ctx.SetStatusCode 401 252 - 253 - return! 254 - json 255 - { 256 - error = "AuthenticationRequired" 257 - message = "Invalid identifier or password" 258 - } 259 - next 260 - ctx 261 - else 262 - let accessJwt = createAccessToken config.JwtSecret account.Did 263 - let refreshJwt = createRefreshToken config.JwtSecret account.Did 264 - 265 - ctx.SetStatusCode 200 266 - 267 - return! 268 - json 269 - { 270 - accessJwt = accessJwt 271 - refreshJwt = refreshJwt 272 - handle = account.Handle 273 - did = account.Did 274 - email = account.Email 275 - } 276 - next 277 - ctx 278 - } 279 - 280 - /// Extract Bearer token from Authorization header 281 - let private extractBearerToken (ctx : HttpContext) : string option = 282 - match ctx.Request.Headers.TryGetValue("Authorization") with 283 - | true, values -> 284 - let header = values.ToString() 32 + let config = getConfig () 285 33 286 - if header.StartsWith("Bearer ", StringComparison.OrdinalIgnoreCase) then 287 - Some(header.Substring(7)) 288 - else 289 - None 290 - | _ -> None 34 + SqliteStore.initialize config.SqliteConnectionString 291 35 292 - /// POST /xrpc/com.atproto.server.refreshSession 293 - let refreshSessionHandler : HttpHandler = 294 - fun next ctx -> task { 295 - let config = ctx.GetService<AppConfig>() 296 - 297 - match extractBearerToken ctx with 298 - | None -> 299 - ctx.SetStatusCode 401 300 - 301 - return! 302 - json 303 - { 304 - error = "AuthenticationRequired" 305 - message = "Missing or invalid Authorization header" 306 - } 307 - next 308 - ctx 309 - | Some token -> 310 - match validateToken config.JwtSecret token with 311 - | Invalid reason -> 312 - ctx.SetStatusCode 401 313 - return! json { error = "ExpiredToken"; message = reason } next ctx 314 - | Valid(did, tokenType, _) -> 315 - if tokenType <> Refresh then 316 - ctx.SetStatusCode 400 317 - 318 - return! 319 - json 320 - { 321 - error = "InvalidRequest" 322 - message = "Refresh token required" 323 - } 324 - next 325 - ctx 326 - else 327 - match getAccountByDid did with 328 - | None -> 329 - ctx.SetStatusCode 401 330 - return! json { error = "AccountNotFound"; message = "Account not found" } next ctx 331 - | Some account -> 332 - let accessJwt = createAccessToken config.JwtSecret account.Did 333 - let refreshJwt = createRefreshToken config.JwtSecret account.Did 334 - 335 - ctx.SetStatusCode 200 336 - 337 - return! 338 - json 339 - { 340 - accessJwt = accessJwt 341 - refreshJwt = refreshJwt 342 - handle = account.Handle 343 - did = account.Did 344 - email = account.Email 345 - } 346 - next 347 - ctx 348 - } 349 - 350 - let createRecordHandler : HttpHandler = 351 - fun next ctx -> task { 352 - let! body = ctx.ReadBodyFromRequestAsync() 353 - 354 - let request = 355 - JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 356 - 357 - match Lexicon.validate request.collection request.record with 358 - | Lexicon.Error msg -> 359 - ctx.SetStatusCode 400 360 - return! json { error = "InvalidRequest"; message = msg } next ctx 361 - | Lexicon.Ok -> 362 - let did = request.repo 363 - 364 - let rkey = 365 - match request.rkey with 366 - | Some r when not (String.IsNullOrWhiteSpace(r)) -> r 367 - | _ -> Tid.generate () 368 - 369 - let recordJson = request.record.GetRawText() 370 - let recordBytes = Encoding.UTF8.GetBytes(recordJson) 371 - let! recordCid = (blockStore :> IBlockStore).Put(recordBytes) 372 - 373 - let repoData = Map.tryFind did repos |> Option.defaultValue emptyRepo 374 - let mstKey = $"{request.collection}/{rkey}" 375 - 376 - let! newMstRoot = Mst.put loader persister repoData.MstRoot mstKey recordCid "" 377 - let! mstRootCid = persister newMstRoot 378 - 379 - let newRev = Tid.generate () 380 - let! (_, commitCid) = signAndStoreCommit did mstRootCid newRev repoData.Head 381 - 382 - let collectionMap = 383 - Map.tryFind request.collection repoData.Collections 384 - |> Option.defaultValue Map.empty 385 - 386 - let newCollectionMap = Map.add rkey recordCid collectionMap 387 - 388 - let newCollections = 389 - Map.add request.collection newCollectionMap repoData.Collections 390 - 391 - let updatedRepo = { 392 - MstRoot = newMstRoot 393 - Collections = newCollections 394 - Rev = newRev 395 - Head = Some commitCid 396 - Prev = repoData.Head 397 - } 398 - 399 - repos <- Map.add did updatedRepo repos 400 - 401 - let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData() 402 - let carBytes = Car.createCar [ commitCid ] allBlocks 403 - let event = createCommitEvent did newRev commitCid carBytes 404 - broadcastEvent event 405 - 406 - let uri = $"at://{did}/{request.collection}/{rkey}" 407 - ctx.SetStatusCode 200 408 - 409 - return! 410 - json 411 - {| 412 - uri = uri 413 - cid = recordCid.ToString() 414 - commit = {| rev = newRev; cid = commitCid.ToString() |} 415 - |} 416 - next 417 - ctx 418 - } 419 - 420 - let getRecordHandler : HttpHandler = 421 - fun next ctx -> task { 422 - let repo = ctx.Request.Query.["repo"].ToString() 423 - let collection = ctx.Request.Query.["collection"].ToString() 424 - let rkey = ctx.Request.Query.["rkey"].ToString() 425 - 426 - if 427 - String.IsNullOrWhiteSpace(repo) 428 - || String.IsNullOrWhiteSpace(collection) 429 - || String.IsNullOrWhiteSpace(rkey) 430 - then 431 - ctx.SetStatusCode 400 432 - 433 - return! 434 - json 435 - { 436 - error = "InvalidRequest" 437 - message = "Missing required query parameters: repo, collection, rkey" 438 - } 439 - next 440 - ctx 441 - else 442 - match Map.tryFind repo repos with 443 - | None -> 444 - ctx.SetStatusCode 404 445 - 446 - return! 447 - json 448 - { 449 - error = "RepoNotFound" 450 - message = $"Repository not found: {repo}" 451 - } 452 - next 453 - ctx 454 - | Some repoData -> 455 - match Map.tryFind collection repoData.Collections with 456 - | None -> 457 - ctx.SetStatusCode 404 458 - 459 - return! 460 - json 461 - { 462 - error = "RecordNotFound" 463 - message = $"Collection not found: {collection}" 464 - } 465 - next 466 - ctx 467 - | Some collectionMap -> 468 - match Map.tryFind rkey collectionMap with 469 - | None -> 470 - ctx.SetStatusCode 404 471 - 472 - return! 473 - json 474 - { 475 - error = "RecordNotFound" 476 - message = $"Record not found: {rkey}" 477 - } 478 - next 479 - ctx 480 - | Some recordCid -> 481 - let! recordBytesOpt = (blockStore :> IBlockStore).Get(recordCid) 482 - 483 - match recordBytesOpt with 484 - | None -> 485 - ctx.SetStatusCode 500 486 - 487 - return! 488 - json 489 - { 490 - error = "InternalError" 491 - message = "Block not found in store" 492 - } 493 - next 494 - ctx 495 - | Some recordBytes -> 496 - let recordJson = Encoding.UTF8.GetString(recordBytes) 497 - let uri = $"at://{repo}/{collection}/{rkey}" 498 - let valueElement = JsonSerializer.Deserialize<JsonElement>(recordJson) 499 - ctx.SetStatusCode 200 500 - 501 - return! 502 - json 503 - {| 504 - uri = uri 505 - cid = recordCid.ToString() 506 - value = valueElement 507 - |} 508 - next 509 - ctx 510 - } 511 - 512 - let putRecordHandler : HttpHandler = 513 - fun next ctx -> task { 514 - let! body = ctx.ReadBodyFromRequestAsync() 515 - 516 - let request = 517 - JsonSerializer.Deserialize<CreateRecordRequest>(body, JsonSerializerOptions(PropertyNameCaseInsensitive = true)) 518 - 519 - match Lexicon.validate request.collection request.record with 520 - | Lexicon.Error msg -> 521 - ctx.SetStatusCode 400 522 - return! json { error = "InvalidRequest"; message = msg } next ctx 523 - | Lexicon.Ok -> 524 - match request.rkey with 525 - | Some r when not (String.IsNullOrWhiteSpace r) -> 526 - let did = request.repo 527 - let recordJson = request.record.GetRawText() 528 - let recordBytes = Encoding.UTF8.GetBytes(recordJson) 529 - let! recordCid = (blockStore :> IBlockStore).Put(recordBytes) 530 - 531 - let repoData = Map.tryFind did repos |> Option.defaultValue emptyRepo 532 - let mstKey = $"{request.collection}/{r}" 533 - 534 - let! newMstRoot = Mst.put loader persister repoData.MstRoot mstKey recordCid "" 535 - let! mstRootCid = persister newMstRoot 536 - 537 - let newRev = Tid.generate () 538 - let! (_, commitCid) = signAndStoreCommit did mstRootCid newRev repoData.Head 539 - 540 - let collectionMap = 541 - Map.tryFind request.collection repoData.Collections 542 - |> Option.defaultValue Map.empty 543 - 544 - let newCollectionMap = Map.add r recordCid collectionMap 545 - 546 - let newCollections = 547 - Map.add request.collection newCollectionMap repoData.Collections 548 - 549 - let updatedRepo = { 550 - MstRoot = newMstRoot 551 - Collections = newCollections 552 - Rev = newRev 553 - Head = Some commitCid 554 - Prev = repoData.Head 555 - } 556 - 557 - repos <- Map.add did updatedRepo repos 558 - 559 - let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData() 560 - let carBytes = Car.createCar [ commitCid ] allBlocks 561 - let event = createCommitEvent did newRev commitCid carBytes 562 - broadcastEvent event 563 - 564 - ctx.SetStatusCode 200 565 - 566 - return! 567 - json 568 - {| 569 - uri = $"at://{did}/{request.collection}/{r}" 570 - cid = recordCid.ToString() 571 - commit = {| rev = newRev; cid = commitCid.ToString() |} 572 - |} 573 - next 574 - ctx 575 - | _ -> 576 - ctx.SetStatusCode 400 577 - 578 - return! 579 - json 580 - { 581 - error = "InvalidRequest" 582 - message = "rkey is required for putRecord" 583 - } 584 - next 585 - ctx 586 - } 587 - 588 - /// sync.getRepo: Export entire repository as CAR file 589 - let getRepoHandler : HttpHandler = 590 - fun next ctx -> task { 591 - let did = ctx.Request.Query.["did"].ToString() 592 - 593 - if String.IsNullOrWhiteSpace(did) then 594 - ctx.SetStatusCode 400 595 - 596 - return! 597 - json 598 - { 599 - error = "InvalidRequest" 600 - message = "Missing required query parameter: did" 601 - } 602 - next 603 - ctx 604 - else 605 - match Map.tryFind did repos with 606 - | None -> 607 - ctx.SetStatusCode 404 608 - 609 - return! 610 - json 611 - { 612 - error = "RepoNotFound" 613 - message = $"Repository not found: {did}" 614 - } 615 - next 616 - ctx 617 - | Some repoData -> 618 - match repoData.Head with 619 - | None -> 620 - ctx.SetStatusCode 404 621 - 622 - return! 623 - json 624 - { 625 - error = "RepoNotFound" 626 - message = "Repository has no commits" 627 - } 628 - next 629 - ctx 630 - | Some headCid -> 631 - let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData() 632 - let carBytes = Car.createCar [ headCid ] allBlocks 633 - ctx.SetContentType "application/vnd.ipld.car" 634 - ctx.SetStatusCode 200 635 - return! ctx.WriteBytesAsync carBytes 636 - } 637 - 638 - /// sync.getBlocks: Fetch specific blocks by CID 639 - let getBlocksHandler : HttpHandler = 640 - fun next ctx -> task { 641 - let did = ctx.Request.Query.["did"].ToString() 642 - let cidsParam = ctx.Request.Query.["cids"].ToString() 643 - 644 - if String.IsNullOrWhiteSpace did || String.IsNullOrWhiteSpace cidsParam then 645 - ctx.SetStatusCode 400 646 - 647 - return! 648 - json 649 - { 650 - error = "InvalidRequest" 651 - message = "Missing required query parameters: did, cids" 652 - } 653 - next 654 - ctx 655 - else 656 - match Map.tryFind did repos with 657 - | None -> 658 - ctx.SetStatusCode 404 659 - 660 - return! 661 - json 662 - { 663 - error = "RepoNotFound" 664 - message = $"Repository not found: {did}" 665 - } 666 - next 667 - ctx 668 - | Some _ -> 669 - let cidStrs = cidsParam.Split(',') |> Array.map (fun s -> s.Trim()) 670 - let parsedCids = cidStrs |> Array.choose Cid.TryParse |> Array.toList 671 - let! allBlocks = (blockStore :> IBlockStore).GetAllCidsAndData() 672 - 673 - let filteredBlocks = 674 - if parsedCids.IsEmpty then 675 - allBlocks 676 - else 677 - allBlocks 678 - |> List.filter (fun (c, _) -> parsedCids |> List.exists (fun pc -> pc.Bytes = c.Bytes)) 679 - 680 - let roots = 681 - if filteredBlocks.Length > 0 then 682 - [ fst filteredBlocks.[0] ] 683 - else 684 - [] 685 - 686 - let carBytes = Car.createCar roots filteredBlocks 687 - ctx.SetContentType "application/vnd.ipld.car" 688 - ctx.SetStatusCode 200 689 - return! ctx.WriteBytesAsync carBytes 690 - } 691 - 692 - /// sync.getBlob: Fetch a blob by CID 693 - let getBlobHandler : HttpHandler = 694 - fun next ctx -> task { 695 - let did = ctx.Request.Query.["did"].ToString() 696 - let cidStr = ctx.Request.Query.["cid"].ToString() 697 - 698 - if String.IsNullOrWhiteSpace(did) || String.IsNullOrWhiteSpace(cidStr) then 699 - ctx.SetStatusCode 400 700 - 701 - return! 702 - json 703 - { 704 - error = "InvalidRequest" 705 - message = "Missing required query parameters: did, cid" 706 - } 707 - next 708 - ctx 709 - else 710 - match Map.tryFind did repos with 711 - | None -> 712 - ctx.SetStatusCode 404 713 - 714 - return! 715 - json 716 - { 717 - error = "RepoNotFound" 718 - message = $"Repository not found: {did}" 719 - } 720 - next 721 - ctx 722 - | Some _ -> 723 - match Cid.TryParse cidStr with 724 - | None -> 725 - ctx.SetStatusCode 400 726 - 727 - return! 728 - json 729 - { 730 - error = "InvalidRequest" 731 - message = $"Invalid CID format: {cidStr}" 732 - } 733 - next 734 - ctx 735 - | Some cid -> 736 - let! dataOpt = (blockStore :> IBlockStore).Get(cid) 737 - 738 - match dataOpt with 739 - | None -> 740 - ctx.SetStatusCode 404 741 - 742 - return! 743 - json 744 - { 745 - error = "BlobNotFound" 746 - message = $"Blob not found: {cidStr}" 747 - } 748 - next 749 - ctx 750 - | Some data -> 751 - ctx.SetContentType "application/octet-stream" 752 - ctx.SetStatusCode 200 753 - return! ctx.WriteBytesAsync data 754 - } 755 - 756 - /// subscribeRepos: WebSocket firehose endpoint 757 - let subscribeReposHandler : HttpHandler = 758 - fun next ctx -> task { 759 - if ctx.WebSockets.IsWebSocketRequest then 760 - let cursor = 761 - match ctx.Request.Query.TryGetValue("cursor") with 762 - | true, v when not (String.IsNullOrWhiteSpace(v.ToString())) -> 763 - Int64.TryParse(v.ToString()) 764 - |> function 765 - | true, n -> Some n 766 - | _ -> None 767 - | _ -> None 768 - 769 - let! webSocket = ctx.WebSockets.AcceptWebSocketAsync() 770 - let id = Guid.NewGuid() 771 - subscribers.TryAdd(id, webSocket) |> ignore 772 - 773 - let buffer = Array.zeroCreate<byte> 1024 774 - 775 - try 776 - let mutable loop = true 777 - 778 - while loop && webSocket.State = WebSocketState.Open do 779 - let! result = webSocket.ReceiveAsync(ArraySegment(buffer), Threading.CancellationToken.None) 780 - 781 - if result.MessageType = WebSocketMessageType.Close then 782 - loop <- false 783 - finally 784 - subscribers.TryRemove(id) |> ignore 785 - 786 - if webSocket.State = WebSocketState.Open then 787 - webSocket.CloseAsync(WebSocketCloseStatus.NormalClosure, "Closed", Threading.CancellationToken.None) 788 - |> Async.AwaitTask 789 - |> Async.RunSynchronously 790 - 791 - return Some ctx 792 - else 793 - ctx.SetStatusCode 400 794 - 795 - return! 796 - json 797 - { 798 - error = "InvalidRequest" 799 - message = "WebSocket upgrade required" 800 - } 801 - next 802 - ctx 803 - } 804 - 805 - let indexHandler : HttpHandler = 806 - fun next ctx -> 807 - let html = 808 - """<html> 809 - <head><title>PDSharp</title></head> 810 - <body> 811 - <pre> 812 - 888 888 8888888888 888 888 813 - 888 888 888 888 888 814 - 888 888 888 888888888888 815 - 8888b. 888888 88888b. 888d888 .d88b. 888888 .d88b. 88 8888888 888 888 816 - "88b 888 888 "88b 888P" d88""88b 888 d88""88b 888888 888 888 888 817 - .d888888 888 888 888 888 888 888 888 888 888 88 888 888888888888 818 - 888 888 Y88b. 888 d88P 888 Y88..88P Y88b. Y88..88P 888 888 888 819 - "Y888888 "Y888 88888P" 888 "Y88P" "Y888 "Y88P" 888 888 888 820 - 888 821 - 888 822 - 888 823 - 824 - 825 - This is an AT Protocol Personal Data Server (aka, an atproto PDS) 826 - 827 - Most API routes are under /xrpc/ 828 - 829 - Code: https://github.com/bluesky-social/atproto 830 - https://github.com/stormlightlabs/PDSharp 831 - https://tangled.org/desertthunder.dev/PDSharp 832 - Self-Host: https://github.com/bluesky-social/pds 833 - Protocol: https://atproto.com 834 - </pre> 835 - </body> 836 - </html>""" 837 - 838 - ctx.SetContentType "text/html" 839 - ctx.SetStatusCode 200 840 - ctx.WriteStringAsync html 841 - 36 + module App = 842 37 let webApp = 843 38 choose [ 844 39 GET 845 40 >=> choose [ 846 - route "/" >=> indexHandler 847 - route "/xrpc/com.atproto.server.describeServer" >=> describeServerHandler 41 + route "/" >=> Server.indexHandler 42 + route "/xrpc/com.atproto.server.describeServer" >=> Server.describeServerHandler 848 43 ] 849 - POST >=> route "/xrpc/com.atproto.server.createAccount" >=> createAccountHandler 850 - POST >=> route "/xrpc/com.atproto.server.createSession" >=> createSessionHandler 44 + POST 45 + >=> route "/xrpc/com.atproto.server.createAccount" 46 + >=> Auth.createAccountHandler 47 + POST 48 + >=> route "/xrpc/com.atproto.server.createSession" 49 + >=> Auth.createSessionHandler 851 50 POST 852 51 >=> route "/xrpc/com.atproto.server.refreshSession" 853 - >=> refreshSessionHandler 854 - POST >=> route "/xrpc/com.atproto.repo.createRecord" >=> createRecordHandler 855 - GET >=> route "/xrpc/com.atproto.repo.getRecord" >=> getRecordHandler 856 - POST >=> route "/xrpc/com.atproto.repo.putRecord" >=> putRecordHandler 857 - GET >=> route "/xrpc/com.atproto.sync.getRepo" >=> getRepoHandler 858 - GET >=> route "/xrpc/com.atproto.sync.getBlocks" >=> getBlocksHandler 859 - GET >=> route "/xrpc/com.atproto.sync.getBlob" >=> getBlobHandler 860 - GET >=> route "/xrpc/com.atproto.sync.subscribeRepos" >=> subscribeReposHandler 52 + >=> Auth.refreshSessionHandler 53 + POST 54 + >=> route "/xrpc/com.atproto.repo.createRecord" 55 + >=> Repo.createRecordHandler 56 + GET >=> route "/xrpc/com.atproto.repo.getRecord" >=> Repo.getRecordHandler 57 + POST >=> route "/xrpc/com.atproto.repo.putRecord" >=> Repo.putRecordHandler 58 + GET >=> route "/xrpc/com.atproto.sync.getRepo" >=> Sync.getRepoHandler 59 + GET >=> route "/xrpc/com.atproto.sync.getBlocks" >=> Sync.getBlocksHandler 60 + GET >=> route "/xrpc/com.atproto.sync.getBlob" >=> Sync.getBlobHandler 61 + GET 62 + >=> route "/xrpc/com.atproto.sync.subscribeRepos" 63 + >=> Sync.subscribeReposHandler 861 64 route "/" >=> text "PDSharp PDS is running." 862 65 RequestErrors.NOT_FOUND "Not Found" 863 66 ] ··· 870 73 services.AddGiraffe() |> ignore 871 74 services.AddSingleton<AppConfig>(config) |> ignore 872 75 873 - [<EntryPoint>] 874 - let main args = 875 - let configBuilder = 876 - ConfigurationBuilder() 877 - .SetBasePath(AppContext.BaseDirectory) 878 - .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) 879 - .AddEnvironmentVariables(prefix = "PDSHARP_") 880 - .Build() 76 + let blockStore = new SqliteBlockStore(config.SqliteConnectionString) 77 + let accountStore = new SqliteAccountStore(config.SqliteConnectionString) 78 + let repoStore = new SqliteRepoStore(config.SqliteConnectionString) 881 79 882 - let appConfig = configBuilder.Get<AppConfig>() 80 + services.AddSingleton<IBlockStore>(blockStore) |> ignore 81 + services.AddSingleton<IAccountStore>(accountStore) |> ignore 82 + services.AddSingleton<IRepoStore>(repoStore) |> ignore 883 83 84 + let blobStore : IBlobStore = 85 + match config.BlobStore with 86 + | Disk path -> new DiskBlobStore(path) :> IBlobStore 87 + | S3 s3Config -> new S3BlobStore(s3Config) :> IBlobStore 88 + 89 + services.AddSingleton<IBlobStore>(blobStore) |> ignore 90 + services.AddSingleton<FirehoseState>(new FirehoseState()) |> ignore 91 + services.AddSingleton<SigningKeyStore>(new SigningKeyStore()) |> ignore 92 + 93 + [<EntryPoint>] 94 + let main args = 884 95 Host 885 96 .CreateDefaultBuilder(args) 886 97 .ConfigureWebHostDefaults(fun webHostBuilder -> 887 - webHostBuilder.Configure(configureApp).ConfigureServices(configureServices appConfig) 98 + webHostBuilder.Configure(configureApp).ConfigureServices(configureServices config) 888 99 |> ignore) 889 100 .Build() 890 101 .Run()

Configure Feed

Configure Feed