an atproto pds written in F# (.NET 9) 馃
pds
fsharp
giraffe
dotnet
atproto
1namespace PDSharp.Core
2
3open System
4open System.IO
5open Microsoft.Data.Sqlite
6open Dapper
7open PDSharp.Core.BlockStore
8open PDSharp.Core.Auth
9open System.Threading.Tasks
10open PDSharp.Core.Config
11
12/// SQLite persistence layer
13module 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 }