50200f4 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Improve type safety and simplify code: use `data` for all union types, add wildcard patterns, inline unused helpers

50200f4iko6 months ago

client/App.fs+39−49

compare with master

unifiedsplit

@@ -37,10 +37,8 @@ module App =

37 | NoIdentity

38 | Identified of identity: Identity * conn: ConnStatus

40− type IncomingMessage = { SenderPubkey: string; Message: ChatMessage }

41−

42 type DecryptedEvent =

40 type DecryptedEvent =

43− | IncomingChat of IncomingMessage

41+ | IncomingChat of senderPubkey: string * message: ChatMessage

44 | IncomingDeliveryAck of senderPubkey: string * ackIds: string list

42 | IncomingDeliveryAck of senderPubkey: string * ackIds: string list

45 | IncomingProfile of senderPubkey: string * displayName: string * bio: string * photo: string option

43 | IncomingProfile of senderPubkey: string * displayName: string * bio: string * photo: string option

@@ -138,8 +136,8 @@ module App =

138 |> List.tryFind (fun c -> c.Pubkey = pk)

136 |> List.tryFind (fun c -> c.Pubkey = pk)

139 |> Option.map (fun c ->

137 |> Option.map (fun c ->

140 if c.Nickname <> fallback then c.Nickname

138 if c.Nickname <> fallback then c.Nickname

141− elif not (String.IsNullOrEmpty c.DisplayName) then c.DisplayName

139+ elif c.DisplayName <> "" then c.DisplayName

142− else c.Nickname)

140+ else fallback)

143 |> Option.defaultValue fallback

141 |> Option.defaultValue fallback

144

142

145 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =

143 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =

@@ -261,13 +259,12 @@ module App =

261 Page = Chat(pk, "")

259 Page = Chat(pk, "")

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

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

263

261

262+ model',

264− let cmds = [ CmdSend(session, pk, compose, id); saveCmdMsg model' ]

263+ [ CmdSend(session, pk, compose, id)

265− let cmds =

264+ saveCmdMsg model'

266− match model.Profile, isFirstInteraction with

265+ match model.Profile, isFirstInteraction with

267− | Some profile, true -> cmds @ [ CmdSendProfileToAll(session, profile, [ pk ]) ]

266+ | Some profile, true -> CmdSendProfileToAll(session, profile, [ pk ])

268− | _ -> cmds

267+ | _ -> () ]

269−

270− model', cmds

271 | _ -> model, []

268 | _ -> model, []

272

269

273 | SendFailed err -> { model with Error = Some err }, []

270 | SendFailed err -> { model with Error = Some err }, []

@@ -279,10 +276,10 @@ module App =

279 |> List.fold

276 |> List.fold

280 (fun (m: Model) evt ->

277 (fun (m: Model) evt ->

281 match evt with

278 match evt with

282− | IncomingChat msg ->

279+ | IncomingChat(senderPubkey, message) ->

283 { m with

280 { m with

284− Contacts = m.Contacts |> addContactIfNew { Pubkey = msg.SenderPubkey; Nickname = truncKey msg.SenderPubkey; DisplayName = null; Bio = null; PhotoBase64 = null }

281+ Contacts = m.Contacts |> addContactIfNew { Pubkey = senderPubkey; Nickname = truncKey senderPubkey; DisplayName = ""; Bio = ""; PhotoBase64 = "" }

285− Messages = m.Messages |> appendMessage msg.SenderPubkey msg.Message }

282+ Messages = m.Messages |> appendMessage senderPubkey message }

286 | IncomingDeliveryAck(senderPubkey, ackIds) ->

283 | IncomingDeliveryAck(senderPubkey, ackIds) ->

287 { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }

284 { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }

288 | IncomingProfile(senderPubkey, displayName, bio, photo) ->

285 | IncomingProfile(senderPubkey, displayName, bio, photo) ->

@@ -291,7 +288,7 @@ module App =

291 m.Contacts

288 m.Contacts

292 |> List.map (fun c ->

289 |> List.map (fun c ->

293 if c.Pubkey = senderPubkey then

290 if c.Pubkey = senderPubkey then

294− { c with DisplayName = displayName; Bio = bio; PhotoBase64 = photo |> Option.defaultValue null }

291+ { c with DisplayName = displayName; Bio = bio; PhotoBase64 = photo |> Option.defaultValue "" }

295 else c) })

292 else c) })

