5889a08 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: JsonNumberHandling, resource disposal, explicit MessageStatus patterns, use Option.ofObj, factor authenticateRequest

5889a08iko6 months ago

client/ApiClient.fs+10−29

compare with master

unifiedsplit

@@ -39,14 +39,6 @@ module ApiClient =

39 else ok t.Result)

40 |> ignore)

42− type private FlexibleInt64Converter() =

43− inherit JsonConverter<int64>()

44− override _.Read(reader, _, _) =

45− match reader.TokenType with

46− | JsonTokenType.String -> Int64.Parse(reader.GetString())

47− | _ -> reader.GetInt64()

48− override _.Write(writer, value, _) = writer.WriteNumberValue(value)

49−

50 type private MessageStatusConverter() =

42 type private MessageStatusConverter() =

51 inherit JsonConverter<MessageStatus>()

43 inherit JsonConverter<MessageStatus>()

52 override _.Read(reader, _, _) =

44 override _.Read(reader, _, _) =

@@ -67,8 +59,7 @@ module ApiClient =

67 | Unauthorized -> "unauthorized")

59 | Unauthorized -> "unauthorized")

69 let private jsonOpts =

61 let private jsonOpts =

70− let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true)

62+ let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true, NumberHandling = JsonNumberHandling.AllowReadingFromString)

71− opts.Converters.Add(FlexibleInt64Converter())

72 opts.Converters.Add(MessageStatusConverter())

63 opts.Converters.Add(MessageStatusConverter())

73 opts

64 opts

@@ -84,34 +75,24 @@ module ApiClient =

85 let private sendRequest (httpClient: HttpClient) (url: string) (body: string) (token: string option) =

76 let private sendRequest (httpClient: HttpClient) (url: string) (body: string) (token: string option) =

86 async {

77 async {

87− let request = new HttpRequestMessage(HttpMethod.Post, url)

78+ use request = new HttpRequestMessage(HttpMethod.Post, url)

88 request.Content <- new StringContent(body, Encoding.UTF8, "application/json")

79 request.Content <- new StringContent(body, Encoding.UTF8, "application/json")

89−

90− token

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

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

92−

93− let! response = httpClient.SendAsync(request) |> awaitTask

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

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

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

95− let doc = JsonDocument.Parse(text)

83+ use doc = JsonDocument.Parse(text)

96−

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

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

98− | true, err ->

99− let msg = err.GetString()

100− doc.Dispose()

101− return failwith $"{url}: {msg}"

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

102− | _ -> return doc

86+ | _ -> return text

103 }

87 }

104

105 let private post httpClient url body token =

89 let private post httpClient url body token =

106− async {

107− use! _doc = sendRequest httpClient url body token

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

108− return ()

109− }

110

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

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

112 async {

93 async {

113− use! doc = sendRequest httpClient url body token

94+ let! text = sendRequest httpClient url body token

114− return doc.RootElement.Deserialize<'T>(jsonOpts)

95+ return JsonSerializer.Deserialize<'T>(text, jsonOpts)

115 }

96 }

116

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

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

client/App.fs+2−3

@@ -201,11 +201,11 @@ module App =

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

202 | _ -> model, []

203

204+ | Sent(Ok { Status = ApiClient.Delivered | ApiClient.Federated | ApiClient.Queued }) -> model, []

204 | Sent(Ok { Status = ApiClient.Rejected }) ->

205 | Sent(Ok { Status = ApiClient.Rejected }) ->

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

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

206 | Sent(Ok { Status = ApiClient.Unauthorized }) ->

207 | Sent(Ok { Status = ApiClient.Unauthorized }) ->

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

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

208− | Sent(Ok _) -> model, []

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

210

211 | PollResult(incoming, status, newCursor) ->

@@ -493,8 +493,7 @@ module App =

493 model.Messages

494 |> Map.tryFind c.Pubkey

495 |> Option.bind List.tryLast

496− |> Option.map _.Body

497− |> Option.map (fun b -> if b.Length > 40 then b.[..39] + "..." else b)

496+ |> Option.map (fun m -> if m.Body.Length > 40 then m.Body.[..39] + "..." else m.Body)

498 |> Option.defaultValue ""

497 |> Option.defaultValue ""

499

498

500 Button($"{c.Nickname}\n{preview}", Nav(Chat(c.Pubkey, "")))

499 Button($"{c.Nickname}\n{preview}", Nav(Chat(c.Pubkey, "")))

client/Store.fs+3−3

@@ -71,9 +71,9 @@ module Store =

71 use db = openDb ()

