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