13e9b38 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify server code and improve type safety: use sum types for auth/result handlers, nest prune results, eliminate dummy values and shouldInsert flag

13e9b38iko6 months ago

client/ApiClient.fs+23−25

compare with master

unifiedsplit

@@ -4,32 +4,28 @@ open System

4open System.Net.Http

5open System.Text

6open System.Text.Json

7+open System.Text.Json.Serialization

7open System.Threading.Tasks

8open System.Threading.Tasks

9module ApiClient =

10module ApiClient =

11− type EventPayload = { EncryptedBlob: string; Timestamp: int64 }

12− type PollEvent = { Id: string; Payload: EventPayload }

13−

14 [<CLIMutable>]

12 [<CLIMutable>]

15− type SendResult = { Status: string; MessageId: string }

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

16−

17− type PollResponse = { Events: PollEvent list; Cursor: uint64 }

19 [<CLIMutable>]

15 [<CLIMutable>]

20− type ChallengeResponse = { challenge: string }

16+ type PollEvent = { Id: string; EventType: string; Payload: EventPayload }

22 [<CLIMutable>]

18 [<CLIMutable>]

23− type VerifyResponse = { token: string }

19+ type SendResult = { Status: string; MessageId: string }

25 [<CLIMutable>]

21 [<CLIMutable>]

26− type PollPayloadDto = { encryptedBlob: string; timestamp: JsonElement }

22+ type PollResponse = { Cursor: uint64; Events: PollEvent array }

28 [<CLIMutable>]

24 [<CLIMutable>]

29− type PollEventDto = { id: string; eventType: string; payload: PollPayloadDto }

25+ type ChallengeResponse = { challenge: string }

31 [<CLIMutable>]

27 [<CLIMutable>]

32− type PollResponseDto = { cursor: uint64; events: PollEventDto array }

28+ type VerifyResponse = { token: string }

34 /// Awaits a Task without converting TaskCanceledException to F# async

30 /// Awaits a Task without converting TaskCanceledException to F# async

35 /// cancellation (which bypasses try...with). Re-raises it as a regular exception.

31 /// cancellation (which bypasses try...with). Re-raises it as a regular exception.

@@ -41,7 +37,18 @@ module ApiClient =

41 else ok t.Result)

37 else ok t.Result)

42 |> ignore)

38 |> ignore)

40+ type private FlexibleInt64Converter() =

41+ inherit JsonConverter<int64>()

42+ override _.Read(reader, _, _) =

43+ match reader.TokenType with

44+ | JsonTokenType.String -> Int64.Parse(reader.GetString())

45+ | _ -> reader.GetInt64()

46+ override _.Write(writer, value, _) = writer.WriteNumberValue(value)

47+

48+ let private jsonOpts =

44− let private jsonOpts = JsonSerializerOptions(PropertyNameCaseInsensitive = true)

49+ let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true)

50+ opts.Converters.Add(FlexibleInt64Converter())

51+ opts

46 let private client =

53 let private client =

47 let c = new HttpClient()

54 let c = new HttpClient()

@@ -100,19 +107,10 @@ module ApiClient =

100 let poll (serverUrl: string) (token: string) (cursor: uint64) =

107 let poll (serverUrl: string) (token: string) (cursor: uint64) =

101 async {

108 async {

102 let body = JsonSerializer.Serialize({| cursor = cursor; timeout = 30000 |})

109 let body = JsonSerializer.Serialize({| cursor = cursor; timeout = 30000 |})

103− let! response = postJson<PollResponseDto> pollClient $"{serverUrl}/poll" body (Some token)

110+ let! response = postJson<PollResponse> pollClient $"{serverUrl}/poll" body (Some token)

104−

111+ return

105− let events =

112+ { response with

106− [ for e in response.events do

113+ Events = response.Events |> Array.filter (fun e -> e.EventType = "message") }

107− if e.eventType = "message" then

108− let ts =

109− if e.payload.timestamp.ValueKind = JsonValueKind.String

110− then Int64.Parse(e.payload.timestamp.GetString())

111− else e.payload.timestamp.GetInt64()

112− { Id = e.id

113− Payload = { EncryptedBlob = e.payload.encryptedBlob; Timestamp = ts } } ]

114−

115− return { Events = events; Cursor = response.cursor }

116 }

114 }