296 { model with PollStatus = status; PollCursor = newCursor }

293 { model with PollStatus = status; PollCursor = newCursor }

297

294

@@ -311,7 +308,7 @@ module App =

311 let contact: Contact =

308 let contact: Contact =

312 match existing with

309 match existing with

313 | Some e -> { e with Nickname = cnn }

310 | Some e -> { e with Nickname = cnn }

314− | None -> { Pubkey = hex; Nickname = cnn; DisplayName = null; Bio = null; PhotoBase64 = null }

311+ | None -> { Pubkey = hex; Nickname = cnn; DisplayName = ""; Bio = ""; PhotoBase64 = "" }

315

312

316 let model' =

313 let model' =

317 { model with

314 { model with

@@ -350,13 +347,11 @@ module App =

350 match model.Page with

347 match model.Page with

351 | EditProfile(name, bio, photo) ->

348 | EditProfile(name, bio, photo) ->

352 let profile: Profile = { DisplayName = name; Bio = bio; PhotoBase64 = photo }

349 let profile: Profile = { DisplayName = name; Bio = bio; PhotoBase64 = photo }

350+ { model with Profile = Some profile; Page = Settings },

353− let cmds = [ CmdSaveProfile profile ]

351+ [ CmdSaveProfile profile

354− let cmds =

355− match trySession model with

352+ match trySession model with

356− | Some session ->

357− cmds @ [ CmdSendProfileToAll(session, profile, model.Contacts |> List.map _.Pubkey) ]

353+ | Some session -> CmdSendProfileToAll(session, profile, model.Contacts |> List.map _.Pubkey)

358− | None -> cmds

354+ | None -> () ]

359− { model with Profile = Some profile; Page = Settings }, cmds

360 | _ -> model, []

355 | _ -> model, []

361

356

362 | StateLoaded(IdentityAndData(identity, data, profile)) ->

357 | StateLoaded(IdentityAndData(identity, data, profile)) ->

@@ -397,6 +392,14 @@ module App =

397 | ProfileMessage(id, displayName, bio, photo) ->

392 | ProfileMessage(id, displayName, bio, photo) ->

398 JsonSerializer.Serialize({| ``type`` = "profile"; id = id; timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = displayName; bio = bio; photo = (photo |> Option.defaultValue null) |})

393 JsonSerializer.Serialize({| ``type`` = "profile"; id = id; timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = displayName; bio = bio; photo = (photo |> Option.defaultValue null) |})

399

394

395+ let private sendEnvelope (session: Session) (recipientHex: string) (envelope: Envelope) =

396+ async {

397+ let payload = serializeEnvelope envelope

398+ let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex recipientHex) payload

399+ let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()

400+ return! sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts

401+ }

402+

400 let private parseEnvelope (json: string) =

403 let private parseEnvelope (json: string) =

401 use doc = JsonDocument.Parse(json)

404 use doc = JsonDocument.Parse(json)

402 let root = doc.RootElement

405 let root = doc.RootElement

@@ -427,13 +430,11 @@ module App =

427 | Some(plaintext, senderHex) ->

430 | Some(plaintext, senderHex) ->

428 match parseEnvelope plaintext with

431 match parseEnvelope plaintext with

429 | Some(TextMessage(id, body)) ->

432 | Some(TextMessage(id, body)) ->

430− Ok(IncomingChat

433+ Ok(IncomingChat(senderHex,

431− { SenderPubkey = senderHex

432− Message =

433− { Id = id; Body = body

434+ { Id = id; Body = body

434− Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)

435+ Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)

435− IsOutgoing = false

436+ IsOutgoing = false

436− Status = DeliveryStatus.Delivered } })

437+ Status = DeliveryStatus.Delivered }))

