7373014 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Fix error handling, polling backoff, and cache eviction

7373014iko6 months ago

client/ApiClient.fs+8−5

compare with master

unifiedsplit

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

10module ApiClient =

12+ exception ApiError of string

13+ exception ServerRejected of string

14+

12 [<CLIMutable>]

15 [<CLIMutable>]

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

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

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

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

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

67 | true, err ->

70 | true, err ->

68 doc.Dispose()

71 doc.Dispose()

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

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

70 | _ -> return doc

73 | _ -> return doc

71 }

74 }

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

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

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

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

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

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

90 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")

89 return token

92 return token

90 }

93 }

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

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

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

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

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

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

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

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

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

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

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

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

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

101 }

104 }

102

105

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

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

client/App.fs+61−41

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

126 Error = None

127 PollCursor = 0L

128 Profile = None

129− FlushingOutbox = false },

129+ FlushingOutbox = false

130+ PollRetries = 0 },

130 [ CmdLoadState ]

131 [ CmdLoadState ]

131

132

132 // ── Update ──

133 // ── Update ──

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

167 Error = None

168 Error = None

168 PollStatus = "polling..."

169 PollStatus = "polling..."

169 FlushingOutbox = true },

170 FlushingOutbox = true },

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

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

171 | _ -> model, []

172 | _ -> model, []

172

173

173 | AuthErr err ->

174 | AuthErr err ->

174 { setConn Offline model with

175 { setConn Offline model with

175 Error = Some err

176 Error = Some err

176− FlushingOutbox = false },

177+ FlushingOutbox = false

178+ PollRetries = 0 },

177 []

179 []

178

180

179 | DoDisconnect ->

181 | DoDisconnect ->

180 { setConn Offline model with

182 { setConn Offline model with

181 PollStatus = ""

183 PollStatus = ""

182− FlushingOutbox = false },

184+ FlushingOutbox = false

185+ PollRetries = 0 },

183 []

186 []

184

187

185 | DoSend ->

188 | DoSend ->

186 match model.Page with

189 match model.Page with

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

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

191+ let body = compose.Trim()

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

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

189

193

190 let outMsg =

194 let outMsg =

191 { Id = id

195 { Id = id

192− Body = compose

196+ Body = body

193 Timestamp = DateTimeOffset.UtcNow

197 Timestamp = DateTimeOffset.UtcNow

194 Direction = Outgoing DeliveryStatus.Sent }

198 Direction = Outgoing DeliveryStatus.Sent }

195

199

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

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

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

202

206

203 model',

207 model',

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

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

205 match model.Profile with

209 match model.Profile with

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

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

207 | _ -> ()

211 | _ -> ()

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

225 { model with FlushingOutbox = false }, []

229 { model with FlushingOutbox = false }, []

226

230

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

231 | 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+

228 let model' =

238 let model' =

229 events

239 events

230 |> List.fold

240 |> List.fold

231 applyEvent

241 applyEvent

232 { model with

242 { model with

233 PollStatus = status

243 PollStatus = status

234− PollCursor = newCursor }

244+ PollCursor = newCursor

245+ PollRetries = retries }

235

246

236 model',

247 model',

237 [ match trySession model' with

248 [ match trySession model' with

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

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

239 | None -> ()

250 | None -> ()

240 if not events.IsEmpty then

251 if not events.IsEmpty then

241 saveCmdMsg model' ]

252 saveCmdMsg model' ]

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

443 match! Store.peekOutbox () with

454 match! Store.peekOutbox () with

444 | Some item ->

455 | Some item ->

445 try

456 try

446− let blob =

457+ let blobOpt =

447 Crypto.encrypt

458 Crypto.encrypt

448 session.Identity.PrivKey

459 session.Identity.PrivKey

449 (Crypto.fromHex item.RecipientHex)

460 (Crypto.fromHex item.RecipientHex)

450 item.EnvelopeJson

461 item.EnvelopeJson

451

462

463+ match blobOpt with

464+ | Some blob ->

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

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

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

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

454 do! Store.dequeueOutbox item.Id

476 do! Store.dequeueOutbox item.Id

455 dispatch (FlushResult true)

477 dispatch (FlushResult true)

456− with ex ->

478+ | ex ->

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

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

458− do! Async.Sleep 3000

480+ do! Async.Sleep Constants.outboxRetryDelayMs

459 dispatch (FlushResult true)

481 dispatch (FlushResult true)

460 | None -> dispatch (FlushResult false)

482 | None -> dispatch (FlushResult false)

461 }

483 }

462 |> Async.Start)

484 |> Async.Start)

463

485

464− | CmdPoll(session, cursor) ->

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

465 Cmd.ofEffect (fun dispatch ->

487 Cmd.ofEffect (fun dispatch ->

466 async {

488 async {

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

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

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

493 for e in errors do

515 for e in errors do

494 log $"decrypt error: {e}"

516 log $"decrypt error: {e}"

495

517

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

518+ if not ackIds.IsEmpty then

497− async {

519+ try

498− if not ackIds.IsEmpty then

499− try

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

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

501− with ex ->

521+ with ex ->

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

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

503−

523+

524+ if not events.IsEmpty then

504− let acksBySender =

525+ let acksBySender =

505− events

526+ events

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

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

507− match evt.Envelope with

528+ match evt.Envelope with

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

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

509− | _ -> None)

530+ | _ -> None)

510− |> List.groupBy fst

531+ |> List.groupBy fst

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

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

512−

533+

513− for sender, msgIds in acksBySender do

534+ for sender, msgIds in acksBySender do

514− try

535+ try

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

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

516− with ex ->

537+ with ex ->

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

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

518− }

519− |> Async.Start

520

539

521 if response.Events.Length = 0 then

540 if response.Events.Length = 0 then

522− do! Async.Sleep 5000

541+ do! Async.Sleep Constants.pollEmptyDelayMs

523

542

524 let chatCount =

543 let chatCount =

525 events

544 events

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

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

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

542 | ex ->

561 | ex ->

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

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

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

544− do! Async.Sleep 3000

564+ do! Async.Sleep delay

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

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

546 }

566 }