117

115

118 let ackMessages (serverUrl: string) (token: string) (messageIds: string list) =

116 let ackMessages (serverUrl: string) (token: string) (messageIds: string list) =

client/App.fs+12−20

@@ -45,15 +45,6 @@ module App =

45 | Connecting of Identity

46 | Online of Session

48− type PollResultData =

49− { Messages: (string * ChatMessage) list

50− Status: string

51− Cursor: uint64 }

52−

53− type LoadedState =

54− | NoIdentity

55− | Loaded of identity: Identity * data: Store.DataDto option

56−

57 // ── Model ──

48 // ── Model ──

59 type Model =

50 type Model =

@@ -88,10 +79,11 @@ module App =

88 | SetNewPubkey of string

79 | SetNewPubkey of string

89 | SetNewNickname of string

80 | SetNewNickname of string

90 | DoSaveContact

81 | DoSaveContact

91− | PollResult of PollResultData

82+ | PollResult of messages: (string * ChatMessage) list * status: string * cursor: uint64

92 | CopyPubKey

83 | CopyPubKey

93 | DismissError

84 | DismissError

85+ | NoIdentityFound

94− | StateLoaded of LoadedState

86+ | StateLoaded of Identity * Store.DataDto option

96 // ── CmdMsg ──

88 // ── CmdMsg ──

@@ -216,7 +208,7 @@ module App =

216

208

217 | Sent result -> { model with LastSendStatus = $"{result.Status}:{result.MessageId}" }, []

209 | Sent result -> { model with LastSendStatus = $"{result.Status}:{result.MessageId}" }, []

218

210

219− | PollResult { Messages = incoming; Status = status; Cursor = newCursor } ->

211+ | PollResult(incoming, status, newCursor) ->

220 let model' =

212 let model' =

221 incoming

213 incoming

222 |> List.fold

214 |> List.fold

@@ -263,8 +255,8 @@ module App =

263

255

264 | DismissError -> { model with Error = None }, []

256 | DismissError -> { model with Error = None }, []

265

257

266− | StateLoaded NoIdentity -> model, []

258+ | NoIdentityFound -> model, []

267− | StateLoaded(Loaded(identity, dataOpt)) ->

259+ | StateLoaded(identity, dataOpt) ->

268 let model' = { model with Identity = Some identity; Conn = Connecting identity }

260 let model' = { model with Identity = Some identity; Conn = Connecting identity }

269

261

270 let model' =

262 let model' =

@@ -363,7 +355,7 @@ module App =

363 let! response = ApiClient.poll session.Url session.Token cursor

355 let! response = ApiClient.poll session.Url session.Token cursor

364 let messages, ackIds, errors =

356 let messages, ackIds, errors =

365 response.Events

357 response.Events

366− |> List.fold (fun (msgs, acks, errs) evt ->

358+ |> Array.fold (fun (msgs, acks, errs) evt ->

367 match decryptEvent session.Identity.PrivKey evt.Payload with

359 match decryptEvent session.Identity.PrivKey evt.Payload with

368 | Ok msg -> (msg :: msgs, evt.Id :: acks, errs)

360 | Ok msg -> (msg :: msgs, evt.Id :: acks, errs)

369 | Error err -> (msgs, acks, err :: errs))

361 | Error err -> (msgs, acks, err :: errs))

@@ -378,14 +370,14 @@ module App =

378 $"[{now}] evts:{response.Events.Length} msgs:{messages.Length} errs:{errors.Length}"

370 $"[{now}] evts:{response.Events.Length} msgs:{messages.Length} errs:{errors.Length}"

379 + (match errors with err :: _ -> $" [{err}]" | [] -> "")

371 + (match errors with err :: _ -> $" [{err}]" | [] -> "")

380

372

