b466ddf · skrepka · git.iko.soy

git.iko.soy/skrepka

Improve type safety and simplify server code: use DUs with custom JSON serialization, optimize string handling with contains(), tighten response types

b466ddfiko6 months ago

client/ApiClient.fs+4−3

compare with master

unifiedsplit

@@ -17,7 +17,7 @@ module ApiClient =

17 [<CLIMutable>]

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

20− type MessageStatus = Delivered | Federated | Queued | Rejected | Unauthorized

22 [<CLIMutable>]

23 type private SendResult = { Status: MessageStatus }

@@ -50,7 +50,7 @@ module ApiClient =

50 | "queued" -> Queued

51 | "rejected" -> Rejected

52 | "unauthorized" -> Unauthorized

53− | s -> failwith $"Unknown message status: {s}"

53+ | s -> UnknownStatus s

54 override _.Write(writer, value, _) =

55 writer.WriteStringValue(

56 match value with

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

58 | Federated -> "federated"

59 | Queued -> "queued"

60 | Rejected -> "rejected"

61− | Unauthorized -> "unauthorized")

61+ | Unauthorized -> "unauthorized"

62+ | UnknownStatus s -> s)

63 type private EventTypeConverter() =

64 type private EventTypeConverter() =

64 inherit JsonConverter<EventType>()

65 inherit JsonConverter<EventType>()

client/App.fs+26−24

@@ -95,7 +95,7 @@ module App =

95 | PollResult of messages: (string * ChatMessage) list * status: string * cursor: int64

96 | CopyPubKey

97 | DismissError

98− | StateLoaded of Identity * Data option

98+ | StateLoaded of (Identity * Data option) option

100 // ── CmdMsg ──

101

@@ -130,6 +130,10 @@ module App =

130

131 let private truncKey (hex: string) = hexToOb hex |> truncOb

132

133+ let private tryParsePubkey (input: string) =

134+ (Phonemic.fromOb input |> Option.orElseWith (fun () -> Crypto.tryFromHex input))

135+ |> Option.filter (fun bytes -> bytes.Length = 32)

136+

133 let private contactName (contacts: Contact list) (pk: string) =

137 let private contactName (contacts: Contact list) (pk: string) =

134 contacts

138 contacts

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

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

@@ -268,8 +272,8 @@ module App =

268 let pk, nn = model.ContactPubkey, model.ContactNickname

272 let pk, nn = model.ContactPubkey, model.ContactNickname

269 match model.Page with

273 match model.Page with

270 | AddContact when pk <> "" && nn <> "" ->

274 | AddContact when pk <> "" && nn <> "" ->

271− match Phonemic.fromOb pk |> Option.orElseWith (fun () -> Crypto.tryFromHex pk) with

275+ match tryParsePubkey pk with

272− | Some bytes when bytes.Length = 32 ->

276+ | Some bytes ->

273 let contact: Contact = { Pubkey = Crypto.toHex bytes; Nickname = nn }

277 let contact: Contact = { Pubkey = Crypto.toHex bytes; Nickname = nn }

274

278

275 let model' =

279 let model' =

@@ -289,20 +293,19 @@ module App =

289

293

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

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

291

295

292− | StateLoaded(identity, dataOpt) ->

296+ | StateLoaded(Some(identity, Some data)) ->

293− match dataOpt with

294− | Some data ->

295− let model' =

297+ let model' =

296− { model with

298+ { model with

297− Auth = Identified(identity, Connecting)

299+ Auth = Identified(identity, Connecting)

298− Contacts = data.Contacts

300+ Contacts = data.Contacts

299− Messages = data.Messages

301+ Messages = data.Messages

300− ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl

302+ ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl

301− PollCursor = data.PollCursor

303+ PollCursor = data.PollCursor

302− Page = Conversations }

304+ Page = Conversations }

303− model', [ CmdConnect(model'.ServerUrl, identity) ]

305+ model', [ CmdConnect(model'.ServerUrl, identity) ]

304− | None ->

306+ | StateLoaded(Some(identity, None)) ->

305− { model with Auth = Identified(identity, Offline); Page = Settings }, []

307+ { model with Auth = Identified(identity, Offline); Page = Settings }, []

