b1414f5 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: add DeliveryStatus, inline result ADTs, factor retryEvictedAcks, type route params as Timestamp

b1414f5iko6 months ago

client/ApiClient.fs+6−15

compare with master

unifiedsplit

@@ -86,9 +86,6 @@ module ApiClient =

86 | _ -> return text

87 }

89− let private post httpClient url body token =

90− sendRequest httpClient url body token |> Async.Ignore

91−

92 let private postJson<'T> httpClient url body token =

89 let private postJson<'T> httpClient url body token =

93 async {

90 async {

94 let! text = sendRequest httpClient url body token

91 let! text = sendRequest httpClient url body token

@@ -107,22 +104,16 @@ module ApiClient =

107 }

104 }

108

105

109 let sendMessage (serverUrl: string) (token: string) (toHex: string) (blobHex: string) (timestamp: int64) =

106 let sendMessage (serverUrl: string) (token: string) (toHex: string) (blobHex: string) (timestamp: int64) =

110− async {

111− let body = JsonSerializer.Serialize({| ``to`` = toHex; encryptedBlob = blobHex; timestamp = timestamp |})

107+ let body = JsonSerializer.Serialize({| ``to`` = toHex; encryptedBlob = blobHex; timestamp = timestamp |})

112− return! postJson<SendResult> client $"{serverUrl}/messages" body (Some token)

108+ postJson<SendResult> client $"{serverUrl}/messages" body (Some token)

113− }

114

109

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

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

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

116 async {

112 async {

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

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

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

119− return

120− { response with

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

114+ return { response with Events = response.Events |> Array.filter (fun e -> e.EventType = "message") }

122 }

115 }

123

116

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

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

125− async {

126− let body = JsonSerializer.Serialize({| messageIds = messageIds |})

118+ let body = JsonSerializer.Serialize({| messageIds = messageIds |})

127− do! post client $"{serverUrl}/messages/ack" body (Some token)

119+ sendRequest client $"{serverUrl}/messages/ack" body (Some token) |> Async.Ignore

128− }

client/App.fs+18−16

@@ -13,6 +13,7 @@ module App =

14 open Store

15 open Crypto

16+ open ApiClient

17 // ── Domain Types ──

18 // ── Domain Types ──

@@ -66,7 +67,7 @@ module App =

66 | DoDisconnect

67 | DoDisconnect

67 | SetCompose of string

68 | SetCompose of string

68 | DoSend

69 | DoSend

69− | Sent of Result<ApiClient.MessageStatus, string>

70+ | Sent of Result<MessageStatus, string>

70 | SetNewPubkey of string

71 | SetNewPubkey of string

71 | SetNewNickname of string

72 | SetNewNickname of string

72 | DoSaveContact

73 | DoSaveContact

@@ -132,8 +133,8 @@ module App =

132 | Identified(id, _) -> { model with Auth = Identified(id, status) }

133 | Identified(id, _) -> { model with Auth = Identified(id, status) }

133 | NoIdentity -> model

134 | NoIdentity -> model

134

135

135− let private saveCmd model =

136+ let private saveCmdMsg model =

136− [ CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = model.ServerUrl; PollCursor = model.PollCursor } ]

137+ CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = model.ServerUrl; PollCursor = model.PollCursor }

137

138

138 // ── Init ──

139 // ── Init ──

139

140

@@ -200,13 +201,13 @@ module App =

200 Page = Chat(pk, "")

201 Page = Chat(pk, "")

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

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

202

203

203− model', CmdSend(session, pk, compose, id) :: saveCmd model'

204+ model', [ CmdSend(session, pk, compose, id); saveCmdMsg model' ]

204 | _ -> model, []

205 | _ -> model, []

205

206

206− | Sent(Ok(ApiClient.Delivered | ApiClient.Federated | ApiClient.Queued)) -> model, []

207+ | Sent(Ok(Delivered | Federated | Queued)) -> model, []