437 | Some(DeliveryAck(_, ackIds)) ->

438 | Some(DeliveryAck(_, ackIds)) ->

438 Ok(IncomingDeliveryAck(senderHex, ackIds))

439 Ok(IncomingDeliveryAck(senderHex, ackIds))

439 | Some(ProfileMessage(_, displayName, bio, photo)) ->

440 | Some(ProfileMessage(_, displayName, bio, photo)) ->

@@ -447,15 +448,12 @@ module App =

447 async {

448 async {

448 let chatsBySender =

449 let chatsBySender =

449 events

450 events

450− |> List.choose (function IncomingChat msg -> Some(msg.SenderPubkey, msg.Message.Id) | _ -> None)

451+ |> List.choose (function IncomingChat(senderPubkey, msg) -> Some(senderPubkey, msg.Id) | _ -> None)

451 |> List.groupBy fst

452 |> List.groupBy fst

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

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

453

454

454 for sender, msgIds in chatsBySender do

455 for sender, msgIds in chatsBySender do

455− try

456− let ackPayload = serializeEnvelope (DeliveryAck(Guid.NewGuid().ToString(), msgIds))

456+ try do! sendEnvelope session sender (DeliveryAck(Guid.NewGuid().ToString(), msgIds)) |> Async.Ignore

457− let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex sender) ackPayload

458− do! sendMessage session.Url session.Token sender (Crypto.toHex blob) (DateTimeOffset.UtcNow.ToUnixTimeSeconds()) |> Async.Ignore

459 with _ -> ()

457 with _ -> ()

460 }

458 }

461

459

@@ -473,12 +471,7 @@ module App =

473 | CmdSend(session, recipientHex, text, messageId) ->

471 | CmdSend(session, recipientHex, text, messageId) ->