308+ | StateLoaded None -> model, []

306

309

307 // ── mapCmd ──

310 // ── mapCmd ──

308

311

@@ -362,6 +365,7 @@ module App =

362 | Delivered | Federated | Queued -> ()

365 | Delivered | Federated | Queued -> ()

363 | Rejected -> dispatch (SendFailed "Message rejected by server")

366 | Rejected -> dispatch (SendFailed "Message rejected by server")

364 | Unauthorized -> dispatch (SendFailed "Not authorized to deliver message")

367 | Unauthorized -> dispatch (SendFailed "Not authorized to deliver message")

368+ | UnknownStatus s -> dispatch (SendFailed $"Unexpected status: {s}")

365 with ex ->

369 with ex ->

366 dispatch (SendFailed $"Send failed: {ex.Message}")

370 dispatch (SendFailed $"Send failed: {ex.Message}")

367 }

371 }

@@ -405,13 +409,11 @@ module App =

405 |> ignore)

409 |> ignore)

406

410

407 | CmdLoadState ->

411 | CmdLoadState ->

408− Cmd.ofEffect (fun dispatch ->

409− async {

412+ asyncCmd (async {

410− match! Store.loadIdentity () with

413+ match! Store.loadIdentity () with

411− | Some id -> dispatch (StateLoaded(id, Store.loadData ()))

414+ | Some id -> return StateLoaded(Some(id, Store.loadData ()))

412− | None -> ()

415+ | None -> return StateLoaded None

413− }

416+ })

414− |> Async.Start)

415

417

416 | CmdSaveIdentity identity ->

418 | CmdSaveIdentity identity ->

417 Cmd.ofEffect (fun _ -> Store.saveIdentity identity |> Async.Start)

419 Cmd.ofEffect (fun _ -> Store.saveIdentity identity |> Async.Start)

client/Phonemic.fs+4−3

@@ -1,5 +1,7 @@

1namespace Skrepka

3+open System

3module Phonemic =

5module Phonemic =

5 // Urbit @p syllable tables (256 prefixes, 256 suffixes)

7 // Urbit @p syllable tables (256 prefixes, 256 suffixes)

@@ -94,12 +96,11 @@ module Phonemic =

94 sb.ToString()

96 sb.ToString()

96 let fromOb (s: string) : byte[] option =

98 let fromOb (s: string) : byte[] option =

97− let s = s.Trim('-')

99+ let pairs = s.Split('-', StringSplitOptions.RemoveEmptyEntries)

100

99− if s = "" then

101+ if pairs.Length = 0 then

100 None

102 None

101 else

103 else

102− let pairs = s.Split('-') |> Array.filter (fun p -> p <> "")

103

104

104 let decoded =

105 let decoded =

105 pairs

106 pairs

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

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

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−bab902372413363aadc7dd6fd03839ec75cc7bfbd2431aa615e69476a889187f

1+ac592265f098d871e6f04a2ad8e3355d036bd09f4c75fa6fc8a66820739b5515

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

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

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

@@ -50,19 +50,33 @@ federationEnabled = federationSecret != ""

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

53−type GossipEventType = Text where \s -> s == "online" || s == "offline"

53+type GossipEventType = GossipOnline {} | GossipOffline {}

54+

55+impl ToJSON GossipEventType where

56+ toJson et = toJson (case et of

57+ GossipOnline {} -> "online"

58+ GossipOffline {} -> "offline")

59+

60+impl FromJSON GossipEventType where

61+ parseJson t =

62+ let s : Text = parseJson t in

63+ if s == "online" then GossipOnline {} else GossipOffline {}

64+

65+isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}

66+isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}

55type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}

68type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}

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

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

59−isDeliveryStatus = \s -> s == "delivered" || s == "federated" || s == "queued"

60−type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || isDeliveryStatus s

72+type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || s == "delivered" || s == "federated" || s == "queued"

62type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s

74type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s

63type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s

75type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s

64type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s

76type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s

65−type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s

77+isValidMessageId = \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s

78+type MessageIdHex = Text where isValidMessageId

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

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

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

67type ServerName = Text where isValidServerName

81type ServerName = Text where isValidServerName

