c622597 · skrepka · git.iko.soy

git.iko.soy/skrepka

Improve server type safety and simplify relay handlers

- Add DeliveryStatus ADT for narrower delivery state types - Collapse SendResult variants to SendFailed/SendDone for clarity - Remove LookupResult and inline response fields into result record - Optimize validGossipEvents with single-pass fold instead of two iterations - Simplify LookupPresence handler: separate filter from max-finding logic - Add deliveryToMessageStatus converter for API responses

commitc622597942208741d3c804aefd43a0d3c4efc092 authoriko <mail@iko.soy> dateSun 12 Apr 2026, 08:58 (6 months ago) parentf1f6e11

9 files changed+71−54

compare with master

unifiedsplit

client/ApiClient.fs+17−16 client/App.fs+3−3 client/Buttons.fs+3−2 client/Constants.fs+7 client/Skrepka.fsproj+1 client/Store.fs+7−5 client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfo.fs+1−1 client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfoInputs.cache+1−1 server.knot+31−26

client/ApiClient.fs+17−16

@@ -62,31 +62,29 @@ module ApiClient =

6262 token |> Option.iter (fun t -> request.Headers.Add("Authorization", $"Bearer {t}"))

6363 use! response = httpClient.SendAsync(request) |> awaitTask

6464 let! text = response.Content.ReadAsStringAsync() |> awaitTask

65− use doc = JsonDocument.Parse(text)

65+ let doc = JsonDocument.Parse(text)

6666 match doc.RootElement.TryGetProperty("error") with

67− | true, err -> return failwith $"{url}: {err.GetString()}"

68− | _ -> return text

67+ | true, err ->

68+ doc.Dispose()

69+ return failwith $"{url}: {err.GetString()}"

70+ | _ -> return doc

6971 }

7072

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

7274 async {

73− let! text = sendRequest httpClient url body token

74− return JsonSerializer.Deserialize<'T>(text, jsonOpts)

75+ use! doc = sendRequest httpClient url body token

76+ return doc.RootElement.Deserialize<'T>(jsonOpts)

7577 }

7678

77− let private getString (text: string) (prop: string) =

78− use doc = JsonDocument.Parse(text)

79− doc.RootElement.GetProperty(prop).GetString()

80−

8179 let authenticate (serverUrl: string) (identity: Crypto.Identity) =

8280 async {

8381 let body = JsonSerializer.Serialize({| pubkey = identity.PubKeyHex |})

84− let! text = sendRequest client $"{serverUrl}/auth/challenge" body None

85− let challenge = getString text "challenge"

82+ use! challengeDoc = sendRequest client $"{serverUrl}/auth/challenge" body None

83+ let challenge = challengeDoc.RootElement.GetProperty("challenge").GetString()

8684 let sigHex = Crypto.signChallenge identity.PrivKey challenge

8785 let body = JsonSerializer.Serialize({| pubkey = identity.PubKeyHex; challenge = challenge; signature = sigHex |})

88− let! text = sendRequest client $"{serverUrl}/auth/verify" body None

89− let token = getString text "token"

86+ use! tokenDoc = sendRequest client $"{serverUrl}/auth/verify" body None

87+ let token = tokenDoc.RootElement.GetProperty("token").GetString()

9088 if String.IsNullOrEmpty(token) then failwith "Authentication rejected by server"

9189 return token

9290 }

@@ -94,8 +92,8 @@ module ApiClient =

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

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

