ab639f4 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: remove ForwardInfo, inline computed properties, add ValidGossipEntry, short-circuit validGossipEvents

ab639f4iko6 months ago

client/App.fs+24−41

compare with master

unifiedsplit

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

14 // ── Domain Types ──

16− type Contact = { Pubkey: string; Nickname: string }

16+ type Contact = Store.Contact

18 type ChatMessage =

19 { Id: string

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

41 type ConnState =

42 | Offline

43− | Connecting

43+ | Connecting of Identity

44 | Online of Session

46 type PollResultData =

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

82 | DoDisconnect

83 | SetCompose of string

84 | DoSend

85− | Sent of status: string

85+ | Sent of ApiClient.SendResult

86 | SetNewPubkey of string

87 | SetNewNickname of string

88 | DoSaveContact

@@ -178,17 +178,16 @@ module App =

178 | DoConnect ->

179 match model.Identity with

180 | Some id ->

181− { model with Conn = Connecting }, [ CmdConnect(model.ServerUrl, id) ]

181+ { model with Conn = Connecting id }, [ CmdConnect(model.ServerUrl, id) ]

182 | None -> { model with Error = Some "No identity generated" }, []

183

184 | AuthOk token ->

185− match model.Identity with

185+ match model.Conn with

186− | Some id ->

186+ | Connecting id ->

187 let session = { Url = model.ServerUrl; Token = token; Identity = id }

188 { model with Conn = Online session; Page = Conversations; Error = None },

189 [ CmdPoll(session, model.PollCursor) ]

190− | None ->

190+ | _ -> model, []

191− { model with Error = Some "No identity generated" }, []

192

191

193 | AuthErr err -> { model with Conn = Offline; Error = Some err }, []

192 | AuthErr err -> { model with Conn = Offline; Error = Some err }, []

194

193

@@ -215,7 +214,7 @@ module App =

215 model', CmdSend(session, pk, text, id) :: saveCmd model'

214 model', CmdSend(session, pk, text, id) :: saveCmd model'

216 | _ -> model, []

215 | _ -> model, []

217

216

218− | Sent status -> { model with LastSendStatus = status }, []

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

219

218

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

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

221 let model' =

220 let model' =

@@ -286,35 +285,26 @@ module App =

286 match identityOpt with

285 match identityOpt with

287 | None -> model, []

286 | None -> model, []

288 | Some identity ->

287 | Some identity ->

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

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

290

289

291 let model' =

290 let model' =

292 match dataOpt with

291 match dataOpt with

293 | Some data ->

292 | Some data ->

294− let contacts =

295− data.Contacts

296− |> Array.toList

297− |> List.map (fun c ->

298− { Pubkey = c.Pubkey; Nickname = c.Nickname }: Contact)

299−

300 let messages =

293 let messages =

301 data.Messages

294 data.Messages

302− |> Seq.fold

303− (fun acc (KeyValue(pk, dtos)) ->

295+ |> Seq.map (fun (KeyValue(pk, dtos)) ->

304− let msgs =

296+ pk,

305− dtos

297+ dtos

306− |> Array.toList

298+ |> Array.toList

307− |> List.map (fun m ->

299+ |> List.map (fun m ->

308− { Id = m.Id

300+ { Id = m.Id

309− Body = m.Body

301+ Body = m.Body

310− Timestamp = DateTimeOffset.FromUnixTimeSeconds m.TimestampUnix

302+ Timestamp = DateTimeOffset.FromUnixTimeSeconds m.TimestampUnix

311− IsOutgoing = m.IsOutgoing })

303+ IsOutgoing = m.IsOutgoing }))

312−

304+ |> Map.ofSeq

313− acc |> Map.add pk msgs)

314− Map.empty

315

305

316 { model' with

306 { model' with

317− Contacts = contacts

307+ Contacts = data.Contacts |> Array.toList

318 Messages = messages

308 Messages = messages

319 ServerUrl = if data.ServerUrl <> "" then data.ServerUrl else model.ServerUrl

309 ServerUrl = if data.ServerUrl <> "" then data.ServerUrl else model.ServerUrl

320 PollCursor = data.PollCursor

310 PollCursor = data.PollCursor

@@ -391,7 +381,7 @@ module App =

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

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

392 let blobHex = Crypto.toHex blob

382 let blobHex = Crypto.toHex blob

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

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

394− return Sent $"{result.Status}:{result.MessageId}"

384+ return Sent result

395 with ex ->

385 with ex ->

396 return DismissError // TODO: show send errors properly

386 return DismissError // TODO: show send errors properly

397 })

387 })

