7373014 · skrepka · git.iko.soy

git.iko.soy/skrepka

Fix error handling, polling backoff, and cache eviction

commit7373014b85fd32dae56a6401c36c1ffae82f413d authoriko <mail@iko.soy> dateSat 18 Apr 2026, 02:15 (6 months ago) parent9e1d695

8 files changed+160−105

compare with master

unifiedsplit

client/ApiClient.fs+8−5 client/App.fs+61−41 client/AppTypes.fs+3−2 client/Constants.fs+6 client/Crypto.fs+62−41 client/Protocol.fs+5−5 client/Store.fs+5−7 client/Styles.fs+10−4

client/ApiClient.fs+8−5

@@ -9,6 +9,9 @@ open System.Threading.Tasks

1010module ApiClient =

1111

12+ exception ApiError of string

13+ exception ServerRejected of string

14+

1215 [<CLIMutable>]

1316 type EventPayload = { EncryptedBlob: string; Timestamp: int64 }

1417

@@ -66,7 +69,7 @@ module ApiClient =

6669 match doc.RootElement.TryGetProperty("error") with

6770 | true, err ->

6871 doc.Dispose()

69− return failwith $"{url}: {err.GetString()}"

72+ return raise (ApiError $"{url}: {err.GetString()}")

7073 | _ -> return doc

7174 }

7275

@@ -85,7 +88,7 @@ module ApiClient =

8588 let body = JsonSerializer.Serialize({| pubkey = identity.PubKeyHex; challenge = challenge; signature = sigHex |})

8689 use! tokenDoc = sendRequest client $"{serverUrl}/auth/verify" body None

8790 let token = tokenDoc.RootElement.GetProperty("token").GetString()

88− if String.IsNullOrEmpty(token) then failwith "Authentication rejected by server"

91+ if String.IsNullOrEmpty(token) then raise (ApiError "Authentication rejected by server")

8992 return token

9093 }

9194

@@ -95,9 +98,9 @@ module ApiClient =

9598 use! doc = sendRequest client $"{serverUrl}/messages" body (Some token)

9699 match doc.RootElement.GetProperty("status").GetString() with

97100 | "delivered" | "federated" | "queued" -> ()

98− | "rejected" -> failwith "Message rejected by server"

99− | "unauthorized" -> failwith "Not authorized to deliver message"

100− | s -> failwith $"Unexpected status: {s}"

101+ | "rejected" -> raise (ServerRejected "Message rejected by server")

102+ | "unauthorized" -> raise (ServerRejected "Not authorized to deliver message")

103+ | s -> raise (ApiError $"Unexpected status: {s}")

101104 }

102105

103106 let poll (serverUrl: string) (token: string) (cursor: int64) =

client/App.fs+61−41

@@ -126,7 +126,8 @@ module App =

126126 Error = None

127127 PollCursor = 0L

128128 Profile = None

129− FlushingOutbox = false },

129+ FlushingOutbox = false

130+ PollRetries = 0 },

130131 [ CmdLoadState ]

131132

132133 // ── Update ──

@@ -167,29 +168,32 @@ module App =

167168 Error = None

168169 PollStatus = "polling..."

169170 FlushingOutbox = true },

170− [ CmdPoll(session, model.PollCursor); CmdFlushOutbox session ]

171+ [ CmdPoll(session, model.PollCursor, 0); CmdFlushOutbox session ]

171172 | _ -> model, []

172173

173174 | AuthErr err ->

174175 { setConn Offline model with

175176 Error = Some err

176− FlushingOutbox = false },

177+ FlushingOutbox = false

178+ PollRetries = 0 },

177179 []

178180

179181 | DoDisconnect ->

180182 { setConn Offline model with

181183 PollStatus = ""

182− FlushingOutbox = false },

184+ FlushingOutbox = false

185+ PollRetries = 0 },

183186 []

184187

185188 | DoSend ->

186189 match model.Page with

187− | Chat(pk, compose) when compose <> "" ->

190+ | Chat(pk, compose) when compose.Trim() <> "" ->

191+ let body = compose.Trim()

188192 let id = Guid.NewGuid().ToString()