72 let settings = db.GetCollection<SettingsDoc>("settings").FindById(BsonValue "settings")

74− match box settings with

74+ match settings |> Option.ofObj with

75− | null -> None

75+ | None -> None

76− | _ ->

76+ | Some settings ->

77 let contacts = db.GetCollection<Contact>("contacts").FindAll() |> Seq.toList

79 let messages =

server.knot+10−14

@@ -69,10 +69,10 @@ type PresenceEntry = {pubkey: PubkeyHex, server: Text, expiresAt: Timestamp, tim

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

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

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

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

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

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

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

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

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

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

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

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

@@ -371,6 +371,9 @@ authenticateSession = \sessions token t ->

371 Nothing {} -> Unauthorized {}

372 Just {value: s} -> Authorized {pubkey: s.pubkey}

373

374+authenticateRequest = \sessions authorization t ->

375+ authenticateSession sessions (extractToken authorization) t

376+

374extractToken = \authHeader ->

377extractToken = \authHeader ->

375 let token = drop 7 authHeader in

378 let token = drop 7 authHeader in

376 if toLower (take 7 authHeader) == "bearer " && not (tooLong token maxTokenLen)

379 if toLower (take 7 authHeader) == "bearer " && not (tooLong token maxTokenLen)

@@ -771,11 +774,7 @@ serve = \req -> case req of

771 case result.verify of

774 case result.verify of

772 VerifyOk {peerServers} ->

775 VerifyOk {peerServers} ->

773 when federationEnabled

776 when federationEnabled

774− (sendToEach peerServers (\server -> do

775− _ <- fetch (federationScheme ++ server) (RecvGossip {

776− authorization: "Bearer " ++ federationSecret,

777− events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})

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

778− yield {}))

779 _ -> yield {}

778 _ -> yield {}

780 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

779 broadcastOfflineGossip t result.pr.peerServers expiredLocal)

781 yield (case result.verify of

780 yield (case result.verify of

@@ -797,14 +796,13 @@ serve = \req -> case req of

797 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do

796 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do

798 let to = normalizeHex to

797 let to = normalizeHex to

799 let encryptedBlob = normalizeHex encryptedBlob

798 let encryptedBlob = normalizeHex encryptedBlob

800− let token = extractToken authorization

801 t <- now

799 t <- now

802 msgId <- genToken

800 msgId <- genToken

803 let clampedTs = clampTimestamp timestamp t

801 let clampedTs = clampTimestamp timestamp t

804 result <- atomic do

802 result <- atomic do

805 pr <- maybePrune t

803 pr <- maybePrune t

806 sessions <- *sessions

804 sessions <- *sessions

807− let auth = authenticateSession sessions token t

805+ let auth = authenticateRequest sessions authorization t

808 case auth of

806 case auth of

809 Unauthorized {} ->

807 Unauthorized {} ->

810 yield {pr: pr, send: SendUnauthorized {}}

808 yield {pr: pr, send: SendUnauthorized {}}

@@ -853,13 +851,12 @@ serve = \req -> case req of

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

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

854

852

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

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

856− let token = extractToken authorization

857 t <- now

854 t <- now

858 let dedupedIds = dedupMessageIds messageIds

855 let dedupedIds = dedupMessageIds messageIds

859 result <- atomic do

856 result <- atomic do

860 pr <- maybePrune t

857 pr <- maybePrune t

861 sessions <- *sessions

858 sessions <- *sessions

862− let auth = authenticateSession sessions token t

859+ let auth = authenticateRequest sessions authorization t

863 case auth of

860 case auth of

864 Unauthorized {} ->

861 Unauthorized {} ->

865 yield {pr: pr, ack: AckUnauthorized {}}

862 yield {pr: pr, ack: AckUnauthorized {}}

@@ -921,12 +918,11 @@ serve = \req -> case req of

921

918

922 LookupPresence {pubkey, authorization, respond} -> do

919 LookupPresence {pubkey, authorization, respond} -> do

923 let pubkey = normalizeHex pubkey

920 let pubkey = normalizeHex pubkey

924− let token = extractToken authorization

925 t <- now

921 t <- now

926 result <- atomic do

922 result <- atomic do

927 pr <- maybePrune t

923 pr <- maybePrune t

928 sessions <- *sessions

924 sessions <- *sessions

929− let auth = authenticateSession sessions token t

925+ let auth = authenticateRequest sessions authorization t

930 case auth of

926 case auth of

931 Unauthorized {} ->

927 Unauthorized {} ->

932 yield {pr: pr, lookup: LookupUnauthorized {}}

928 yield {pr: pr, lookup: LookupUnauthorized {}}