@@ -444,13 +434,6 @@ module App =

444

434

445 | CmdSaveData(contacts, messages, serverUrl, cursor) ->

435 | CmdSaveData(contacts, messages, serverUrl, cursor) ->

446 Cmd.ofEffect (fun _ ->

436 Cmd.ofEffect (fun _ ->

447− let contactDtos =

448− contacts

449− |> List.map (fun c ->

450− { Store.ContactDto.Pubkey = c.Pubkey

451− Store.ContactDto.Nickname = c.Nickname })

452− |> Array.ofList

453−

454 let messageDtos = Dictionary<string, Store.MessageDto array>()

437 let messageDtos = Dictionary<string, Store.MessageDto array>()

455

438

456 messages

439 messages

@@ -465,7 +448,7 @@ module App =

465 |> Array.ofList)

448 |> Array.ofList)

466

449

467 Store.saveData

450 Store.saveData

468− { Contacts = contactDtos

451+ { Contacts = contacts |> Array.ofList

469 Messages = messageDtos

452 Messages = messageDtos

470 ServerUrl = serverUrl

453 ServerUrl = serverUrl

471 PollCursor = cursor })

454 PollCursor = cursor })

@@ -520,7 +503,7 @@ module App =

520

503

521 match model.Conn with

504 match model.Conn with

522 | Offline -> Button("Connect", DoConnect)

505 | Offline -> Button("Connect", DoConnect)

523− | Connecting -> Label("Connecting...").centerTextHorizontal()

506+ | Connecting _ -> Label("Connecting...").centerTextHorizontal()

524 | Online _ ->

507 | Online _ ->

525 Button("Disconnect", DoDisconnect)

508 Button("Disconnect", DoDisconnect)

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

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

@@ -533,7 +516,7 @@ module App =

533 let connStr =

516 let connStr =

534 match model.Conn with

517 match model.Conn with

535 | Offline -> "OFFLINE"

518 | Offline -> "OFFLINE"

536− | Connecting -> "CONNECTING"

519+ | Connecting _ -> "CONNECTING"

537 | Online _ -> "ONLINE"

520 | Online _ -> "ONLINE"

538

521

539 let contactNames =

522 let contactNames =

client/Store.fs+2−2

@@ -9,7 +9,7 @@ open Microsoft.Maui.Storage

9module Store =

11 [<CLIMutable>]

12− type ContactDto =

12+ type Contact =

13 { Pubkey: string

14 Nickname: string }

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

23 [<CLIMutable>]

24 type DataDto =

25− { Contacts: ContactDto array

25+ { Contacts: Contact array

26 Messages: Dictionary<string, MessageDto array>

27 ServerUrl: string

28 PollCursor: uint64 }

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

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

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−258df1087fc418adab33f09b6403611ecf00ae4643e2b1d8257eaca6be4c82ac

1+83cc1d0f7837e56dfd3e64e2491b55a1e8c0c0e8eac0237e2d9f361c0cdf8383

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

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

server.knot+27−36

@@ -49,6 +49,8 @@ type GossipEventType = Text where \s -> s == "online" || s == "offline"

50type GossipEvent = {eventType: GossipEventType, pubkey: Text, server: Text, timestamp: Timestamp, ttl: Int<S>}

52+type ValidGossipEntry = {pubkey: PubkeyHex, server: Text, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}

53+

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

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

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

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

@@ -68,7 +70,7 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T

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

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

69type AuthResult = {authorized: Bool, pubkey: Text}

71type AuthResult = {authorized: Bool, pubkey: Text}

70type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [Text]}

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