207− | Sent(Ok ApiClient.Rejected) ->

208+ | Sent(Ok Rejected) ->

208 { model with Error = Some "Message rejected by server" }, []

209 { model with Error = Some "Message rejected by server" }, []

209− | Sent(Ok ApiClient.Unauthorized) ->

210+ | Sent(Ok Unauthorized) ->

210 { model with Error = Some "Not authorized to deliver message" }, []

211 { model with Error = Some "Not authorized to deliver message" }, []

211 | Sent(Error err) -> { model with Error = Some $"Send failed: {err}" }, []

212 | Sent(Error err) -> { model with Error = Some $"Send failed: {err}" }, []

212

213

@@ -224,7 +225,7 @@ module App =

224 [ match trySession model' with

225 [ match trySession model' with

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

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

226 | None -> ()

227 | None -> ()

227− if not incoming.IsEmpty then yield! saveCmd model' ]

228+ if not incoming.IsEmpty then saveCmdMsg model' ]

228

229

229 | SetNewPubkey pk ->

230 | SetNewPubkey pk ->

230 match model.Page with

231 match model.Page with

@@ -246,7 +247,7 @@ module App =

246 Contacts = model.Contacts |> upsertContact contact

247 Contacts = model.Contacts |> upsertContact contact

247 Page = Conversations }

248 Page = Conversations }

248

249

249− model', saveCmd model'

250+ model', [ saveCmdMsg model' ]

250 | _ -> model, []

251 | _ -> model, []

251

252

252 | CopyPubKey ->

253 | CopyPubKey ->

@@ -281,7 +282,7 @@ module App =

281 }

282 }

282 |> Async.Start)

283 |> Async.Start)

283

284

284− let private decryptEvent (privKey: byte[]) (payload: ApiClient.EventPayload) =

285+ let private decryptEvent (privKey: byte[]) (payload: EventPayload) =

285 try

286 try

286 let blob = Crypto.fromHex payload.EncryptedBlob

287 let blob = Crypto.fromHex payload.EncryptedBlob

287

288

@@ -309,7 +310,7 @@ module App =

309 | CmdConnect(url, identity) ->

310 | CmdConnect(url, identity) ->