381− return PollResult { Messages = List.rev messages; Status = status; Cursor = response.Cursor }

373+ return PollResult(List.rev messages, status, response.Cursor)

382 with

374 with

383 | :? TimeoutException ->

375 | :? TimeoutException ->

384− return PollResult { Messages = []; Status = "polling..."; Cursor = cursor }

376+ return PollResult([], "polling...", cursor)

385 | ex ->

377 | ex ->

386 let now = DateTimeOffset.UtcNow.ToString("HH:mm:ss")

378 let now = DateTimeOffset.UtcNow.ToString("HH:mm:ss")

387 do! Async.Sleep 3000

379 do! Async.Sleep 3000

388− return PollResult { Messages = []; Status = $"[{now}] poll error: {ex.Message}"; Cursor = cursor }

380+ return PollResult([], $"[{now}] poll error: {ex.Message}", cursor)

389 })

381 })

390

382

391 | CmdCopyToClipboard text ->

383 | CmdCopyToClipboard text ->

@@ -397,10 +389,10 @@ module App =

397 asyncCmd (async {

389 asyncCmd (async {

398 let! identity = Store.loadIdentity ()

390 let! identity = Store.loadIdentity ()

399 match identity with

391 match identity with

400− | None -> return StateLoaded NoIdentity

392+ | None -> return NoIdentityFound

401 | Some id ->

393 | Some id ->

402 let data = Store.loadData ()

394 let data = Store.loadData ()

403− return StateLoaded(Loaded(id, data))

395+ return StateLoaded(id, data)

404 })

396 })

405

397

406 | CmdSaveIdentity identity ->

398 | CmdSaveIdentity identity ->

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

Binary file not shown.

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

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.app/Contents/_CodeSignature/CodeResources+2−2

@@ -240,14 +240,14 @@

240 <dict>

241 <key>hash2</key>

242 <data>

243− Tb9gTNQn0vC6xYnphz/SPqKOypsS1ii7ovZ7S6s4QoY=

243+ kz4trELqvTzwqCWvJX0TwklUlGDMQ7PmstX/wX+L1ys=

244 </data>

245 </dict>

246 <key>MonoBundle/Skrepka.pdb</key>

247 <dict>

248 <key>hash2</key>

249 <data>

250− k0t0cbTVWz/CfZ4rlDzYjSX4lniTHLZRvz2UrUCSZdM=

250+ R15BgIEVnOLSGbnwifZrUZ3UxFh8o3aOr8vzoOqfToE=

251 </data>

252 </dict>

253 <key>MonoBundle/Sodium.Core.dll</key>

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+f11ecd2201e52dce49ef2d913500531961808e00")>]

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

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−90103b2909e2d6c308fd0241aa80b308b414d7047eeca8cef6ba5f4642cdf15a