189193

190194 let outMsg =

191195 { Id = id

192− Body = compose

196+ Body = body

193197 Timestamp = DateTimeOffset.UtcNow

194198 Direction = Outgoing DeliveryStatus.Sent }

195199

@@ -201,7 +205,7 @@ module App =

201205 Messages = model.Messages |> appendMessage pk outMsg }

202206

203207 model',

204− [ CmdEnqueue(pk, Envelope.TextMessage(id, compose))

208+ [ CmdEnqueue(pk, Envelope.TextMessage(id, body))

205209 match model.Profile with

206210 | Some profile when isFirstInteraction -> CmdEnqueue(pk, Envelope.ProfileMessage profile)

207211 | _ -> ()

@@ -225,17 +229,24 @@ module App =

225229 { model with FlushingOutbox = false }, []

226230

227231 | PollResult(events, status, newCursor) ->

232+ let retries =

233+ if events.IsEmpty && status.StartsWith("poll error") then

234+ model.PollRetries + 1

235+ else

236+ 0

237+

228238 let model' =

229239 events

230240 |> List.fold

231241 applyEvent

232242 { model with

233243 PollStatus = status

234− PollCursor = newCursor }

244+ PollCursor = newCursor

245+ PollRetries = retries }

235246

236247 model',

237248 [ match trySession model' with

238− | Some session -> CmdPoll(session, model'.PollCursor)

249+ | Some session -> CmdPoll(session, model'.PollCursor, model'.PollRetries)

239250 | None -> ()

240251 if not events.IsEmpty then

241252 saveCmdMsg model' ]

@@ -443,25 +454,36 @@ module App =

443454 match! Store.peekOutbox () with

444455 | Some item ->

445456 try

446− let blob =

457+ let blobOpt =

447458 Crypto.encrypt

448459 session.Identity.PrivKey

449460 (Crypto.fromHex item.RecipientHex)

450461 item.EnvelopeJson

451462

452− let ts = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()

453− do! sendMessage session.Url session.Token item.RecipientHex (Crypto.toHex blob) ts

463+ match blobOpt with

464+ | Some blob ->

465+ let ts = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()

466+ do! sendMessage session.Url session.Token item.RecipientHex (Crypto.toHex blob) ts

467+ do! Store.dequeueOutbox item.Id

468+ dispatch (FlushResult true)

469+ | None ->

470+ log $"outbox encrypt failed, dropping message to {item.RecipientHex}"

471+ do! Store.dequeueOutbox item.Id

472+ dispatch (FlushResult true)

473+ with

474+ | ServerRejected msg ->

475+ log $"outbox rejected, dropping: {msg}"

454476 do! Store.dequeueOutbox item.Id

455477 dispatch (FlushResult true)

456− with ex ->

478+ | ex ->

457479 log $"outbox send error: {ex.Message}"

458− do! Async.Sleep 3000

480+ do! Async.Sleep Constants.outboxRetryDelayMs

459481 dispatch (FlushResult true)

460482 | None -> dispatch (FlushResult false)

461483 }

462484 |> Async.Start)

463485

464− | CmdPoll(session, cursor) ->

486+ | CmdPoll(session, cursor, retries) ->

465487 Cmd.ofEffect (fun dispatch ->

466488 async {

467489 log $"poll start cursor={cursor}"

@@ -493,33 +515,30 @@ module App =

493515 for e in errors do

494516 log $"decrypt error: {e}"

495517

496− if not ackIds.IsEmpty || not events.IsEmpty then

497− async {

498− if not ackIds.IsEmpty then

499− try

500− do! ackMessages session.Url session.Token ackIds

501− with ex ->

502− log $"ack error: {ex.Message}"

503−

504− let acksBySender =

505− events

506− |> List.choose (fun evt ->

507− match evt.Envelope with

508− | Envelope.TextMessage(id, _) -> Some(evt.Sender, id)

509− | _ -> None)

510− |> List.groupBy fst

511− |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)

512−

513− for sender, msgIds in acksBySender do

514− try

515− do! sendEnvelope session sender (Envelope.DeliveryAck msgIds)

516− with ex ->

517− log $"delivery ack error: {ex.Message}"

518− }

519− |> Async.Start

518+ if not ackIds.IsEmpty then

519+ try

520+ do! ackMessages session.Url session.Token ackIds

521+ with ex ->

522+ log $"ack error: {ex.Message}"

523+

524+ if not events.IsEmpty then

525+ let acksBySender =

526+ events

527+ |> List.choose (fun evt ->

528+ match evt.Envelope with

529+ | Envelope.TextMessage(id, _) -> Some(evt.Sender, id)

530+ | _ -> None)

531+ |> List.groupBy fst

532+ |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)

533+

534+ for sender, msgIds in acksBySender do

535+ try

536+ do! sendEnvelope session sender (Envelope.DeliveryAck msgIds)

537+ with ex ->

538+ log $"delivery ack error: {ex.Message}"

520539

521540 if response.Events.Length = 0 then

522− do! Async.Sleep 5000

541+ do! Async.Sleep Constants.pollEmptyDelayMs

523542

524543 let chatCount =

525544 events

@@ -541,7 +560,8 @@ module App =

541560 dispatch (PollResult([], "polling...", cursor))

542561 | ex ->

543562 log $"poll error: {ex.Message}"

544− do! Async.Sleep 3000

563+ let delay = min (Constants.pollRetryBaseMs * (pown 2 retries)) 30000

564+ do! Async.Sleep delay

545565 dispatch (PollResult([], $"poll error: {ex.Message}", cursor))

546566 }