310 asyncCmd (async {

311 asyncCmd (async {

311 try

312 try

312− let! token = ApiClient.authenticate url identity

313+ let! token = authenticate url identity

313 return AuthOk token

314 return AuthOk token

314 with ex ->

315 with ex ->

315 return AuthErr ex.Message

316 return AuthErr ex.Message

@@ -326,7 +327,7 @@ module App =

326

327

327 let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload

328 let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload

328 let blobHex = Crypto.toHex blob

329 let blobHex = Crypto.toHex blob

329− let! result = ApiClient.sendMessage session.Url session.Token recipientHex blobHex ts

330+ let! result = sendMessage session.Url session.Token recipientHex blobHex ts

330 return Sent(Ok result.Status)

331 return Sent(Ok result.Status)

331 with ex ->

332 with ex ->

332 return Sent(Error ex.Message)

333 return Sent(Error ex.Message)

@@ -335,10 +336,10 @@ module App =

335 | CmdPoll(session, cursor) ->

336 | CmdPoll(session, cursor) ->

336 asyncCmd (async {

337 asyncCmd (async {

337 try

338 try

338− let! response = ApiClient.poll session.Url session.Token cursor

339+ let! response = poll session.Url session.Token cursor

339 let messages, ackIds, errors =

340 let messages, ackIds, errors =

340 Array.foldBack

341 Array.foldBack

341− (fun (evt: ApiClient.PollEvent) (msgs, acks, errs) ->

342+ (fun (evt: PollEvent) (msgs, acks, errs) ->

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

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

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

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

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

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

@@ -346,7 +347,7 @@ module App =

346 ([], [], [])

347 ([], [], [])

347

348

348 if not ackIds.IsEmpty then

349 if not ackIds.IsEmpty then

349− do! ApiClient.ackMessages session.Url session.Token ackIds

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

350

351

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

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

352

353

@@ -433,11 +434,12 @@ module App =

433 | None -> ()

434 | None -> ()

434

435

435 match model.Auth with

436 match model.Auth with

436− | Identified(_, Offline) | NoIdentity -> Button("Connect", DoConnect)

437+ | Identified(_, Offline) -> Button("Connect", DoConnect)

437 | Identified(_, Connecting) -> Label("Connecting...").centerTextHorizontal()

438 | Identified(_, Connecting) -> Label("Connecting...").centerTextHorizontal()

438 | Identified(_, Online _) ->

439 | Identified(_, Online _) ->

439 Button("Disconnect", DoDisconnect)

440 Button("Disconnect", DoDisconnect)

440 Button("Go to Conversations", Nav Conversations)

441 Button("Go to Conversations", Nav Conversations)

442+ | NoIdentity -> ()

441 })

443 })

442 .padding(20.)

444 .padding(20.)

443 )

445 )

client/Store.fs+8−16

@@ -38,6 +38,12 @@ module Store =

38 ServerUrl: string

39 PollCursor: int64 }

41+ let private toChatMessage (d: MessageDoc) : ChatMessage =

42+ { Id = d.Id; Body = d.Body; Timestamp = DateTimeOffset.FromUnixTimeSeconds d.TimestampUnix; IsOutgoing = d.IsOutgoing }

43+

44+ let private toMessageDoc convId (m: ChatMessage) : MessageDoc =

45+ { Id = m.Id; ConversationId = convId; Body = m.Body; TimestampUnix = m.Timestamp.ToUnixTimeSeconds(); IsOutgoing = m.IsOutgoing }

46+

41 let private openDb () =

47 let private openDb () =

42 new LiteDatabase(Path.Combine(FileSystem.AppDataDirectory, "skrepka.db"))

48 new LiteDatabase(Path.Combine(FileSystem.AppDataDirectory, "skrepka.db"))

@@ -80,15 +86,7 @@ module Store =

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

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

81 |> Seq.groupBy _.ConversationId

87 |> Seq.groupBy _.ConversationId

82 |> Seq.map (fun (convId, docs) ->

88 |> Seq.map (fun (convId, docs) ->

83− convId,

84− docs

85− |> Seq.map (fun d ->

86− { ChatMessage.Id = d.Id

87− Body = d.Body

88− Timestamp = DateTimeOffset.FromUnixTimeSeconds d.TimestampUnix

89− IsOutgoing = d.IsOutgoing })

90− |> Seq.sortBy _.Timestamp

89+ convId, docs |> Seq.map toChatMessage |> Seq.sortBy _.Timestamp |> Seq.toList)

91− |> Seq.toList)

92 |> Map.ofSeq

90 |> Map.ofSeq

94 Some

92 Some

@@ -112,13 +110,7 @@ module Store =

112 data.Messages

110 data.Messages

113 |> Map.iter (fun convId msgs ->

111 |> Map.iter (fun convId msgs ->

114 for m in msgs do

112 for m in msgs do

115− messages.Upsert

113+ messages.Upsert(toMessageDoc convId m) |> ignore)

116− { Id = m.Id

117− ConversationId = convId

118− Body = m.Body

119− TimestampUnix = m.Timestamp.ToUnixTimeSeconds()

120− IsOutgoing = m.IsOutgoing }

121− |> ignore)

122

114

123 settings.Upsert

115 settings.Upsert

124 { Id = "settings"

116 { Id = "settings"

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

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

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−619a20356f5e49038371f33a93f265cb66ee99cf70d2100710b5c8d26eea4f99

1+808c17c7a8d50977c580708316952c7549166adf51c13e03fa8fcc9b8233a84e

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

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

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+48−49

@@ -71,10 +71,9 @@ type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp

71type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

72type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}

73type PollResult = PollUnauthorized {} | PollAuthorized {events: [PollEvent], cursor: Timestamp}

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

74+type DeliveryStatus = Text where \s -> s == "delivered" || s == "federated" || s == "queued"

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

75+type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}

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

77−type LookupResult = LookupUnauthorized {} | LookupDone {foundServer: OptionalServerName}

80-- ============================================

79-- ============================================

@@ -107,12 +106,12 @@ route AuthApi where

107 -> {challenge: Text}

106 -> {challenge: Text}

108 = ReqChallenge

107 = ReqChallenge

109 POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex} /verify

108 POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex} /verify

110− -> {token: Text, expiresAt: Int}

109+ -> {token: Text, expiresAt: Timestamp}

111 = VerifyAuth

110 = VerifyAuth

112

111

113route ClientApi where

112route ClientApi where

114− POST {cursor: Int, timeout: Int} /poll headers {authorization: Text}

113+ POST {cursor: Timestamp, timeout: Int} /poll headers {authorization: Text}

115− -> {events: [PollEvent], cursor: Int, authorized: Bool}

114+ -> {events: [PollEvent], cursor: Timestamp, authorized: Bool}

116 = Poll

115 = Poll

117 /messages

116 /messages

118 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}