9694 async {

97− let! text = sendRequest client $"{serverUrl}/messages" body (Some token)

98− match getString text "status" with

95+ use! doc = sendRequest client $"{serverUrl}/messages" body (Some token)

96+ match doc.RootElement.GetProperty("status").GetString() with

9997 | "delivered" | "federated" | "queued" -> ()

10098 | "rejected" -> failwith "Message rejected by server"

10199 | "unauthorized" -> failwith "Not authorized to deliver message"

@@ -108,4 +106,7 @@ module ApiClient =

108106

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

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

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

109+ async {

110+ use! _ = sendRequest client $"{serverUrl}/messages/ack" body (Some token)

111+ ()

112+ }

client/App.fs+3−3

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

144144 (Option.map (

145145 List.map (fun m ->

146146 match m.Direction with

147− | Outgoing _ when Set.contains m.Id ackSet ->

147+ | Outgoing DeliveryStatus.Sent when Set.contains m.Id ackSet ->

148148 { m with

149149 Direction = Outgoing DeliveryStatus.Delivered }

150150 | _ -> m)

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

669669 Label("End-to-end encrypted messaging").font(size = 16.).centerTextHorizontal ()

670670

671671

672− button "Generate Identity" GenIdentity

672+ Button("Generate Identity", GenIdentity).centerHorizontal ()

673673 })

674674 .padding(30.)

675675 .centerVertical ()

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

789789 let prefix, tick =

790790 match m.Direction with

791791 | Outgoing DeliveryStatus.Delivered -> "You: ", " \u2713"

792− | Outgoing _ -> "You: ", ""

792+ | Outgoing DeliveryStatus.Sent -> "You: ", ""

793793 | Incoming -> "", ""

794794

795795 Label($"{prefix}{m.Body}{tick}").padding(8.).font (size = 14.)

client/Buttons.fs+3−2

@@ -1,5 +1,6 @@

11namespace Skrepka

34open System

45open System.IO

56open System.Text.Json

@@ -10,5 +11,5 @@ open Microsoft.Maui.Graphics

1011open type Fabulous.Maui.View

1112

1213module Buttons =

13− let button text msg =

14− Border(Label(text)).width(4).gestureRecognizers () { TapGestureRecognizer(msg) }

14+ let button (text: string) (msg: 'msg) : WidgetBuilder<'msg, IFabButton> =

15+ (Button(text, msg).borderWidth(4).background (Constants.accentColor)).borderColor (Colors.Black)

client/Constants.fsnew file+7

@@ -0,0 +1,7 @@

1+namespace Skrepka

3+open Fabulous.Maui

4+open Microsoft.Maui.Graphics

6+module Constants =

7+ let accentColor = Color.FromRgb(98, 54, 255)

client/Skrepka.fsproj+1

@@ -21,6 +21,7 @@

2121 </PropertyGroup>

2222

2323 <ItemGroup>

24+ <Compile Include="Constants.fs" />

2425 <Compile Include="Crypto.fs" />

2526 <Compile Include="ApiClient.fs" />

2627 <Compile Include="Phonemic.fs" />

client/Store.fs+7−5

@@ -79,11 +79,13 @@ module Store =

7979

8080 let loadIdentity () =

8181 async {

82− let privKeyB64 =

83− try

84− SecureStorage.Default.GetAsync("identity_privkey").Result

85− with _ ->

86− Preferences.Default.Get<string>("identity_privkey", null)

82+ let! privKeyB64 =

83+ async {

84+ try

85+ return! SecureStorage.Default.GetAsync("identity_privkey") |> Async.AwaitTask

86+ with _ ->

87+ return Preferences.Default.Get<string>("identity_privkey", null)

88+ }

8789

8890 return

8991 privKeyB64

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

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

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

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

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

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

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

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

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

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

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

@@ -1 +1 @@

1−5d8b947be179b38191ae86d14581cb7ade1a8c6c2068a71f3fb4f519ddb5bdaa

1+e379db3bdff4a4a771cdab0914453c7ee01e98a757a35695e8595a28293a349c

server.knot+31−26

@@ -87,6 +87,8 @@ impl ToJSON MessageStatus where

8787 MsUnauthorized {} -> "unauthorized"

8888 MsRejected {} -> "rejected")

8989

90+data DeliveryStatus = DsDelivered {} | DsFederated {} | DsQueued {}

91+

9092isValidBoundedHex = \maxLen s -> isValidHex s && not (tooLong s maxLen) && s == normalizeHex s

9193type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen

9294type BlobHex = Text where isValidBoundedHex maxBlobLen

@@ -108,10 +110,9 @@ type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Times

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

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

110112data AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

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

113+data SendResult = SendFailed {status: MessageStatus} | SendDone {delivery: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}

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

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

114−data LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}

115116type PollResponse = {events: [PollEvent], cursor: Timestamp, authorized: Bool}

116117

117118

@@ -375,6 +376,11 @@ clampTtl = clamp 1 maxPresenceTtl

375376

376377clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp

377378

379+deliveryToMessageStatus = \ds -> case ds of

380+ DsDelivered {} -> MsDelivered {}

381+ DsFederated {} -> MsFederated {}

382+ DsQueued {} -> MsQueued {}

383+

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

379385

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

@@ -518,10 +524,11 @@ validGossipEvents = \events t ->

518524 then [{pubkey: e.pubkey, server: e.server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}]

519525 else []

520526 else []

521− in {

522− online: do e <- events; case e.eventType of GossipOnline {} -> validate e; _ -> [],

523− offline: do e <- events; case e.eventType of GossipOffline {} -> validate e; _ -> []

524− }

527+ in fold (\acc e ->

528+ case e.eventType of

529+ GossipOnline {} -> {online: union acc.online (validate e), offline: acc.offline}

530+ GossipOffline {} -> {online: acc.online, offline: union acc.offline (validate e)}

531+ _ -> acc) {online: [], offline: []} events

525532

526533sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}

