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