547567 |> Async.Start)

client/AppTypes.fs+3−2

@@ -58,7 +58,8 @@ module AppTypes =

5858 Error: string option

5959 PollCursor: int64

6060 Profile: Profile option

61− FlushingOutbox: bool }

61+ FlushingOutbox: bool

62+ PollRetries: int }

6263

6364 // ── Msg ──

6465

@@ -89,7 +90,7 @@ module AppTypes =

8990 | CmdConnect of url: string * identity: Identity

9091 | CmdEnqueue of recipientHex: string * envelope: Envelope

9192 | CmdFlushOutbox of session: Session

92− | CmdPoll of session: Session * cursor: int64

93+ | CmdPoll of session: Session * cursor: int64 * retries: int

9394 | CmdCopyToClipboard of string

9495 | CmdLoadState

9596 | CmdSaveIdentity of Identity

client/Constants.fs+6

@@ -11,3 +11,9 @@ module Constants =

1111 let profileId = "me"

1212 let settingsId = "settings"

1313 let schemaVersion = 2

14+ let maxBitmapCacheSize = 128

15+ let pollRetryBaseMs = 3000

16+ let pollEmptyDelayMs = 5000

17+ let outboxRetryDelayMs = 3000

18+ let maxMessages = 200

19+ let blobVersion = 1uy

client/Crypto.fs+62−41

@@ -156,16 +156,17 @@ module Crypto =

156156

157157 let private log msg = eprintfn $"[skrepka] {msg}"

158158

159− let identityFromPrivKey (privKey: byte[]) : Identity =

159+ let identityFromPrivKey (privKey: byte[]) : Identity option =

160160 if privKey.Length <> 64 then

161− failwith $"Invalid Ed25519 secret key length: expected 64, got {privKey.Length}"

162−

163− { PrivKey = privKey

164− PubKeyHex = toHex privKey.[32..63] }

161+ None

162+ else

163+ Some

164+ { PrivKey = privKey

165+ PubKeyHex = toHex privKey.[32..63] }

165166

166167 let generateIdentity () : Identity =

167168 let _, sk = generateSignKeyPair ()

168− sk |> identityFromPrivKey

169+ sk |> identityFromPrivKey |> Option.get

169170

170171 let signChallenge (privKey: byte[]) (challenge: string) : string =

171172 let message = Encoding.UTF8.GetBytes(challenge)

@@ -185,45 +186,65 @@ module Crypto =

185186 let private trailerLen = pubLen + sigLen

186187 let private minBlobLen = headerLen + 16 + trailerLen // 16 = AEAD tag

187188

188− let encrypt (senderPrivKey: byte[]) (recipientEd25519Pub: byte[]) (plaintext: string) : byte[] =