68type OptionalServerName = Text where \s -> s == "" || isValidServerName s

82type OptionalServerName = Text where \s -> s == "" || isValidServerName s

@@ -78,7 +92,11 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T

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

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

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

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

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

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

81−type DeliveryStatus = Text where isDeliveryStatus

95+type DeliveryStatus = Delivered {} | Federated {} | Queued {}

96+deliveryStatusText = \s -> case s of

97+ Delivered {} -> "delivered"

98+ Federated {} -> "federated"

99+ Queued {} -> "queued"

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

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

101

102

@@ -121,13 +139,13 @@ route ClientApi where

121 = Poll

139 = Poll

122 /messages

140 /messages

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

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

124− -> {status: MessageStatus, messageId: Text}

142+ -> {status: MessageStatus, messageId: OptionalMessageId}

125 = SendMessage

143 = SendMessage

126 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}

144 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}

127 -> {ok: Bool}

145 -> {ok: Bool}

128 = AckMessages

146 = AckMessages

129 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}

147 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}

130− -> {online: Bool, server: Text, authorized: Bool}

148+ -> {online: Bool, server: AnyServerName, authorized: Bool}

131 = LookupPresence

149 = LookupPresence

132

150

133route FederationApi where

151route FederationApi where

@@ -204,28 +222,25 @@ containsBadUrlChar = \s -> any (chars s) (\c -> not (isAllowedServerChar c))

204

222

205isCgnatRange = \s ->

223isCgnatRange = \s ->

206 if take 4 s != "100." then False {}

224 if take 4 s != "100." then False {}

207− else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")

225+ else let d4 = take 1 (drop 4 s) in

208− && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."

226+ let d5 = take 1 (drop 5 s) in

227+ let d6 = take 1 (drop 6 s) in

228+ let d7 = take 1 (drop 7 s) in

229+ if contains d4 "789" && isDigitChar d5 && d6 == "."

209 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)

230 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)

210 then True {}

231 then True {}

211− else if take 1 (drop 4 s) == "6"

232+ else if d4 == "6" && contains d5 "456789" && d6 == "."

212− && (take 1 (drop 5 s) == "4" || take 1 (drop 5 s) == "5" || take 1 (drop 5 s) == "6" || take 1 (drop 5 s) == "7" || take 1 (drop 5 s) == "8" || take 1 (drop 5 s) == "9")

213− && take 1 (drop 6 s) == "."

214 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)

233 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)

215 then True {}

234 then True {}

216− else if take 1 (drop 4 s) == "1" && (take 1 (drop 5 s) == "0" || take 1 (drop 5 s) == "1")

235+ else if d4 == "1" && contains d5 "01" && isDigitChar d6 && d7 == "."

217− && isDigitChar (take 1 (drop 6 s)) && take 1 (drop 7 s) == "."

218 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)

236 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)

219 then True {}

237 then True {}

220− else if take 1 (drop 4 s) == "1" && take 1 (drop 5 s) == "2"

238+ else if d4 == "1" && d5 == "2" && contains d6 "01234567" && d7 == "."

221− && (take 1 (drop 6 s) == "0" || take 1 (drop 6 s) == "1" || take 1 (drop 6 s) == "2" || take 1 (drop 6 s) == "3"

222− || take 1 (drop 6 s) == "4" || take 1 (drop 6 s) == "5" || take 1 (drop 6 s) == "6" || take 1 (drop 6 s) == "7")

223− && take 1 (drop 7 s) == "."

224 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)

239 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)

225 then True {}

240 then True {}

226 else False {}

241 else False {}

227

242

228−containsMultipleColons = \s -> count (do c <- chars s; where c == ":"; yield c) > 1

243+containsMultipleColons = \s -> fold (\n c -> if c == ":" then n + 1 else n) 0 (chars s) > 1

229

244

230hasOctalOctet = \s ->

245hasOctalOctet = \s ->

231 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}

246 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}

@@ -273,30 +288,26 @@ containsSuffixN = \suffix suffixLen s ->

273

288

274containsSuffix = \suffix s -> containsSuffixN suffix (count (chars suffix)) s

289containsSuffix = \suffix s -> containsSuffixN suffix (count (chars suffix)) s

