c622597 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Improve server type safety and simplify relay handlers

c622597iko6 months ago

client/ApiClient.fs+17−16

compare with master

unifiedsplit

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

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

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

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

65− use doc = JsonDocument.Parse(text)

65+ let doc = JsonDocument.Parse(text)

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

67+ | true, err ->

68+ doc.Dispose()

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

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

68− | _ -> return text

70+ | _ -> return doc

69 }

71 }

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

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

72 async {

74 async {

73− let! text = sendRequest httpClient url body token

75+ use! doc = sendRequest httpClient url body token

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

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

75 }

77 }

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

78− use doc = JsonDocument.Parse(text)

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

80−

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

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

82 async {

80 async {

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

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

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

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

85− let challenge = getString text "challenge"

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

86 let sigHex = Crypto.signChallenge identity.PrivKey challenge

84 let sigHex = Crypto.signChallenge identity.PrivKey challenge

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

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

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

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

89− let token = getString text "token"

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

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

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

91 return token

89 return token

92 }

90 }

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

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

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

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

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

96 async {

94 async {

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

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

98− match getString text "status" with

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

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

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

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

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

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

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

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

108

106

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

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

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

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

109+ async {

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

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

111+ ()

112+ }

client/App.fs+3−3

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

144 (Option.map (

145 List.map (fun m ->

146 match m.Direction with

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

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

148 { m with

149 Direction = Outgoing DeliveryStatus.Delivered }

150 | _ -> m)

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

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

670

671

672− button "Generate Identity" GenIdentity

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

673 })

674 .padding(30.)

675 .centerVertical ()

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

789 let prefix, tick =

790 match m.Direction with

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

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

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

793 | Incoming -> "", ""

794

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

client/Buttons.fs+3−2

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

1namespace Skrepka

3open System

4open System

4open System.IO

5open System.IO

5open System.Text.Json

6open System.Text.Json

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

10open type Fabulous.Maui.View

11open type Fabulous.Maui.View

12module Buttons =

13module Buttons =

13− let button text msg =

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

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

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 @@

21 </PropertyGroup>

23 <ItemGroup>

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

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

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

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

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

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

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

client/Store.fs+7−5

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

80 let loadIdentity () =

81 async {

82− let privKeyB64 =

82+ let! privKeyB64 =

83+ async {

83− try

84+ try

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

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

85− with _ ->

86+ with _ ->

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

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

88+ }

88 return

90 return

89 privKeyB64

91 privKeyB64

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

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

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−5d8b947be179b38191ae86d14581cb7ade1a8c6c2068a71f3fb4f519ddb5bdaa

1+e379db3bdff4a4a771cdab0914453c7ee01e98a757a35695e8595a28293a349c

server.knot+31−26

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

87 MsUnauthorized {} -> "unauthorized"

88 MsRejected {} -> "rejected")

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

91+

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

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

91type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen

93type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen

92type BlobHex = Text where isValidBoundedHex maxBlobLen

94type BlobHex = Text where isValidBoundedHex maxBlobLen

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

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

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

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

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

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

112data 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}

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

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

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

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

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

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

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

116

117

118

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

375

376

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

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

377

378

379+deliveryToMessageStatus = \ds -> case ds of

380+ DsDelivered {} -> MsDelivered {}

381+ DsFederated {} -> MsFederated {}

382+ DsQueued {} -> MsQueued {}

383+

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

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

379

385

380takeN = \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

386takeN = \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 ->

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

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

519 else []

525 else []

520 else []

526 else []

521− in {

527+ in fold (\acc e ->

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

528+ case e.eventType of

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

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

524− }

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

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

525

532

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

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

527sendToEach = \servers action ->

534sendToEach = \servers action ->

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

831 auth <- authenticateRequest authorization t

838 auth <- authenticateRequest authorization t

832 case auth of

839 case auth of

833 Unauthorized {} ->

840 Unauthorized {} ->

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

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

835 Authorized {pubkey: fromKey} -> do

842 Authorized {pubkey: fromKey} -> do

836 messages <- *messages

843 messages <- *messages

837 if countMessagesFor messages to t >= maxMessagesPerRecipient

844 if countMessagesFor messages to t >= maxMessagesPerRecipient

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

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

839 else do

846 else do

840 presence <- *presence

847 presence <- *presence

841 seqCounter <- *seqCounter

848 seqCounter <- *seqCounter

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

850 forwards <- *forwards

857 forwards <- *forwards

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

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

852 let shouldForward = federationEnabled && count forwardServers > 0

859 let shouldForward = federationEnabled && count forwardServers > 0

853− let status = if localOnline then MsDelivered {}

860+ let delivery = if localOnline then DsDelivered {}

854− else if shouldForward then MsFederated {}

861+ else if shouldForward then DsFederated {}

855− else MsQueued {}

862+ else DsQueued {}

856 set *forwards = if shouldForward

863 set *forwards = if shouldForward

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

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

858 else forwards

865 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}}

860 case result.send of

867 case result.send of

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

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

862 fork (do

869 fork (do

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

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

864 sendToEach remoteServers (\server -> do

871 sendToEach remoteServers (\server -> do

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

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

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

868 authorization: federationAuth})

875 authorization: federationAuth})

869 whenOk fwdResult (removeForward msgId server))

876 whenOk fwdResult (removeForward msgId server))

870− case status of

877+ case delivery of

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

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

872 _ -> yield {})

879 _ -> yield {})

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

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

874 _ -> forkBroadcastOffline t result.pr

881 _ -> forkBroadcastOffline t result.pr

875 yield (case result.send of

882 yield (case result.send of

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

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

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

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

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

879

885

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

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

881 t <- now

887 t <- now

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

921 auth <- authenticateRequest authorization t

927 auth <- authenticateRequest authorization t

922 case auth of

928 case auth of

923 Unauthorized {} ->

929 Unauthorized {} ->

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

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

925 Authorized _ -> do

931 Authorized _ -> do

926 presence <- *presence

932 presence <- *presence

927 let valid = do

933 let valid = do

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

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

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

930 yield p

936 yield p

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

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

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

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

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

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

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

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

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

935 let foundServer = if localOnline then serverHostN

942 let foundServer = if localOnline then serverHostN

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

943 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 {}}

938 forkBroadcastOffline t result.pr

945 forkBroadcastOffline t result.pr

939− yield (case result.lookup of

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

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

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

942

947

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

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

944 t <- now

949 t <- now