on master help sign in
Migrate to Donald for data access and fix profile message propagation for unknown senders
commitd9813d4d700f96d9bf49129182917ed468ca0a5a authoriko <mail@iko.soy> dateSun 19 Apr 2026, 01:49 (6 months ago) parent68c43e5
3 files changed+167−263
client/App.fs+7−1 client/Skrepka.fsproj+1−1 client/Store.fs+159−261
client/App.fs+7−1
@@ -89,7 +89,11 @@ module App =
8989 Messages = m.Messages |> markDelivered evt.Sender ackIds }
9090 | Envelope.ProfileMessage profile ->
9191 { m with
92− Contacts = m.Contacts |> Map.change evt.Sender (Option.map (withProfile profile)) }
92+ Contacts =
93+ m.Contacts
94+ |> Map.change evt.Sender (fun c ->
95+ let contact = c |> Option.defaultWith (fun () -> newContact evt.Sender "")
96+ Some(withProfile profile contact)) }
9397
9498 let private trySession model =
9599 match model.Auth with
@@ -336,6 +340,8 @@ module App =
336340 []
337341 | StateLoaded(None, _, _) -> model, []
338342
343+ | Search _ -> model, []
344+
339345 | KeyboardHeightChanged h -> { model with KeyboardHeight = h }, []
340346
341347 // ── mapCmd ──
client/Skrepka.fsproj+1−1
@@ -125,7 +125,7 @@
125125 <PackageReference Include="Fabulous" Version="3.0.0-pre22" />
126126 <PackageReference Include="Fabulous.Avalonia" Version="3.0.0-pre13" />
127127 <PackageReference Include="Sodium.Core" Version="1.4.0" />
128− <PackageReference Include="Dapper.FSharp" Version="4.10.0" />
128+ <PackageReference Include="Donald" Version="10.0.2" />
129129 <PackageReference Include="Microsoft.Data.Sqlite" Version="11.0.0-preview.2.26159.112" />
130130 <PackageReference Include="QRCoder" Version="1.6.0" />
131131 </ItemGroup>
client/Store.fs+159−261
@@ -1,10 +1,10 @@
11namespace Skrepka
22
33open System
4+open System.Data
45open System.IO
5−open Dapper
6+open Donald
67open Microsoft.Data.Sqlite
7−open Dapper.FSharp.SQLite
88
99module Store =
1010
@@ -41,50 +41,6 @@ module Store =
4141 ServerUrl: string
4242 PollCursor: int64 }
4343
44− // DB row types matching table columns
45− [<CLIMutable>]
46− type ProfileRow =
47− { Id: string
48− DisplayName: string
49− Bio: string
50− Photo: byte[] option }
51−
52− [<CLIMutable>]
53− type ContactRow =
54− { Pubkey: string
55− Nickname: string
56− DisplayName: string
57− Bio: string
58− Photo: byte[] option }
59−
60− [<CLIMutable>]
61− type MessageRow =
62− { Id: string
63− ConversationId: string
64− Body: string
65− TimestampUnix: int64
66− IsOutgoing: bool
67− Status: int }
68−
69− [<CLIMutable>]
70− type SettingsRow =
71− { Id: string
72− ServerUrl: string
73− PollCursor: int64 }
74−
75− [<CLIMutable>]
76− type OutboxRow =
77− { Id: int64
78− RecipientHex: string
79− EnvelopeJson: string
80− CreatedAt: int64 }
81−
82− let private profileTable = table'<ProfileRow> "profile"
83− let private contactTable = table'<ContactRow> "contacts"
84− let private messageTable = table'<MessageRow> "messages"
85− let private settingsTable = table'<SettingsRow> "settings"
86− let private outboxTable = table'<OutboxRow> "outbox"
87−
8844 let private log msg = eprintfn $"[skrepka] {msg}"
8945
9046 let private appDataDir =
@@ -109,78 +65,87 @@ module Store =
10965 let private openConn () =
11066 let conn = new SqliteConnection($"Data Source={dbPath}")
11167 conn.Open()
112− conn.Execute("PRAGMA busy_timeout = 5000") |> ignore
68+ conn |> Db.newCommand "PRAGMA busy_timeout = 5000" |> Db.exec
11369 conn
11470
115− type private ByteArrayOptionHandler() =
116− inherit SqlMapper.TypeHandler<byte[] option>()
117−
118− override _.SetValue(p, value) =
119− p.Value <-
120− match value with
121− | Some v -> box v
122− | None -> box DBNull.Value
123−
124− override _.Parse(value) =
125− if value = null || value :? DBNull then
126− None
71+ // ── Readers ──
72+
73+ let private readContact (rd: IDataReader) : Contact =
74+ { Pubkey = rd.ReadString "Pubkey"
75+ Nickname = rd.ReadString "Nickname"
76+ DisplayName = rd.ReadString "DisplayName"
77+ Bio = rd.ReadString "Bio"
78+ Photo = rd.ReadBytesOption "Photo" }
79+
80+ let private readMessage (rd: IDataReader) : ChatMessage =
81+ let isOutgoing = rd.ReadBoolean "IsOutgoing"
82+ let status = rd.ReadInt32 "Status"
83+
84+ { Id = rd.ReadString "Id"
85+ Body = rd.ReadString "Body"
86+ Timestamp = rd.ReadInt64 "TimestampUnix" |> DateTimeOffset.FromUnixTimeMilliseconds
87+ Direction =
88+ if not isOutgoing then
89+ Incoming
12790 else
128− Some(value :?> byte[])
91+ Outgoing(if status = 1 then DeliveryStatus.Delivered else DeliveryStatus.Sent) }
92+
93+ // ── Schema ──
12994
13095 do
131− OptionTypes.register ()
132− SqlMapper.AddTypeHandler(ByteArrayOptionHandler())
13396 use conn = openConn ()
134− conn.Execute("PRAGMA journal_mode=WAL") |> ignore
97+ conn |> Db.newCommand "PRAGMA journal_mode=WAL" |> Db.exec
13598
136− conn.Execute(
99+ conn
100+ |> Db.newCommand
137101 "CREATE TABLE IF NOT EXISTS profile (Id TEXT PRIMARY KEY, DisplayName TEXT NOT NULL DEFAULT '', Bio TEXT NOT NULL DEFAULT '', Photo BLOB)"
138− )
139− |> ignore
102+ |> Db.exec
140103
141− conn.Execute(
104+ conn
105+ |> Db.newCommand
142106 "CREATE TABLE IF NOT EXISTS contacts (Pubkey TEXT PRIMARY KEY, Nickname TEXT NOT NULL DEFAULT '', DisplayName TEXT NOT NULL DEFAULT '', Bio TEXT NOT NULL DEFAULT '', Photo BLOB)"
143− )
144− |> ignore
107+ |> Db.exec
145108
146− conn.Execute(
109+ conn
110+ |> Db.newCommand
147111 "CREATE TABLE IF NOT EXISTS messages (Id TEXT PRIMARY KEY, ConversationId TEXT NOT NULL, Body TEXT NOT NULL DEFAULT '', TimestampUnix INTEGER NOT NULL, IsOutgoing INTEGER NOT NULL DEFAULT 0, Status INTEGER NOT NULL DEFAULT 0)"
148− )
149− |> ignore
112+ |> Db.exec
150113
151− conn.Execute(
114+ conn
115+ |> Db.newCommand
152116 "CREATE TABLE IF NOT EXISTS settings (Id TEXT PRIMARY KEY, ServerUrl TEXT NOT NULL DEFAULT '', PollCursor INTEGER NOT NULL DEFAULT 0)"
153− )
154− |> ignore
117+ |> Db.exec
155118
156− conn.Execute(
119+ conn
120+ |> Db.newCommand
157121 "CREATE TABLE IF NOT EXISTS outbox (Id INTEGER PRIMARY KEY AUTOINCREMENT, RecipientHex TEXT NOT NULL, EnvelopeJson TEXT NOT NULL, CreatedAt INTEGER NOT NULL)"
158− )
159− |> ignore
122+ |> Db.exec
160123
161− // Schema versioning
162− conn.Execute("CREATE TABLE IF NOT EXISTS schema_meta (key TEXT PRIMARY KEY, value TEXT NOT NULL)")
163− |> ignore
124+ conn
125+ |> Db.newCommand "CREATE TABLE IF NOT EXISTS schema_meta (key TEXT PRIMARY KEY, value TEXT NOT NULL)"
126+ |> Db.exec
164127
165128 let dbVersion =
166129 try
167− conn.QueryFirstOrDefault<string>("SELECT value FROM schema_meta WHERE key = 'schema_version'")
168− |> Option.ofObj
169− |> Option.map int
130+ conn
131+ |> Db.newCommand "SELECT value FROM schema_meta WHERE key = 'schema_version'"
132+ |> Db.querySingle (fun rd -> rd.ReadString "value" |> int)
170133 |> Option.defaultValue 0
171134 with ex ->
172135 log $"schema version check: {ex.Message}"
173136 0
174137
175138 if dbVersion < 2 then
176− conn.Execute("CREATE INDEX IF NOT EXISTS idx_messages_conv ON messages(ConversationId)")
177− |> ignore
139+ conn
140+ |> Db.newCommand "CREATE INDEX IF NOT EXISTS idx_messages_conv ON messages(ConversationId)"
141+ |> Db.exec
178142
179− conn.Execute(
180− "INSERT OR REPLACE INTO schema_meta (key, value) VALUES ('schema_version', @v)",
181− {| v = string Constants.schemaVersion |}
182− )
183− |> ignore
143+ conn
144+ |> Db.newCommand "INSERT OR REPLACE INTO schema_meta (key, value) VALUES (@key, @value)"
145+ |> Db.setParams [ "key", SqlType.String "schema_version"; "value", SqlType.String(string Constants.schemaVersion) ]
146+ |> Db.exec
147+
148+ // ── Identity ──
184149
185150 let private identityPath = Path.Combine(appDataDir, "identity.key")
186151
@@ -206,26 +171,21 @@ module Store =
206171 File.WriteAllText(identityPath, b64)
207172 }
208173
174+ // ── Profile ──
175+
209176 let loadProfile () =
210177 async {
211178 try
212179 use conn = openConn ()
213180
214− let! rows =
215− select {
216− for p in profileTable do
217− where (p.Id = Constants.profileId)
218− }
219− |> conn.SelectAsync<ProfileRow>
220− |> Async.AwaitTask
221−
222181 return
223− rows
224− |> Seq.tryHead
225− |> Option.map (fun p ->
226− { DisplayName = p.DisplayName
227− Bio = p.Bio
228− Photo = p.Photo })
182+ conn
183+ |> Db.newCommand "SELECT DisplayName, Bio, Photo FROM profile WHERE Id = @Id"
184+ |> Db.setParams [ "Id", SqlType.String Constants.profileId ]
185+ |> Db.querySingle (fun rd ->
186+ { DisplayName = rd.ReadString "DisplayName"
187+ Bio = rd.ReadString "Bio"
188+ Photo = rd.ReadBytesOption "Photo" })
229189 with ex ->
230190 log $"loadProfile error: {ex.Message}"
231191 return None
@@ -236,93 +196,60 @@ module Store =
236196 try
237197 use conn = openConn ()
238198
239− do!
240− conn.ExecuteAsync(
241− "INSERT OR REPLACE INTO profile (Id, DisplayName, Bio, Photo) VALUES (@Id, @DisplayName, @Bio, @Photo)",
242− {| Id = Constants.profileId
243− DisplayName = profile.DisplayName
244− Bio = profile.Bio
245− Photo = profile.Photo |> Option.defaultValue null |}
246− )
247− |> Async.AwaitTask
248− |> Async.Ignore
199+ conn
200+ |> Db.newCommand
201+ "INSERT OR REPLACE INTO profile (Id, DisplayName, Bio, Photo) VALUES (@Id, @DisplayName, @Bio, @Photo)"
202+ |> Db.setParams
203+ [ "Id", SqlType.String Constants.profileId
204+ "DisplayName", SqlType.String profile.DisplayName
205+ "Bio", SqlType.String profile.Bio
206+ "Photo",
207+ (match profile.Photo with
208+ | Some bytes -> SqlType.Bytes bytes
209+ | None -> SqlType.Null) ]
210+ |> Db.exec
249211 with ex ->
250212 log $"saveProfile error: {ex.Message}"
251213 }
252214
215+ // ── Data ──
216+
253217 let loadData () =
254218 async {
255219 try
256220 use conn = openConn ()
257221
258− let! settings =
259− select {
260− for s in settingsTable do
261− where (s.Id = Constants.settingsId)
262− }
263− |> conn.SelectAsync<SettingsRow>
264− |> Async.AwaitTask
222+ let settings =
223+ conn
224+ |> Db.newCommand "SELECT ServerUrl, PollCursor FROM settings WHERE Id = @Id"
225+ |> Db.setParams [ "Id", SqlType.String Constants.settingsId ]
226+ |> Db.querySingle (fun rd -> rd.ReadString "ServerUrl", rd.ReadInt64 "PollCursor")
265227
266− match settings |> Seq.tryHead with
228+ match settings with
267229 | None -> return None
268− | Some s ->
269− let! contactRows =
270− select {
271− for c in contactTable do
272− selectAll
273− }
274− |> conn.SelectAsync<ContactRow>
275− |> Async.AwaitTask
276−
230+ | Some(serverUrl, pollCursor) ->
277231 let contacts =
278− contactRows
279− |> Seq.map (fun c ->
280− let contact: Contact =
281− { Pubkey = c.Pubkey
282− Nickname = c.Nickname
283− DisplayName = c.DisplayName
284− Bio = c.Bio
285− Photo = c.Photo }
286−
287− c.Pubkey, contact)
288− |> Map.ofSeq
289−
290− let! messageRows =
291− conn.QueryAsync<MessageRow>(
292− $"SELECT Id, ConversationId, Body, TimestampUnix, IsOutgoing, Status FROM (SELECT *, ROW_NUMBER() OVER (PARTITION BY ConversationId ORDER BY TimestampUnix DESC) AS rn FROM messages) WHERE rn <= {Constants.maxMessages}"
293− )
294− |> Async.AwaitTask
232+ conn
233+ |> Db.newCommand "SELECT Pubkey, Nickname, DisplayName, Bio, Photo FROM contacts"
234+ |> Db.query readContact
235+ |> List.map (fun c -> c.Pubkey, c)
236+ |> Map.ofList
295237
296238 let messages =
297− messageRows
298− |> Seq.groupBy _.ConversationId
299− |> Seq.map (fun (convId, rows) ->
300− convId,
301− rows
302− |> Seq.map (fun m ->
303− { Id = m.Id
304− Body = m.Body
305− Timestamp = DateTimeOffset.FromUnixTimeMilliseconds m.TimestampUnix
306− Direction =
307− if not m.IsOutgoing then
308− Incoming
309− else
310− Outgoing(
311− if m.Status = 1 then
312− DeliveryStatus.Delivered
313− else
314− DeliveryStatus.Sent
315− ) })
316− |> Seq.sortBy _.Timestamp
317− |> Seq.toList)
318− |> Map.ofSeq
239+ conn
240+ |> Db.newCommand
241+ $"SELECT Id, Body, TimestampUnix, IsOutgoing, Status, ConversationId FROM (SELECT *, ROW_NUMBER() OVER (PARTITION BY ConversationId ORDER BY TimestampUnix DESC) AS rn FROM messages) WHERE rn <= {Constants.maxMessages}"
242+ |> Db.query (fun rd -> rd.ReadString "ConversationId", readMessage rd)
243+ |> List.groupBy fst
244+ |> List.map (fun (convId, pairs) -> convId, pairs |> List.map snd |> List.sortBy _.Timestamp)
245+ |> Map.ofList
319246
320247 return
321248 Some
322249 { Contacts = contacts
323250 Messages = messages
324− ServerUrl = s.ServerUrl
325− PollCursor = s.PollCursor }
251+ ServerUrl = serverUrl
252+ PollCursor = pollCursor }
326253 with ex ->
327254 log $"loadData error: {ex.Message}"
328255 return None
@@ -335,18 +262,19 @@ module Store =
335262 use tx = conn.BeginTransaction()
336263
337264 for c in data.Contacts.Values do
338− do!
339− conn.ExecuteAsync(
340− "INSERT OR REPLACE INTO contacts (Pubkey, Nickname, DisplayName, Bio, Photo) VALUES (@Pubkey, @Nickname, @DisplayName, @Bio, @Photo)",
341− {| Pubkey = c.Pubkey
342− Nickname = c.Nickname
343− DisplayName = c.DisplayName
344− Bio = c.Bio
345− Photo = c.Photo |},
346− tx
347− )
348− |> Async.AwaitTask
349− |> Async.Ignore
265+ conn
266+ |> Db.newCommand
267+ "INSERT OR REPLACE INTO contacts (Pubkey, Nickname, DisplayName, Bio, Photo) VALUES (@Pubkey, @Nickname, @DisplayName, @Bio, @Photo)"
268+ |> Db.setParams
269+ [ "Pubkey", SqlType.String c.Pubkey
270+ "Nickname", SqlType.String c.Nickname
271+ "DisplayName", SqlType.String c.DisplayName
272+ "Bio", SqlType.String c.Bio
273+ "Photo",
274+ (match c.Photo with
275+ | Some bytes -> SqlType.Bytes bytes
276+ | None -> SqlType.Null) ]
277+ |> Db.exec
350278
351279 for KeyValue(convId, msgs) in data.Messages do
352280 for m in msgs do
@@ -356,55 +284,47 @@ module Store =
356284 | Outgoing DeliveryStatus.Delivered -> true, 1
357285 | Outgoing DeliveryStatus.Sent -> true, 0
358286
359− do!
360− conn.ExecuteAsync(
361− "INSERT OR REPLACE INTO messages (Id, ConversationId, Body, TimestampUnix, IsOutgoing, Status) VALUES (@Id, @ConversationId, @Body, @TimestampUnix, @IsOutgoing, @Status)",
362− {| Id = m.Id
363− ConversationId = convId
364− Body = m.Body
365− TimestampUnix = m.Timestamp.ToUnixTimeMilliseconds()
366− IsOutgoing = isOutgoing
367− Status = status |},
368− tx
369− )
370− |> Async.AwaitTask
371− |> Async.Ignore
372−
373− do!
374− conn.ExecuteAsync(
375− "INSERT OR REPLACE INTO settings (Id, ServerUrl, PollCursor) VALUES (@Id, @ServerUrl, @PollCursor)",
376− {| Id = Constants.settingsId
377− ServerUrl = data.ServerUrl
378− PollCursor = data.PollCursor |},
379− tx
380− )
381− |> Async.AwaitTask
382− |> Async.Ignore
287+ conn
288+ |> Db.newCommand
289+ "INSERT OR REPLACE INTO messages (Id, ConversationId, Body, TimestampUnix, IsOutgoing, Status) VALUES (@Id, @ConversationId, @Body, @TimestampUnix, @IsOutgoing, @Status)"
290+ |> Db.setParams
291+ [ "Id", SqlType.String m.Id
292+ "ConversationId", SqlType.String convId
293+ "Body", SqlType.String m.Body
294+ "TimestampUnix", SqlType.Int64(m.Timestamp.ToUnixTimeMilliseconds())
295+ "IsOutgoing", SqlType.Boolean isOutgoing
296+ "Status", SqlType.Int32 status ]
297+ |> Db.exec
298+
299+ conn
300+ |> Db.newCommand
301+ "INSERT OR REPLACE INTO settings (Id, ServerUrl, PollCursor) VALUES (@Id, @ServerUrl, @PollCursor)"
302+ |> Db.setParams
303+ [ "Id", SqlType.String Constants.settingsId
304+ "ServerUrl", SqlType.String data.ServerUrl
305+ "PollCursor", SqlType.Int64 data.PollCursor ]
306+ |> Db.exec
383307
384308 tx.Commit()
385309 with ex ->
386310 log $"saveData error: {ex.Message}"
387311 }
388312
313+ // ── Outbox ──
314+
389315 let enqueueOutbox (recipientHex: string) (envelopeJson: string) =
390316 async {
391317 try
392318 use conn = openConn ()
393319
394− do!
395− insert {
396− for o in outboxTable do
397− value
398− { Id = 0L
399− RecipientHex = recipientHex
400− EnvelopeJson = envelopeJson
401− CreatedAt = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds() }
402−
403− excludeColumn o.Id
404− }
405− |> conn.InsertAsync
406− |> Async.AwaitTask
407− |> Async.Ignore
320+ conn
321+ |> Db.newCommand
322+ "INSERT INTO outbox (RecipientHex, EnvelopeJson, CreatedAt) VALUES (@RecipientHex, @EnvelopeJson, @CreatedAt)"
323+ |> Db.setParams
324+ [ "RecipientHex", SqlType.String recipientHex
325+ "EnvelopeJson", SqlType.String envelopeJson
326+ "CreatedAt", SqlType.Int64(DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()) ]
327+ |> Db.exec
408328 with ex ->
409329 log $"enqueueOutbox error: {ex.Message}"
410330 }
@@ -414,13 +334,13 @@ module Store =
414334 try
415335 use conn = openConn ()
416336
417− let! rows =
418− conn.QueryAsync<OutboxRow>(
419− "SELECT Id, RecipientHex, EnvelopeJson, CreatedAt FROM outbox ORDER BY Id LIMIT 1"
420− )
421− |> Async.AwaitTask
422−
423− return rows |> Seq.tryHead
337+ return
338+ conn
339+ |> Db.newCommand "SELECT Id, RecipientHex, EnvelopeJson, CreatedAt FROM outbox ORDER BY Id LIMIT 1"
340+ |> Db.querySingle (fun rd ->
341+ {| Id = rd.ReadInt64 "Id"
342+ RecipientHex = rd.ReadString "RecipientHex"
343+ EnvelopeJson = rd.ReadString "EnvelopeJson" |})
424344 with ex ->
425345 log $"peekOutbox error: {ex.Message}"
426346 return None
@@ -431,14 +351,10 @@ module Store =
431351 try
432352 use conn = openConn ()
433353
434− do!
435− delete {
436− for o in outboxTable do
437− where (o.Id = id)
438− }
439− |> conn.DeleteAsync
440− |> Async.AwaitTask
441− |> Async.Ignore
354+ conn
355+ |> Db.newCommand "DELETE FROM outbox WHERE Id = @Id"
356+ |> Db.setParams [ "Id", SqlType.Int64 id ]
357+ |> Db.exec
442358 with ex ->
443359 log $"dequeueOutbox error: {ex.Message}"
444360 }
@@ -448,30 +364,12 @@ module Store =
448364 try
449365 use conn = openConn ()
450366
451− let! rows =
452− conn.QueryAsync<MessageRow>(
453− "SELECT Id, ConversationId, Body, TimestampUnix, IsOutgoing, Status FROM messages WHERE ConversationId = @convId ORDER BY TimestampUnix",
454− {| convId = conversationId |}
455− )
456− |> Async.AwaitTask
457−
458367 return
459− rows
460− |> Seq.map (fun m ->
461− { Id = m.Id
462− Body = m.Body
463− Timestamp = DateTimeOffset.FromUnixTimeMilliseconds m.TimestampUnix
464− Direction =
465− if not m.IsOutgoing then
466− Incoming
467− else
468− Outgoing(
469− if m.Status = 1 then
470− DeliveryStatus.Delivered
471− else
472− DeliveryStatus.Sent
473− ) })
474− |> Seq.toList
368+ conn
369+ |> Db.newCommand
370+ "SELECT Id, Body, TimestampUnix, IsOutgoing, Status FROM messages WHERE ConversationId = @convId ORDER BY TimestampUnix"
371+ |> Db.setParams [ "convId", SqlType.String conversationId ]
372+ |> Db.query readMessage
475373 with ex ->
476374 log $"loadMessagesForConversation error: {ex.Message}"
477375 return []