275

290

276−containsLocalhostSuffix = \s -> containsSuffix ".localhost" s

277−containsLocalSuffix = \s -> containsSuffix ".local" s

278−containsInternalSuffix = \s -> containsSuffix ".internal" s

279−

280is172Private = \sn ->

291is172Private = \sn ->

281 take 4 sn == "172."

292 take 4 sn == "172."

282 && let d1 = take 1 (drop 4 sn) in

293 && let d1 = take 1 (drop 4 sn) in

283 let d2 = take 1 (drop 5 sn) in

294 let d2 = take 1 (drop 5 sn) in

284 take 1 (drop 6 sn) == "."

295 take 1 (drop 6 sn) == "."

285− && ((d1 == "1" && (d2 == "6" || d2 == "7" || d2 == "8" || d2 == "9"))

296+ && ((d1 == "1" && contains d2 "6789")

286 || (d1 == "2" && isDigitChar d2)

297 || (d1 == "2" && isDigitChar d2)

287− || (d1 == "3" && (d2 == "0" || d2 == "1")))

298+ || (d1 == "3" && contains d2 "01"))

288

299

289isHighOctetPrefix = \sn ->

300isHighOctetPrefix = \sn ->

290 take 1 sn == "2"

301 take 1 sn == "2"

291 && let d2 = take 1 (drop 1 sn) in

302 && let d2 = take 1 (drop 1 sn) in

292 let d3 = take 1 (drop 2 sn) in

303 let d3 = take 1 (drop 2 sn) in

293 take 1 (drop 3 sn) == "."

304 take 1 (drop 3 sn) == "."

294− && ((d2 == "2" && (d3 == "4" || d3 == "5" || d3 == "6" || d3 == "7" || d3 == "8" || d3 == "9"))

305+ && ((d2 == "2" && contains d3 "456789")

295− || (d2 == "3" && isDigitChar d3)

296− || (d2 == "4" && isDigitChar d3)

306+ || (contains d2 "34" && isDigitChar d3)

297− || (d2 == "5" && (d3 == "0" || d3 == "1" || d3 == "2" || d3 == "3" || d3 == "4" || d3 == "5")))

307+ || (d2 == "5" && contains d3 "012345"))

298

308

299−matchesHostname = \sn name nameLen ->

309+matchesHostname = \sn name ->

310+ let nameLen = count (chars name) in

300 take nameLen sn == name && (drop nameLen sn == "" || take 1 (drop nameLen sn) == ":")

311 take nameLen sn == name && (drop nameLen sn == "" || take 1 (drop nameLen sn) == ":")

301

312

302isBadServerName = \sn ->

313isBadServerName = \sn ->

@@ -304,14 +315,14 @@ isBadServerName = \sn ->

304 || take 1 sn == "."

315 || take 1 sn == "."

305 || take 1 sn == ":"

316 || take 1 sn == ":"

306 || containsBadUrlChar sn

317 || containsBadUrlChar sn

307− || matchesHostname sn "localhost" 9

318+ || matchesHostname sn "localhost"

308− || matchesHostname sn "localhost.localdomain" 21

319+ || matchesHostname sn "localhost.localdomain"

309− || containsLocalhostSuffix sn

320+ || containsSuffix ".localhost" sn

310− || matchesHostname sn "local" 5

321+ || matchesHostname sn "local"

311− || containsLocalSuffix sn

322+ || containsSuffix ".local" sn

312− || matchesHostname sn "internal" 8

323+ || matchesHostname sn "internal"

313− || containsInternalSuffix sn

324+ || containsSuffix ".internal" sn

314− || matchesHostname sn "metadata" 8

325+ || matchesHostname sn "metadata"

315 || take 4 sn == "127." || take 3 sn == "10."

326 || take 4 sn == "127." || take 3 sn == "10."

316 || take 8 sn == "192.168." || take 8 sn == "169.254."

327 || take 8 sn == "192.168." || take 8 sn == "169.254."

317 || take 2 sn == "0." || take 1 sn == "["

328 || take 2 sn == "0." || take 1 sn == "["

@@ -573,7 +584,7 @@ broadcastOfflineGossip = \t peerServers expiredLocal ->