71−type ForwardInfo = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, toServer: ServerName}

73+

73-- ============================================

75-- ============================================

74-- Persisted State

76-- Persisted State

@@ -326,20 +328,23 @@ isHighOctetPrefix = \sn ->

326 || (d2 == "4" && isDigitChar d3)

328 || (d2 == "4" && isDigitChar d3)

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

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

328

330

331+matchesHostname = \sn name nameLen ->

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

333+

329isBadServerName = \s ->

334isBadServerName = \s ->

330 let sn = toLower (stripTrailingDot s) in

335 let sn = toLower (stripTrailingDot s) in

331 sn == ""

336 sn == ""

332 || take 1 sn == "."

337 || take 1 sn == "."

333 || take 1 sn == ":"

338 || take 1 sn == ":"

334 || containsBadUrlChar sn

339 || containsBadUrlChar sn

335− || sn == "localhost" || take 10 sn == "localhost:"

340+ || matchesHostname sn "localhost" 9

336− || sn == "localhost.localdomain" || take 22 sn == "localhost.localdomain:"

341+ || matchesHostname sn "localhost.localdomain" 21

337 || containsLocalhostSuffix sn

342 || containsLocalhostSuffix sn

338− || sn == "local" || take 6 sn == "local:"

343+ || matchesHostname sn "local" 5

339 || containsLocalSuffix sn

344 || containsLocalSuffix sn

340− || sn == "internal" || take 9 sn == "internal:"

345+ || matchesHostname sn "internal" 8

341 || containsInternalSuffix sn

346 || containsInternalSuffix sn

342− || sn == "metadata" || take 9 sn == "metadata:"

347+ || matchesHostname sn "metadata" 8

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

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

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

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

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

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

@@ -489,22 +494,12 @@ countMessagesFor = \messages toKey t ->

489 where m.receivedAt >= t - messageMaxAge

494 where m.receivedAt >= t - messageMaxAge

490 yield m)

495 yield m)

491

496

492−&pendingAcks = do

493− ackedIds <- *ackedIds

494− yield (do a <- ackedIds; where isFederatedOrigin a.originServer; yield a)

495−

496−&knownMessageKeys = do

497− messages <- *messages

498− ackedIds <- *ackedIds

499− yield (union

500− (do m <- messages; yield {messageId: m.messageId, toKey: m.toKey})

501− (do a <- ackedIds; yield {messageId: a.messageId, toKey: a.toKey}))

502

497

503−validGossipEvents : [GossipEvent] -> Bool -> Timestamp -> GossipEventType -> [{pubkey: PubkeyHex, server: Text, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}]

498+validGossipEvents : [GossipEvent] -> Bool -> Timestamp -> GossipEventType -> [ValidGossipEntry]

504validGossipEvents = \events validRequest t eventType ->

499validGossipEvents = \events validRequest t eventType ->

500+ if not validRequest then []

505− do

501+ else do

506 e <- events

502 e <- events

507− where validRequest

508 where e.eventType == eventType

503 where e.eventType == eventType

509 where not (e.server == "")

504 where not (e.server == "")

510 where not (e.pubkey == "")

505 where not (e.pubkey == "")

@@ -583,10 +578,7 @@ sendBatchedGossipToServer = \server allEvents ->

583

578

584sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}

579sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}

585sendBatchedGossip = \peerServers allEvents ->

580sendBatchedGossip = \peerServers allEvents ->

586− if count allEvents == 0

587− then yield {}

588− else

589− sendToEach peerServers (\server -> sendBatchedGossipToServer server allEvents)

581+ sendToEach peerServers (\server -> sendBatchedGossipToServer server allEvents)

590

582

591broadcastOfflineGossip = \t peerServers expiredLocal -> do

583broadcastOfflineGossip = \t peerServers expiredLocal -> do