474 asyncCmd (async {

472 asyncCmd (async {

475 try

473 try

476− let recipPub = Crypto.fromHex recipientHex

477− let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()

478− let payload = serializeEnvelope (TextMessage(messageId, text))

474+ let! status = sendEnvelope session recipientHex (TextMessage(messageId, text))

479− let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload

480− let! status = sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts

481−

482 match messageStatusToError status with

475 match messageStatusToError status with

483 | Some err -> return SendFailed err

476 | Some err -> return SendFailed err

484 | None -> return SendOk

477 | None -> return SendOk

@@ -567,10 +560,7 @@ module App =

567 Cmd.ofEffect (fun _ ->

560 Cmd.ofEffect (fun _ ->

568 async {

561 async {

569 for recipientHex in recipientHexes do

562 for recipientHex in recipientHexes do

570− try

571− let payload = serializeEnvelope (ProfileMessage(Guid.NewGuid().ToString(), profile.DisplayName, profile.Bio, profile.PhotoBase64))

563+ try do! sendEnvelope session recipientHex (ProfileMessage(Guid.NewGuid().ToString(), profile.DisplayName, profile.Bio, profile.PhotoBase64)) |> Async.Ignore

572− let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex recipientHex) payload

573− do! sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) (DateTimeOffset.UtcNow.ToUnixTimeSeconds()) |> Async.Ignore

574 with _ -> ()

564 with _ -> ()

575 } |> Async.Start)

565 } |> Async.Start)

576

566

@@ -630,11 +620,11 @@ module App =

630

620

631 Label("Profile:").font(size = 18.)

621 Label("Profile:").font(size = 18.)

632 match model.Profile with

622 match model.Profile with

633− | Some profile when not (String.IsNullOrEmpty profile.DisplayName) ->

623+ | Some profile when profile.DisplayName <> "" ->

634 Label($"Name: {profile.DisplayName}").font(size = 14.)

624 Label($"Name: {profile.DisplayName}").font(size = 14.)

635 | _ -> ()

625 | _ -> ()

636 match model.Profile with

626 match model.Profile with

637− | Some profile when not (String.IsNullOrEmpty profile.Bio) ->

627+ | Some profile when profile.Bio <> "" ->

638 Label($"Bio: {profile.Bio}").font(size = 14.).textColor(Colors.DimGray)

628 Label($"Bio: {profile.Bio}").font(size = 14.).textColor(Colors.DimGray)

639 | _ -> ()

629 | _ -> ()

640 let profilePage =

630 let profilePage =

@@ -773,7 +763,7 @@ module App =

773 viewErrorBanner model.Error

763 viewErrorBanner model.Error

774

764

775 match photo with

765 match photo with

776− | Some p when not (String.IsNullOrEmpty p) ->

766+ | Some p when p <> "" ->

777 Image(new MemoryStream(Convert.FromBase64String(p)) :> Stream)

767 Image(new MemoryStream(Convert.FromBase64String(p)) :> Stream)

778 .width(120.)

768 .width(120.)

779 .height(120.)

769 .height(120.)

client/Store.fs+8−1

@@ -115,7 +115,14 @@ module Store =

115 settings

116 |> Option.ofObj

117 |> Option.map (fun settings ->

118+ let contacts =

118− let contacts = db.GetCollection<Contact>("contacts").FindAll() |> Seq.toList

119+ db.GetCollection<Contact>("contacts").FindAll()

120+ |> Seq.map (fun c ->

121+ { c with

122+ DisplayName = c.DisplayName |> Option.ofObj |> Option.defaultValue ""

123+ Bio = c.Bio |> Option.ofObj |> Option.defaultValue ""

124+ PhotoBase64 = c.PhotoBase64 |> Option.ofObj |> Option.defaultValue "" })

125+ |> Seq.toList

119

126

120 let messages =

127 let messages =

121 db.GetCollection<MessageDoc>("messages").FindAll()

128 db.GetCollection<MessageDoc>("messages").FindAll()

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfo.fs+1−1

@@ -10,7 +10,7 @@ open System.Reflection

10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]

11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]

12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]

13−[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+fec9263421fbac32ef5f434448cbad4cca707ffa")>]

13+[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+4471c7ea728053f905aa06e4d51de8c7e2de1550")>]

14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]

15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]

16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfoInputs.cache+1−1

@@ -1 +1 @@

1−ffbafc0ee7b3b70864bc0f4e57e320aaf92479c321cb705524064b7744b15e7c

1+c25af9bb478fcf0a0ce68966144888db2fe1a3af16d82c8904c7a0f73a3d108d

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.sourcelink.json+1−1

@@ -1 +1 @@