1+64ef513869c07b61515326591a2ef70b3274d7205ba59736fabaf7a6219440eb

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/f11ecd2201e52dce49ef2d913500531961808e00/*"}}

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

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+67−53

@@ -655,8 +655,9 @@ pruneAndRetry = \t -> do

655 forwards <- *forwards

656 ackedIds <- *ackedIds

657 let pendingAcks = do a <- ackedIds; where isFederatedOrigin a.originServer; yield a

658− yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}

658+ yield {pr: pr, pendingForwards: forwards, pendingAcks: pendingAcks}

659+ let pr = result.pr

659− broadcastOfflineGossip t result.peerServers result.expiredLocal

660+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal

660 when (federationEnabled && count result.pendingForwards > 0)

661 when (federationEnabled && count result.pendingForwards > 0)

661 (retryPendingForwards result.pendingForwards)

662 (retryPendingForwards result.pendingForwards)

662 when (federationEnabled && count result.pendingAcks > 0) (do

663 when (federationEnabled && count result.pendingAcks > 0) (do

@@ -748,7 +749,7 @@ serve = \req -> case req of

748 Nothing {} -> False {}

749 Nothing {} -> False {}

749 _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)

750 _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)

750 if not sigValid

751 if not sigValid

751− then yield {sigValid: False {}, peerServers: [], expiredLocal: pr.expiredLocal, offlinePeers: pr.peerServers}

752+ then yield VerifyFailed {pr: pr}

752 else do

753 else do

753 set *challenges = do

754 set *challenges = do

754 c <- challenges

755 c <- challenges

@@ -768,21 +769,24 @@ serve = \req -> case req of

768 let peerServers = if federationEnabled

769 let peerServers = if federationEnabled

769 then collectPeerServers updatedPresence (\p -> p.server)

770 then collectPeerServers updatedPresence (\p -> p.server)

770 else []

771 else []

771− yield {sigValid: True {}, peerServers: peerServers, expiredLocal: pr.expiredLocal, offlinePeers: pr.peerServers}

772+ yield VerifyOk {peerServers: peerServers, pr: pr}

772− fork (do

773+ fork (case result of

774+ VerifyFailed {pr} ->

775+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal

776+ VerifyOk {peerServers, pr} -> do

773− when (result.sigValid && federationEnabled)

777+ when federationEnabled

774− (sendToEach result.peerServers (\server -> do

778+ (sendToEach peerServers (\server -> do

775− _ <- fetch (federationScheme ++ server) (RecvGossip {

779+ _ <- fetch (federationScheme ++ server) (RecvGossip {

776− authorization: "Bearer " ++ federationSecret,

780+ authorization: "Bearer " ++ federationSecret,

777− events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})

781+ events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})

778− yield {}))

782+ yield {}))

779− broadcastOfflineGossip t result.offlinePeers (do

783+ broadcastOfflineGossip t pr.peerServers (do

780− p <- result.expiredLocal

784+ p <- pr.expiredLocal

781− where not (result.sigValid && p.pubkey == pubkey)

785+ where not (p.pubkey == pubkey)

782− yield p))

786+ yield p))

783− yield (if result.sigValid

787+ yield (case result of

788+ VerifyFailed _ -> respond {token: "", expiresAt: 0}

784− then respond {token: token, expiresAt: expiry}

789+ VerifyOk _ -> respond {token: token, expiresAt: expiry})

785− else respond {token: "", expiresAt: 0})

786

790

787 Poll {cursor, timeout, authorization, respond} -> do

791 Poll {cursor, timeout, authorization, respond} -> do

788 t <- now

792 t <- now

@@ -808,7 +812,7 @@ serve = \req -> case req of

808 let auth = authenticateSession sessions (extractToken authorization) t

812 let auth = authenticateSession sessions (extractToken authorization) t

809 case auth of

813 case auth of

810 Unauthorized {} ->

814 Unauthorized {} ->

811− yield {status: "unauthorized", shouldInsert: False {}, remoteServers: [], fromKey: "", expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

815+ yield SendUnauthorized {pr: pr}

812 Authorized {pubkey: fromKey} -> do

816 Authorized {pubkey: fromKey} -> do

813 messages <- *messages

817 messages <- *messages

814 presence <- *presence

818 presence <- *presence

@@ -833,21 +837,26 @@ serve = \req -> case req of

833 set *forwards = if shouldInsert && federationEnabled && count forwardServers > 0

837 set *forwards = if shouldInsert && federationEnabled && count forwardServers > 0

834 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

838 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

835 else forwards

839 else forwards

836− yield {status: status, shouldInsert: shouldInsert, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

840+ yield SendDone {status: status, remoteServers: remoteServers, fromKey: fromKey, pr: pr}

837− fork (do

841+ fork (case result of

842+ SendUnauthorized {pr} ->

843+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal

844+ SendDone {status, remoteServers, fromKey, pr} -> do

838− when (count result.remoteServers > 0 && result.shouldInsert && federationEnabled)

845+ when (count remoteServers > 0 && not (status == "rejected") && federationEnabled)

839− (sendToEach result.remoteServers (\server -> do

846+ (sendToEach remoteServers (\server -> do

840− fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {

847+ fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {

841− toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,

848+ toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob,

842− timestamp: clampedTs, originServer: serverHostN, messageId: msgId,

849+ timestamp: clampedTs, originServer: serverHostN, messageId: msgId,

843− authorization: "Bearer " ++ federationSecret})

850+ authorization: "Bearer " ++ federationSecret})

844− case fwdResult of

851+ case fwdResult of

845− Ok _ -> removeForward msgId server

852+ Ok _ -> removeForward msgId server

846− Err _ -> yield {}))

853+ Err _ -> yield {}))

847− when (result.status == "queued" && count result.remoteServers > 0 && result.shouldInsert && federationEnabled)

854+ when (status == "queued" && count remoteServers > 0 && federationEnabled)

848− (println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking"))

855+ (println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking"))

849− broadcastOfflineGossip t result.peerServers result.expiredLocal)

856+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal)

850− yield (respond {status: result.status, messageId: if result.shouldInsert then msgId else ""})

857+ yield (case result of

858+ SendUnauthorized _ -> respond {status: "unauthorized", messageId: ""}

859+ SendDone {status, remoteServers, fromKey, pr} -> respond {status: status, messageId: if status == "rejected" then "" else msgId})

851

860

852 AckMessages {messageIds, authorization, respond} -> do

861 AckMessages {messageIds, authorization, respond} -> do

853 t <- now

862 t <- now

@@ -858,7 +867,7 @@ serve = \req -> case req of

858 let auth = authenticateSession sessions (extractToken authorization) t

867 let auth = authenticateSession sessions (extractToken authorization) t

859 case auth of

868 case auth of

860 Unauthorized {} ->

869 Unauthorized {} ->

861− yield {ok: False {}, pendingAcks: [], expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: []}

870+ yield AckUnauthorized {pr: pr}

862 Authorized {pubkey} -> do

871 Authorized {pubkey} -> do

863 messages <- *messages

872 messages <- *messages

864 let ackedMessages = do

873 let ackedMessages = do

@@ -880,15 +889,17 @@ serve = \req -> case req of

880 let evictedEntries = if excessCount <= 0 then []

889 let evictedEntries = if excessCount <= 0 then []

881 else diff combinedAckedIds afterEviction

890 else diff combinedAckedIds afterEviction

882 set *ackedIds = afterEviction

891 set *ackedIds = afterEviction

883− yield {ok: True {}, pendingAcks: ackedFederated, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: evictedEntries}

892+ yield AckDone {pendingAcks: ackedFederated, pr: pr, evictedEntries: evictedEntries}

893+ fork (case result of

894+ AckUnauthorized {pr} ->

895+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal

896+ AckDone {pendingAcks, pr, evictedEntries} -> do

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

897+ let originServers = collectPeerServers pendingAcks (\a -> a.originServer)

885− fork (do

886− when result.ok (do

887 when (count originServers > 0 && federationEnabled)

898 when (count originServers > 0 && federationEnabled)

888− (sendAcksAndClean result.pendingAcks originServers)

899+ (sendAcksAndClean pendingAcks originServers)

889 let evictedToRetry = do

900 let evictedToRetry = do

890− a <- result.evictedEntries

901+ a <- evictedEntries

891− where none result.pendingAcks (\a2 -> a2.messageId == a.messageId && a2.toKey == a.toKey)

902+ where none pendingAcks (\a2 -> a2.messageId == a.messageId && a2.toKey == a.toKey)

892 yield a

903 yield a

893 when (count evictedToRetry > 0 && federationEnabled) (do

904 when (count evictedToRetry > 0 && federationEnabled) (do

894 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

905 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

@@ -910,9 +921,11 @@ serve = \req -> case req of

910 yield excess

921 yield excess

911 when (dropped > 0)

922 when (dropped > 0)

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

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

913− _ -> yield {})))

924+ _ -> yield {}))

914− broadcastOfflineGossip t result.peerServers result.expiredLocal)

925+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal)

915− yield (respond {ok: result.ok})

926+ yield (case result of

927+ AckUnauthorized _ -> respond {ok: False {}}

928+ AckDone _ -> respond {ok: True {}})

916

929

917 LookupPresence {pubkey, authorization, respond} -> do

930 LookupPresence {pubkey, authorization, respond} -> do

918 let pubkey = normalizeHex pubkey

931 let pubkey = normalizeHex pubkey

@@ -923,7 +936,7 @@ serve = \req -> case req of

923 let auth = authenticateSession sessions (extractToken authorization) t

936 let auth = authenticateSession sessions (extractToken authorization) t

924 case auth of

937 case auth of

925 Unauthorized {} ->

938 Unauthorized {} ->

926− yield {foundServer: "", authorized: False {}, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

939+ yield {foundServer: "", authorized: False {}, pr: pr}

927 Authorized _ -> do

940 Authorized _ -> do

928 presence <- *presence

941 presence <- *presence

929 let valid = do

942 let valid = do

@@ -934,8 +947,8 @@ serve = \req -> case req of

934 let foundServer = if any valid (\p -> p.server == serverHostN)

947 let foundServer = if any valid (\p -> p.server == serverHostN)

935 then serverHostN

948 then serverHostN

936 else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

949 else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

937− yield {foundServer: foundServer, authorized: True {}, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

950+ yield {foundServer: foundServer, authorized: True {}, pr: pr}

938− forkBroadcastOffline t result

951+ forkBroadcastOffline t result.pr

939 yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})

952 yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})

940

953

941 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do

954 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do

@@ -998,7 +1011,7 @@ serve = \req -> case req of

998 let finalPresence = if validRequest then capResult.finalPresence else presence

1011 let finalPresence = if validRequest then capResult.finalPresence else presence

999 set *presence = finalPresence

1012 set *presence = finalPresence

1000 let gossipPeerServers = collectPeerServers finalPresence (\p -> p.server)

1013 let gossipPeerServers = collectPeerServers finalPresence (\p -> p.server)

1001− yield {appliedKeys: union capResult.appliedOnline appliedOffline, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, gossipPeerServers: gossipPeerServers, withinCapacity: withinCapacity}

1014+ yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: withinCapacity}

1002 let effectiveEvents = do

1015 let effectiveEvents = do

1003 e <- union filteredOnline filteredOffline

1016 e <- union filteredOnline filteredOffline

1004 where any gossipResult.appliedKeys (\a -> samePubkeyServer a e)

1017 where any gossipResult.appliedKeys (\a -> samePubkeyServer a e)

@@ -1016,7 +1029,8 @@ serve = \req -> case req of

1016 authorization: "Bearer " ++ federationSecret,

1029 authorization: "Bearer " ++ federationSecret,

1017 events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHostN})

1030 events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHostN})

1018 yield {}))

1031 yield {}))

1032+ let pr = gossipResult.pr

1019− broadcastOfflineGossip t gossipResult.peerServers gossipResult.expiredLocal)

1033+ broadcastOfflineGossip t pr.peerServers pr.expiredLocal)

1020 yield (respond {ok: validRequest})

1034 yield (respond {ok: validRequest})

1021

1035

1022 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do

1036 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do

@@ -1047,8 +1061,8 @@ serve = \req -> case req of

1047 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

1061 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

1048 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]

1062 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]

1049 else messages

1063 else messages

1050− yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, ok: shouldInsert || alreadyExists}

1064+ yield {pr: pr, ok: shouldInsert || alreadyExists}

1051− forkBroadcastOffline t result

1065+ forkBroadcastOffline t result.pr

1052 yield (respond {ok: result.ok})

1066 yield (respond {ok: result.ok})

1053

1067

1054 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do

1068 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do

@@ -1070,7 +1084,7 @@ serve = \req -> case req of

1070 set *forwards = if validAck

1084 set *forwards = if validAck

1071 then diff forwards forwardsToRemove

1085 then diff forwards forwardsToRemove

1072 else forwards

1086 else forwards

1073− yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal}

1087+ yield pr

1074 forkBroadcastOffline t pruneResult

1088 forkBroadcastOffline t pruneResult

1075 yield (respond {ok: validAck})

1089 yield (respond {ok: validAck})

1076

1090