117 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}

@@ -652,6 +651,33 @@ sendAcksAndClean = \pendingAcks servers ->

652 sendToEach servers (\server ->

651 sendToEach servers (\server ->

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

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

654

653

654+retryEvictedAcks = \evictedEntries pendingAcks ->

655+ let evictedToRetry = do

656+ a <- evictedEntries

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

658+ yield a

659+ in when (count evictedToRetry > 0) (do

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

661+ sendToEach evictedOriginServers (\server -> do

662+ fetchResult <- fetch (federationScheme ++ server) (FederationAck {

663+ authorization: "Bearer " ++ federationSecret,

664+ messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),

665+ originServer: server, fromServer: serverHostN})

666+ case fetchResult of

667+ Err _ -> do

668+ dropped <- atomic do

669+ ackedIds <- *ackedIds

670+ let reinsert = do a <- evictedToRetry; where a.originServer == server; yield a

671+ let combined = union ackedIds reinsert

672+ let excess = count combined - maxAckedIds

673+ let afterEviction = if excess <= 0 then combined

674+ else evictOldestAckedIds combined excess

675+ set *ackedIds = afterEviction

676+ yield excess

677+ when (dropped > 0)

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

679+ _ -> yield {}))

680+

655pruneAndRetry = \t -> do

681pruneAndRetry = \t -> do

656 result <- atomic do

682 result <- atomic do

657 set *lastPrunedAt = t

683 set *lastPrunedAt = t

@@ -743,7 +769,7 @@ serve = \req -> case req of

743 let hasMatch = any challenges (\c -> c.pubkey == pubkey && c.challenge == challenge && c.expiresAt > t)

769 let hasMatch = any challenges (\c -> c.pubkey == pubkey && c.challenge == challenge && c.expiresAt > t)

744 let sigValid = if hasMatch then verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature) else False {}

770 let sigValid = if hasMatch then verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature) else False {}

745 if not sigValid

771 if not sigValid

746− then yield {pr: pr, verify: VerifyFailed {}}

772+ then yield {pr: pr, verified: False {}, peerServers: []}

747 else do

773 else do

748 set *challenges = do

774 set *challenges = do

749 c <- challenges

775 c <- challenges

@@ -762,20 +788,17 @@ serve = \req -> case req of

762 let peerServers = if federationEnabled

788 let peerServers = if federationEnabled

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

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

764 else []

790 else []

765− yield {pr: pr, verify: VerifyOk {peerServers: peerServers}}

791+ yield {pr: pr, verified: True {}, peerServers: peerServers}

766− let expiredLocal = case result.verify of