573 let gossipEvents = mergeByKey (\a b -> a.pubkey == b.pubkey) (\x -> x.timestamp) [] (do

584 let gossipEvents = mergeByKey (\a b -> a.pubkey == b.pubkey) (\x -> x.timestamp) [] (do

574 p <- expiredLocal

585 p <- expiredLocal

575 let ttl = clamp offlineGossipMinTtl maxPresenceTtl ((p.expiresAt - p.timestamp) / 1000)

586 let ttl = clamp offlineGossipMinTtl maxPresenceTtl ((p.expiresAt - p.timestamp) / 1000)

576− yield {eventType: "offline", pubkey: p.pubkey, server: serverHostN, timestamp: p.expiresAt, ttl: ttl})

587+ yield {eventType: GossipOffline {}, pubkey: p.pubkey, server: serverHostN, timestamp: p.expiresAt, ttl: ttl})

577 sendBatchedGossip peerServers gossipEvents 2)

588 sendBatchedGossip peerServers gossipEvents 2)

578

589

579forkBroadcastOffline = \t result ->

590forkBroadcastOffline = \t result ->

@@ -764,7 +775,7 @@ serve = \req -> case req of

764 else result.pr.expiredLocal

775 else result.pr.expiredLocal

765 fork (do

776 fork (do

766 when (result.verified && federationEnabled)

777 when (result.verified && federationEnabled)

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

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

768 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

779 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

769 yield (if result.verified

780 yield (if result.verified

770 then respond {token: token, expiresAt: expiry}

781 then respond {token: token, expiresAt: expiry}

@@ -808,9 +819,9 @@ serve = \req -> case req of

808 forwards <- *forwards

819 forwards <- *forwards

809 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)

820 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)

810 let shouldForward = federationEnabled && count forwardServers > 0

821 let shouldForward = federationEnabled && count forwardServers > 0

811− let status = if localOnline then "delivered"

822+ let status = if localOnline then Delivered {}

812− else if shouldForward then "federated"

823+ else if shouldForward then Federated {}

813− else "queued"

824+ else Queued {}

814 set *forwards = if shouldForward

825 set *forwards = if shouldForward

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

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

816 else forwards

827 else forwards

@@ -825,14 +836,15 @@ serve = \req -> case req of

825 timestamp: clampedTs, originServer: serverHostN, messageId: msgId,

836 timestamp: clampedTs, originServer: serverHostN, messageId: msgId,

826 authorization: "Bearer " ++ federationSecret})

837 authorization: "Bearer " ++ federationSecret})

827 whenOk fwdResult (removeForward msgId server))

838 whenOk fwdResult (removeForward msgId server))

828− when (status == "queued")

839+ case status of

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

840+ Queued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")

841+ _ -> yield {})

830 _ -> yield {}

842 _ -> yield {}

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

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

832 yield (case result.send of

844 yield (case result.send of

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

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

834 SendRejected _ -> respond {status: "rejected", messageId: ""}

846 SendRejected _ -> respond {status: "rejected", messageId: ""}

835− SendDone {status} -> respond {status: status, messageId: msgId})

847+ SendDone {status} -> respond {status: deliveryStatusText status, messageId: msgId})

836

848

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

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

838 t <- now

850 t <- now

@@ -901,8 +913,8 @@ serve = \req -> case req of

901 yield (respond {ok: False {}})

913 yield (respond {ok: False {}})

902 else do

914 else do

903 let allValidEntries = validGossipEvents events t

915 let allValidEntries = validGossipEvents events t

904− let onlineEntries = do e <- allValidEntries; where e.eventType == "online"; yield e

916+ let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e

905− let offlineEntries = do e <- allValidEntries; where e.eventType == "offline"; yield e

917+ let offlineEntries = do e <- allValidEntries; where isGossipOffline e.eventType; yield e

906 let filteredOnline = do

918 let filteredOnline = do

907 e <- onlineEntries

919 e <- onlineEntries

908 where none offlineEntries (\o -> o.server == fromServer && samePubkeyServer o e && o.timestamp > e.timestamp)

920 where none offlineEntries (\o -> o.server == fromServer && samePubkeyServer o e && o.timestamp > e.timestamp)