1−{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/fec9263421fbac32ef5f434448cbad4cca707ffa/*"}}

1+{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/4471c7ea728053f905aa06e4d51de8c7e2de1550/*"}}

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/ref/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/refint/Skrepka.dll

Binary file not shown.

server.knot+25−27

@@ -50,7 +50,7 @@ federationEnabled = federationSecret != ""

51type PollEvent = {id: MessageIdHex, eventType: Text, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}

53−type GossipEventType = GossipOnline {} | GossipOffline {} | GossipUnknown {}

53+data GossipEventType = GossipOnline {} | GossipOffline {} | GossipUnknown {}

55impl ToJSON GossipEventType where

56 toJson et = toJson (case et of

@@ -73,7 +73,7 @@ type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: Serve

74type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}

76−type MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {}

76+data MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {}

78messageStatusText = \ms -> case ms of

79 MsDelivered {} -> "delivered"

@@ -91,7 +91,7 @@ type MessageIdHex = Text where isValidMessageId

91type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s

92isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)

93type ServerName = Text where isValidServerName

94−type MessageOrigin = LocalOrigin {} | FederatedOrigin {server: ServerName}

94+data MessageOrigin = LocalOrigin {} | FederatedOrigin {server: ServerName}

95type AnyServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s

97type Timestamp = Int<Ms>

@@ -102,13 +102,13 @@ type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, e

102type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}

103type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}

104type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}

105−type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

105+data AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

106−type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: MessageStatus, remoteServers: [ServerName], fromKey: PubkeyHex}

106+data SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: MessageStatus, remoteServers: [ServerName], fromKey: PubkeyHex}

107−type VerifyResult = VerifyFailed {} | VerifyOk {peerServers: [ServerName]}

107+data VerifyResult = VerifyFailed {} | VerifyOk {peerServers: [ServerName]}

108−type AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}

108+data AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}

109−type LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}

109+data LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}

110−type ForwardResult = ForwardDuplicate {} | ForwardStored {} | ForwardFull {}

110+data ForwardResult = ForwardDuplicate {} | ForwardStored {} | ForwardFull {}

111−type PollResult = PollUnauthorized {} | PollDone {events: [PollEvent], cursor: Timestamp}

111+data PollResult = PollUnauthorized {} | PollDone {events: [PollEvent], cursor: Timestamp}

112

113

114-- ============================================

@@ -386,9 +386,6 @@ clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp

386

387nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1

388

389−isFederatedOrigin = \origin -> case origin of FederatedOrigin _ -> True {}; _ -> False {}

390−originServerName = \origin -> case origin of FederatedOrigin {server} -> server; LocalOrigin {} -> ""

391−

392takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items

389takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items

393

390

394dedupMessageIds = \messageIds ->

391dedupMessageIds = \messageIds ->

@@ -407,7 +404,8 @@ boundedSmallest = \items n getKey ->

407 if newSize > acc.size

404 if newSize > acc.size

408 then {size: newSize, heap: newHeap, heapMax: Just {value: case acc.heapMax of

405 then {size: newSize, heap: newHeap, heapMax: Just {value: case acc.heapMax of

409 Nothing {} -> k

406 Nothing {} -> k

410− Just {value: v} -> max k v}}

407+ Just {value: v} -> max k v

408+ }}

411 else acc

409 else acc

412 else case acc.heapMax of

410 else case acc.heapMax of

413 Nothing {} -> acc

411 Nothing {} -> acc

@@ -421,7 +419,8 @@ boundedSmallest = \items n getKey ->

421 let newHeap = union removed.items [a] in

419 let newHeap = union removed.items [a] in

422 let newMax = fold (\best x -> Just {value: case best of

420 let newMax = fold (\best x -> Just {value: case best of

423 Nothing {} -> getKey x

421 Nothing {} -> getKey x

424− Just {value: v} -> max (getKey x) v}) Nothing {} newHeap in

422+ Just {value: v} -> max (getKey x) v

423+ }) Nothing {} newHeap in

425 {size: acc.size, heap: newHeap, heapMax: newMax}

424 {size: acc.size, heap: newHeap, heapMax: newMax}

426 else acc) {size: 0, heap: [], heapMax: Nothing {}} items).heap

425 else acc) {size: 0, heap: [], heapMax: Nothing {}} items).heap

427

426

@@ -440,7 +439,8 @@ safeCompare = \a b ->

440evictOneOldest = \items getKey ->

439evictOneOldest = \items getKey ->

441 let oldest = fold (\acc x -> let k = getKey x in Just {value: case acc of

440 let oldest = fold (\acc x -> let k = getKey x in Just {value: case acc of

442 Nothing {} -> k

441 Nothing {} -> k

443− Just {value: v} -> min k v}) Nothing {} items in

442+ Just {value: v} -> min k v

443+ }) Nothing {} items in

444 case oldest of

445 Nothing {} -> items

446 Just {value: oldestKey} ->

@@ -662,8 +662,9 @@ sendBatchedAcksToServer = \serverAcks server ->

662 where not (a.originServer == server && any batch (\sa -> sa.messageId == a.messageId && sa.toKey == a.toKey))

663 yield a))

664

665−sendAcksAndClean : [{messageId: MessageIdHex, toKey: PubkeyHex, originServer: ServerName, | a}] -> [ServerName] -> IO {network} {}

665+sendAcksAndClean : [{messageId: MessageIdHex, toKey: PubkeyHex, originServer: ServerName, | a}] -> IO {network} {}

666−sendAcksAndClean = \pendingAcks servers ->

666+sendAcksAndClean = \pendingAcks ->

667+ let servers = collectPeerServers pendingAcks (\a -> a.originServer) in

667 sendToEach servers (\server ->

668 sendToEach servers (\server ->

668 sendBatchedAcksToServer (do a <- pendingAcks; where a.originServer == server; yield a) server)

669 sendBatchedAcksToServer (do a <- pendingAcks; where a.originServer == server; yield a) server)

669

670

@@ -692,7 +693,7 @@ retryEvictedAcks = \evictedEntries pendingAcks ->

692 yield excess

693 yield excess

693 when (dropped > 0)

694 when (dropped > 0)

694 (println ("ackMessages: ackedIds at capacity (" ++ show maxAckedIds ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server))

695 (println ("ackMessages: ackedIds at capacity (" ++ show maxAckedIds ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server))

695− _ -> yield {})

696+ Ok _ -> yield {})

696

697

697pruneAndRetry = \t -> do

698pruneAndRetry = \t -> do

698 result <- atomic do

699 result <- atomic do

@@ -705,8 +706,7 @@ pruneAndRetry = \t -> do

705 broadcastOfflineGossip t result.peerServers result.expiredLocal

706 broadcastOfflineGossip t result.peerServers result.expiredLocal

706 when federationEnabled (do

707 when federationEnabled (do

707 retryPendingForwards result.pendingForwards

708 retryPendingForwards result.pendingForwards

708− let ackOriginServers = collectPeerServers result.pendingAcks (\a -> a.originServer)

709− sendAcksAndClean result.pendingAcks ackOriginServers)

709+ sendAcksAndClean result.pendingAcks)

710

711pollOnce = \token cursor -> do

712 t <- now

@@ -892,10 +892,9 @@ serve = \req -> case req of

892 where m.toKey == pubkey && any dedupedIds (\mid -> m.messageId == mid)

893 yield m

894 set *messages = diff messages ackedMessages

895− let ackedFederated = do

895+ let ackedFederated = fold (\acc m -> case m.origin of

896− m <- ackedMessages

897− where isFederatedOrigin m.origin

898− yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: originServerName m.origin}

896+ FederatedOrigin {server} -> union acc [{messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: server}]

897+ LocalOrigin {} -> acc) [] ackedMessages

899 ackedIds <- *ackedIds

898 ackedIds <- *ackedIds

900 let combinedAckedIds = union ackedIds ackedFederated

899 let combinedAckedIds = union ackedIds ackedFederated

901 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in

900 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in

@@ -906,8 +905,7 @@ serve = \req -> case req of

906 case result.ack of

905 case result.ack of

907 AckDone {pendingAcks, evictedEntries} ->

906 AckDone {pendingAcks, evictedEntries} ->

908 when federationEnabled (do

907 when federationEnabled (do

909− let originServers = collectPeerServers pendingAcks (\a -> a.originServer)

910− sendAcksAndClean pendingAcks originServers

908+ sendAcksAndClean pendingAcks

911 retryEvictedAcks evictedEntries pendingAcks)

909 retryEvictedAcks evictedEntries pendingAcks)

912 _ -> yield {}

910 _ -> yield {}

913 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)

911 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)