792+ let expiredLocal = if result.verified

767− VerifyOk _ -> do p <- result.pr.expiredLocal; where not (p.pubkey == pubkey); yield p

793+ then do p <- result.pr.expiredLocal; where not (p.pubkey == pubkey); yield p

768− _ -> result.pr.expiredLocal

794+ else result.pr.expiredLocal

769 fork (do

795 fork (do

770− case result.verify of

771− VerifyOk {peerServers} ->

772− when federationEnabled

796+ when (result.verified && federationEnabled)

773− (sendBatchedGossip peerServers [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}] 2)

797+ (sendBatchedGossip result.peerServers [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}] 2)

774− _ -> yield {}

775 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

798 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

776− yield (case result.verify of

799+ yield (if result.verified

777− VerifyFailed _ -> respond {token: "", expiresAt: 0}

778− VerifyOk _ -> respond {token: token, expiresAt: expiry})

800+ then respond {token: token, expiresAt: expiry}

801+ else respond {token: "", expiresAt: 0})

779

802

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

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

781 t <- now

804 t <- now

@@ -881,31 +904,7 @@ serve = \req -> case req of

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

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

882 when (count originServers > 0)

905 when (count originServers > 0)

883 (sendAcksAndClean pendingAcks originServers)

906 (sendAcksAndClean pendingAcks originServers)

884− let evictedToRetry = do

885− a <- evictedEntries

907+ retryEvictedAcks evictedEntries pendingAcks)

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

887− yield a

888− when (count evictedToRetry > 0) (do

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

890− sendToEach evictedOriginServers (\server -> do

891− fetchResult <- fetch (federationScheme ++ server) (FederationAck {

892− authorization: "Bearer " ++ federationSecret,

893− messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),

894− originServer: server, fromServer: serverHostN})

895− case fetchResult of

896− Err _ -> do

897− dropped <- atomic do

898− ackedIds <- *ackedIds

899− let reinsert = do a <- evictedToRetry; where a.originServer == server; yield a

900− let combined = union ackedIds reinsert

901− let excess = count combined - maxAckedIds

902− let afterEviction = if excess <= 0 then combined

903− else evictOldestAckedIds combined excess

904− set *ackedIds = afterEviction

905− yield excess

906− when (dropped > 0)

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

908− _ -> yield {})))

909 _ -> yield {}

908 _ -> yield {}

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

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

911 yield (case result.ack of

910 yield (case result.ack of

@@ -921,7 +920,7 @@ serve = \req -> case req of

921 let auth = authenticateRequest sessions authorization t

920 let auth = authenticateRequest sessions authorization t

922 case auth of

921 case auth of

923 Unauthorized {} ->

922 Unauthorized {} ->

924− yield {pr: pr, lookup: LookupUnauthorized {}}

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

925 Authorized _ -> do

924 Authorized _ -> do

926 presence <- *presence

925 presence <- *presence

927 let valid = do

926 let valid = do

@@ -933,11 +932,11 @@ serve = \req -> case req of

933 else if p.server == serverHostN then {server: serverHostN, best: p.expiresAt}

932 else if p.server == serverHostN then {server: serverHostN, best: p.expiresAt}

934 else if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt}

933 else if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt}

935 else acc) {server: "", best: 0} valid).server

934 else acc) {server: "", best: 0} valid).server

936− yield {pr: pr, lookup: LookupDone {foundServer: foundServer}}

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

937 forkBroadcastOffline t result.pr

936 forkBroadcastOffline t result.pr

938− yield (case result.lookup of

937+ yield (if result.authorized

939− LookupUnauthorized _ -> respond {online: False {}, server: "", authorized: False {}}

940− LookupDone {foundServer} -> respond {online: not (foundServer == ""), server: foundServer, authorized: True {}})

938+ then respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: True {}}

939+ else respond {online: False {}, server: "", authorized: False {}})

941

940

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

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

943 t <- now

942 t <- now