527534sendToEach = \servers action ->

@@ -831,11 +838,11 @@ serve = \req -> case req of

831838 auth <- authenticateRequest authorization t

832839 case auth of

833840 Unauthorized {} ->

834− yield {pr: pr, send: SendUnauthorized {}}

841+ yield {pr: pr, send: SendFailed {status: MsUnauthorized {}}}

835842 Authorized {pubkey: fromKey} -> do

836843 messages <- *messages

837844 if countMessagesFor messages to t >= maxMessagesPerRecipient

838− then yield {pr: pr, send: SendRejected {}}

845+ then yield {pr: pr, send: SendFailed {status: MsRejected {}}}

839846 else do

840847 presence <- *presence

841848 seqCounter <- *seqCounter

@@ -850,15 +857,15 @@ serve = \req -> case req of

850857 forwards <- *forwards

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

852859 let shouldForward = federationEnabled && count forwardServers > 0

853− let status = if localOnline then MsDelivered {}

854− else if shouldForward then MsFederated {}

855− else MsQueued {}

860+ let delivery = if localOnline then DsDelivered {}

861+ else if shouldForward then DsFederated {}

862+ else DsQueued {}

856863 set *forwards = if shouldForward

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

858865 else forwards

859− yield {pr: pr, send: SendDone {status: status, remoteServers: remoteServers, fromKey: fromKey}}

866+ yield {pr: pr, send: SendDone {delivery: delivery, remoteServers: remoteServers, fromKey: fromKey}}

860867 case result.send of

861− SendDone {status, remoteServers, fromKey} ->

868+ SendDone {delivery, remoteServers, fromKey} ->

862869 fork (do

863870 when (count remoteServers > 0 && federationEnabled) (do

864871 sendToEach remoteServers (\server -> do

@@ -867,15 +874,14 @@ serve = \req -> case req of

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

868875 authorization: federationAuth})

869876 whenOk fwdResult (removeForward msgId server))

870− case status of

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

877+ case delivery of

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

872879 _ -> yield {})

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

874881 _ -> forkBroadcastOffline t result.pr

875882 yield (case result.send of

876− SendUnauthorized {} -> respond {status: MsUnauthorized {}, messageId: ""}

877− SendRejected {} -> respond {status: MsRejected {}, messageId: ""}

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

883+ SendFailed {status} -> respond {status: status, messageId: ""}

884+ SendDone {delivery} -> respond {status: deliveryToMessageStatus delivery, messageId: msgId})

879885

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

881887 t <- now

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

921927 auth <- authenticateRequest authorization t

922928 case auth of

923929 Unauthorized {} ->

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

930+ yield {pr: pr, server: "", authorized: False {}}

925931 Authorized _ -> do

926932 presence <- *presence

927933 let valid = do

@@ -929,16 +935,15 @@ serve = \req -> case req of

929935 where p.pubkey == pubkey && p.expiresAt > t

930936 yield p

931937 let localOnline = any valid (\p -> isLocalServer p.server)

932− let bestRemote = fold (\acc p ->

933− let dominated = case acc of Nothing {} -> True {}; Just {value: v} -> p.expiresAt > v.expiresAt in

934− if not (isLocalServer p.server) && dominated then Just {value: p} else acc) Nothing {} valid

938+ let remoteValid = do p <- valid; where not (isLocalServer p.server); yield p

939+ let bestRemote = fold (\acc p -> case acc of

940+ Nothing {} -> Just {value: p}

941+ Just {value: v} -> if p.expiresAt > v.expiresAt then Just {value: p} else acc) Nothing {} remoteValid

935942 let foundServer = if localOnline then serverHostN

936943 else case bestRemote of Just {value: p} -> p.server; Nothing {} -> ""

937− yield {pr: pr, lookup: LookupDone {server: foundServer}}

944+ yield {pr: pr, server: foundServer, authorized: True {}}

938945 forkBroadcastOffline t result.pr

939− yield (case result.lookup of

940− LookupUnauthorized {} -> respond {server: "", authorized: False {}}

941− LookupDone {server} -> respond {server: server, authorized: True {}})

946+ yield (respond {server: result.server, authorized: result.authorized})

942947

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

944949 t <- now