592 let expiredEntries = mergeByKey (\a b -> a.pubkey == b.pubkey) [] (do

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

@@ -610,7 +602,7 @@ removeForward = \mid srv -> atomic do

610 where not (x.messageId == mid && x.toServer == srv)

602 where not (x.messageId == mid && x.toServer == srv)

611 yield x

603 yield x

612

604

613−retryForwardsForServer : [ForwardInfo] -> Int -> IO {network} {}

605+retryForwardsForServer : [ForwardEntry] -> Int -> IO {network} {}

614retryForwardsForServer = \entries remaining ->

606retryForwardsForServer = \entries remaining ->

615 if remaining <= 0

607 if remaining <= 0

616 then yield {}

608 then yield {}

@@ -629,7 +621,7 @@ retryForwardsForServer = \entries remaining ->

629 Err _ -> yield {}

621 Err _ -> yield {}

630 retryForwardsForServer rest (remaining - 1)

622 retryForwardsForServer rest (remaining - 1)

631

623

632−retryPendingForwards : [ForwardInfo] -> IO {network} {}

624+retryPendingForwards : [ForwardEntry] -> IO {network} {}

633retryPendingForwards = \pending -> do

625retryPendingForwards = \pending -> do

634 let servers = collectPeerServers pending (\x -> x.toServer)

626 let servers = collectPeerServers pending (\x -> x.toServer)

635 sendToEach servers (\server ->

627 sendToEach servers (\server ->

@@ -668,10 +660,9 @@ pruneAndRetry = \t -> do

668 set *lastPrunedAt = t

660 set *lastPrunedAt = t

669 pr <- pruneExpired t

661 pr <- pruneExpired t

670 forwards <- *forwards

662 forwards <- *forwards

671− let pendingForwards = do

663+ let pendingForwards = forwards

672− f <- forwards

664+ ackedIds <- *ackedIds

673− yield {toServer: f.toServer, toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, messageId: f.messageId}

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

674− pendingAcks <- &pendingAcks

675 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}

666 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}

676 broadcastOfflineGossip t result.peerServers result.expiredLocal

667 broadcastOfflineGossip t result.peerServers result.expiredLocal

677 if federationEnabled && count result.pendingForwards > 0

668 if federationEnabled && count result.pendingForwards > 0

@@ -976,7 +967,7 @@ serve = \req -> case req of

976 where p.pubkey == pubkey

967 where p.pubkey == pubkey

977 where p.expiresAt > t

968 where p.expiresAt > t

978 yield p

969 yield p

979− let foundServer = if not authorized || count valid == 0

970+ let foundServer = if not authorized

980 then ""

971 then ""

981 else if any valid (\p -> p.server == serverHostN)

972 else if any valid (\p -> p.server == serverHostN)

982 then serverHostN

973 then serverHostN

@@ -1114,12 +1105,12 @@ serve = \req -> case req of

1114 messages <- *messages

1105 messages <- *messages

1115 seqCounter <- *seqCounter

1106 seqCounter <- *seqCounter

1116 let seqTs = nextSeqTs t seqCounter

1107 let seqTs = nextSeqTs t seqCounter

1108+ ackedIds <- *ackedIds

1109+ let exists = authorized && validOrigin

1110+ && (any messages (\m -> m.messageId == messageId && m.toKey == toKey)

1111+ || any ackedIds (\a -> a.messageId == messageId && a.toKey == toKey))

1117− let recipientMsgCount = if not (authorized && validOrigin) then 0

1112+ let shouldInsert = authorized && validOrigin && not exists

1118− else countMessagesFor messages toKey t

1113+ && countMessagesFor messages toKey t < maxMessagesPerRecipient

1119− knownKeys <- &knownMessageKeys

1120− let exists = if not (authorized && validOrigin) then False {}

1121− else any knownKeys (\k -> k.messageId == messageId && k.toKey == toKey)

1122− let shouldInsert = authorized && validOrigin && not exists && recipientMsgCount < maxMessagesPerRecipient

1123 set *seqCounter = if shouldInsert then seqTs else seqCounter

1114 set *seqCounter = if shouldInsert then seqTs else seqCounter

1124 set *messages = if shouldInsert

1115 set *messages = if shouldInsert

1125 then union messages

1116 then union messages