547 |> Async.Start)

567 |> Async.Start)

client/AppTypes.fs+3−2

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

58 Error: string option

59 PollCursor: int64

60 Profile: Profile option

61− FlushingOutbox: bool }

61+ FlushingOutbox: bool

62+ PollRetries: int }

63 // ── Msg ──

64 // ── Msg ──

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

89 | CmdConnect of url: string * identity: Identity

90 | CmdConnect of url: string * identity: Identity

90 | CmdEnqueue of recipientHex: string * envelope: Envelope

91 | CmdEnqueue of recipientHex: string * envelope: Envelope

91 | CmdFlushOutbox of session: Session

92 | CmdFlushOutbox of session: Session

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

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

93 | CmdCopyToClipboard of string

94 | CmdCopyToClipboard of string

94 | CmdLoadState

95 | CmdLoadState

95 | CmdSaveIdentity of Identity

96 | CmdSaveIdentity of Identity

client/Constants.fs+6

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

11 let profileId = "me"

12 let settingsId = "settings"

13 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 =

156

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

158

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

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

160 if privKey.Length <> 64 then

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

161+ None

162−

162+ else

163+ Some

163− { PrivKey = privKey

164+ { PrivKey = privKey

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

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

165

166

166 let generateIdentity () : Identity =

167 let generateIdentity () : Identity =

167 let _, sk = generateSignKeyPair ()

168 let _, sk = generateSignKeyPair ()

168− sk |> identityFromPrivKey

169+ sk |> identityFromPrivKey |> Option.get

169

170

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

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

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

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

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

185 let private trailerLen = pubLen + sigLen

186 let private trailerLen = pubLen + sigLen

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

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

187

188

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

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

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

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

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

191+ None

194−

192+ else

193+ try

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

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

196− let ephPub, ephPriv = generateBoxKeyPair ()

195+ let ephPub, ephPriv = generateBoxKeyPair ()

197− let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

196+ let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

198− let rawSecret = scalarMult ephPriv recipientX25519Pub

197+ let rawSecret = scalarMult ephPriv recipientX25519Pub

199− let key = deriveKey ephPub recipientX25519Pub rawSecret

198+ let key = deriveKey ephPub recipientX25519Pub rawSecret

200− let nonce = getRandomBytes 24

199+ let nonce = getRandomBytes 24

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

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

202− let ciphertext = aeadEncrypt ptBytes nonce key

201+ let ciphertext = aeadEncrypt ptBytes nonce key

203− let signature = signDetached ciphertext senderPrivKey

202+ let signature = signDetached ciphertext senderPrivKey

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

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

205

216

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

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

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

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

208 None

219 None

209 else

220 else

210− try

221+ let tryDecrypt offset =

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

222+ if blob.Length < minBlobLen + offset then

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

218 None

223 None

219 else

224 else

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

220− let recipientX25519Priv = ed25519SkToCurve25519 recipientPrivKey

235+ let recipientX25519Priv = ed25519SkToCurve25519 recipientPrivKey

221− let rawSecret = scalarMult recipientX25519Priv ephPub

236+ let rawSecret = scalarMult recipientX25519Priv ephPub

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

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

223− let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

238+ let recipientX25519Pub = ed25519PkToCurve25519 recipientEd25519Pub

224− let key = deriveKey ephPub recipientX25519Pub rawSecret

239+ let key = deriveKey ephPub recipientX25519Pub rawSecret

225− let plaintext = aeadDecrypt ciphertext nonce key

240+ let plaintext = aeadDecrypt ciphertext nonce key

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

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

227− with ex ->

242+ with ex ->

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

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

229− None

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 =

92 async {

93 let payload = serializeEnvelope envelope

95− let blob =

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

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

97−

96+ | Some blob ->

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

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

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

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

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

100 }

client/Store.fs+5−7

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

192 File.ReadAllText(identityPath)

193 |> Option.ofObj

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

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

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

196 else

197 None

198 with ex ->

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

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

293 )

294 |> Async.AwaitTask

295

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

415 use conn = openConn ()

416

417 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+ )

423 |> Async.AwaitTask

421 |> Async.AwaitTask

424

422

425 return rows |> Seq.tryHead

423 return rows |> Seq.tryHead

client/Styles.fs+10−4

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

43 .Name("PART_ContentPresenter"))

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

46− let private maxBitmapCacheSize = 128

47−

48 let private bitmapCache =

46 let private bitmapCache =

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

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

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

50+

51 let cachedBitmap (bytes: byte[]) =

52 let h =

53 System.HashCode.Combine(

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

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

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

59− if bitmapCache.Count >= maxBitmapCacheSize then

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+ | _ -> ()

60− bitmapCache.Clear()

65+ | _ -> bitmapCache.Clear()

62 bitmapCache.GetOrAdd(h, fun _ ->

67 bitmapCache.GetOrAdd(h, fun _ ->

68+ bitmapInsertOrder.Enqueue(h)

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

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