189− if senderPrivKey.Length <> 64 then

190− failwith $"Invalid sender secret key length: expected 64, got {senderPrivKey.Length}"

191−

192− if recipientEd25519Pub.Length <> 32 then

193− failwith $"Invalid recipient public key length: expected 32, got {recipientEd25519Pub.Length}"

194−

195− let senderPubKey = senderPrivKey.[32..63]

196− let ephPub, ephPriv = generateBoxKeyPair ()

197− let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

198− let rawSecret = scalarMult ephPriv recipientX25519Pub

199− let key = deriveKey ephPub recipientX25519Pub rawSecret

200− let nonce = getRandomBytes 24

201− let ptBytes = Encoding.UTF8.GetBytes(plaintext)

202− let ciphertext = aeadEncrypt ptBytes nonce key

203− let signature = signDetached ciphertext senderPrivKey

204− Array.concat [| ephPub; nonce; ciphertext; senderPubKey; signature |]

189+ let encrypt (senderPrivKey: byte[]) (recipientEd25519Pub: byte[]) (plaintext: string) : byte[] option =

190+ if senderPrivKey.Length <> 64 || recipientEd25519Pub.Length <> 32 then

191+ None

192+ else

193+ try

194+ let senderPubKey = senderPrivKey.[32..63]

195+ let ephPub, ephPriv = generateBoxKeyPair ()

196+ let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

197+ let rawSecret = scalarMult ephPriv recipientX25519Pub

198+ let key = deriveKey ephPub recipientX25519Pub rawSecret

199+ let nonce = getRandomBytes 24

200+ let ptBytes = Encoding.UTF8.GetBytes(plaintext)

201+ let ciphertext = aeadEncrypt ptBytes nonce key

202+ let signature = signDetached ciphertext senderPrivKey

203+

204+ Some(

205+ Array.concat

206+ [| [| Constants.blobVersion |]

207+ ephPub

208+ nonce

209+ ciphertext

210+ senderPubKey

211+ signature |]

212+ )

213+ with ex ->

214+ log $"encrypt error: {ex.Message}"

215+ None

205216

206217 let decrypt (recipientPrivKey: byte[]) (blob: byte[]) : (string * string) option =

207218 if recipientPrivKey.Length <> 64 || blob.Length < minBlobLen then

208219 None

209220 else

210− try

211− let ephPub = blob.[.. ephPubLen - 1]

212− let nonce = blob.[ephPubLen .. headerLen - 1]

213− let ciphertext = blob.[headerLen .. blob.Length - trailerLen - 1]

214− let senderPub = blob.[blob.Length - trailerLen .. blob.Length - sigLen - 1]

215− let signature = blob.[blob.Length - sigLen ..]

216−

217− if not (verifyDetached signature ciphertext senderPub) then

221+ let tryDecrypt offset =

222+ if blob.Length < minBlobLen + offset then

218223 None

219224 else

220− let recipientX25519Priv = ed25519SkToCurve25519 recipientPrivKey

221− let rawSecret = scalarMult recipientX25519Priv ephPub

222− let recipientEd25519Pub = recipientPrivKey.[32..63]

223− let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

224− let key = deriveKey ephPub recipientX25519Pub rawSecret

225− let plaintext = aeadDecrypt ciphertext nonce key

226− Some(Encoding.UTF8.GetString(plaintext), toHex senderPub)

227− with ex ->

228− log $"decrypt error: {ex.Message}"

229− None

225+ try

226+ let ephPub = blob.[offset .. offset + ephPubLen - 1]

227+ let nonce = blob.[offset + ephPubLen .. offset + headerLen - 1]

228+ let ciphertext = blob.[offset + headerLen .. blob.Length - trailerLen - 1]

229+ let senderPub = blob.[blob.Length - trailerLen .. blob.Length - sigLen - 1]

230+ let signature = blob.[blob.Length - sigLen ..]

231+

232+ if not (verifyDetached signature ciphertext senderPub) then

233+ None

234+ else

235+ let recipientX25519Priv = ed25519SkToCurve25519 recipientPrivKey

236+ let rawSecret = scalarMult recipientX25519Priv ephPub

237+ let recipientEd25519Pub = recipientPrivKey.[32..63]

238+ let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

239+ let key = deriveKey ephPub recipientX25519Pub rawSecret

240+ let plaintext = aeadDecrypt ciphertext nonce key

241+ Some(Encoding.UTF8.GetString(plaintext), toHex senderPub)

242+ with ex ->

243+ log $"decrypt error: {ex.Message}"

244+ None

245+

246+ // Try versioned format, fall back to unversioned for backwards compat

247+ if blob.[0] = Constants.blobVersion then

248+ tryDecrypt 1 |> Option.orElseWith (fun () -> tryDecrypt 0)

249+ else

250+ tryDecrypt 0

client/Protocol.fs+5−5

@@ -92,9 +92,9 @@ module Protocol =

9292 async {

9393 let payload = serializeEnvelope envelope

9494

95− let blob =

96− Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex recipientHex) payload

97−

98− let ts = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()

99− do! sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts

95+ match Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex recipientHex) payload with

96+ | Some blob ->

97+ let ts = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()

98+ do! sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts

99+ | None -> log $"encrypt failed for {recipientHex}"

100100 }

client/Store.fs+5−7

@@ -192,7 +192,7 @@ module Store =

192192 File.ReadAllText(identityPath)

193193 |> Option.ofObj

194194 |> Option.filter (fun s -> s <> "")

195− |> Option.map (Convert.FromBase64String >> Crypto.identityFromPrivKey)

195+ |> Option.bind (Convert.FromBase64String >> Crypto.identityFromPrivKey)

196196 else

197197 None

198198 with ex ->

@@ -289,7 +289,7 @@ module Store =

289289

290290 let! messageRows =

291291 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 <= 200"

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}"

293293 )

294294 |> Async.AwaitTask

295295

@@ -415,11 +415,9 @@ module Store =

415415 use conn = openConn ()

416416

417417 let! rows =

418− select {

419− for o in outboxTable do

420− orderBy o.Id

421− }

422− |> conn.SelectAsync<OutboxRow>

418+ conn.QueryAsync<OutboxRow>(

419+ "SELECT Id, RecipientHex, EnvelopeJson, CreatedAt FROM outbox ORDER BY Id LIMIT 1"

420+ )

423421 |> Async.AwaitTask

424422

425423 return rows |> Seq.tryHead

client/Styles.fs+10−4

@@ -43,11 +43,11 @@ module Styles =

4343 .Name("PART_ContentPresenter"))

4444 [ Setter(ContentPresenter.MarginProperty, Thickness(0.)) ] ]

4545

46− let private maxBitmapCacheSize = 128

47−

4846 let private bitmapCache =

4947 System.Collections.Concurrent.ConcurrentDictionary<int, Avalonia.Media.Imaging.Bitmap>()

5048

49+ let private bitmapInsertOrder = System.Collections.Concurrent.ConcurrentQueue<int>()

50+

5151 let cachedBitmap (bytes: byte[]) =

5252 let h =

5353 System.HashCode.Combine(

@@ -56,8 +56,14 @@ module Styles =

5656 (if bytes.Length > 7 then System.BitConverter.ToInt32(bytes, bytes.Length / 2) else 0),

5757 (if bytes.Length > 11 then System.BitConverter.ToInt32(bytes, bytes.Length - 4) else 0))

5858

59− if bitmapCache.Count >= maxBitmapCacheSize then

60− bitmapCache.Clear()

59+ while bitmapCache.Count >= Constants.maxBitmapCacheSize do

60+ match bitmapInsertOrder.TryDequeue() with

61+ | true, oldest ->

62+ match bitmapCache.TryRemove(oldest) with

63+ | true, bmp -> bmp.Dispose()

64+ | _ -> ()

65+ | _ -> bitmapCache.Clear()

6166

6267 bitmapCache.GetOrAdd(h, fun _ ->

68+ bitmapInsertOrder.Enqueue(h)

6369 new Avalonia.Media.Imaging.Bitmap(new System.IO.MemoryStream(bytes)))