3f992e7 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: factor deriveKey and truncate helpers, type Sent as MessageStatus, use match\! in CmdLoadState

3f992e7iko6 months ago

client/App.fs+12−13

compare with master

unifiedsplit

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

66 | DoDisconnect

67 | SetCompose of string

68 | DoSend

69− | Sent of Result<ApiClient.SendResult, string>

69+ | Sent of Result<ApiClient.MessageStatus, string>

70 | SetNewPubkey of string

71 | SetNewNickname of string

72 | DoSaveContact

@@ -89,8 +89,10 @@ module App =

90 // ── Helpers ──

92− let private truncKey (hex: string) =

92+ let private truncate maxLen (s: string) =

93− if hex.Length > 16 then hex.[..15] + "..." else hex

93+ if s.Length > maxLen then s.[..maxLen - 1] + "..." else s

94+

95+ let private truncKey (hex: string) = truncate 16 hex

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

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

96 contacts

98 contacts

@@ -201,10 +203,10 @@ module App =

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

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

202 | _ -> model, []

204 | _ -> model, []

203

205

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

206+ | Sent(Ok(ApiClient.Delivered | ApiClient.Federated | ApiClient.Queued)) -> model, []

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

207+ | Sent(Ok ApiClient.Rejected) ->

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

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

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

209+ | Sent(Ok ApiClient.Unauthorized) ->

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

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

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

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

210

212

@@ -325,7 +327,7 @@ module App =

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

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

326 let blobHex = Crypto.toHex blob

328 let blobHex = Crypto.toHex blob

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

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

328− return Sent(Ok result)

330+ return Sent(Ok result.Status)

329 with ex ->

331 with ex ->

330 return Sent(Error ex.Message)

332 return Sent(Error ex.Message)

331 })

333 })

@@ -370,11 +372,8 @@ module App =

370 | CmdLoadState ->

372 | CmdLoadState ->

371 Cmd.ofEffect (fun dispatch ->

373 Cmd.ofEffect (fun dispatch ->

372 async {

374 async {

373− let! identity = Store.loadIdentity ()

375+ match! Store.loadIdentity () with

374− match identity with

375− | Some id ->

376− let data = Store.loadData ()

377− dispatch (StateLoaded(id, data))

376+ | Some id -> dispatch (StateLoaded(id, Store.loadData ()))

378 | None -> ()

377 | None -> ()

379 }

378 }

380 |> Async.Start)

379 |> Async.Start)

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

493 model.Messages

492 model.Messages

494 |> Map.tryFind c.Pubkey

493 |> Map.tryFind c.Pubkey

495 |> Option.bind List.tryLast

494 |> Option.bind List.tryLast

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

495+ |> Option.map (fun m -> truncate 40 m.Body)

497 |> Option.defaultValue ""

496 |> Option.defaultValue ""

498

497

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

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

client/Crypto.fs+7−6

@@ -23,15 +23,18 @@ module Crypto =

23 let message = Encoding.UTF8.GetBytes(challenge)

24 PublicKeyAuth.SignDetached(message, privKey) |> toHex

26+ let private deriveKey ephPub recipientX25519Pub rawSecret =

27+ let salt = Array.append ephPub recipientX25519Pub

28+ let info = Encoding.UTF8.GetBytes("skrepka-v1")

29+ HKDF.DeriveKey(HashAlgorithmName.SHA256, rawSecret, 32, salt, info)

30+

26 let encrypt (senderPrivKey: byte[]) (recipientEd25519Pub: byte[]) (plaintext: string) : byte[] =

31 let encrypt (senderPrivKey: byte[]) (recipientEd25519Pub: byte[]) (plaintext: string) : byte[] =

27 let senderPubKey = senderPrivKey.[32..63]

32 let senderPubKey = senderPrivKey.[32..63]

28 let ephKp = PublicKeyBox.GenerateKeyPair()

33 let ephKp = PublicKeyBox.GenerateKeyPair()

29 let recipientX25519Pub =

34 let recipientX25519Pub =

30 PublicKeyAuth.ConvertEd25519PublicKeyToCurve25519PublicKey(recipientEd25519Pub)

35 PublicKeyAuth.ConvertEd25519PublicKeyToCurve25519PublicKey(recipientEd25519Pub)

31 let rawSecret = ScalarMult.Mult(ephKp.PrivateKey, recipientX25519Pub)

36 let rawSecret = ScalarMult.Mult(ephKp.PrivateKey, recipientX25519Pub)

32− let salt = Array.append ephKp.PublicKey recipientX25519Pub

37+ let key = deriveKey ephKp.PublicKey recipientX25519Pub rawSecret

33− let info = Encoding.UTF8.GetBytes("skrepka-v1")

34− let key = HKDF.DeriveKey(HashAlgorithmName.SHA256, rawSecret, 32, salt, info)

35 let nonce = SodiumCore.GetRandomBytes(24)

38 let nonce = SodiumCore.GetRandomBytes(24)

36 let ptBytes = Encoding.UTF8.GetBytes(plaintext)

39 let ptBytes = Encoding.UTF8.GetBytes(plaintext)

37 let ciphertext = SecretAeadXChaCha20Poly1305.Encrypt(ptBytes, nonce, key)

40 let ciphertext = SecretAeadXChaCha20Poly1305.Encrypt(ptBytes, nonce, key)

@@ -58,9 +61,7 @@ module Crypto =

58 let recipientEd25519Pub = recipientPrivKey.[32..63]

61 let recipientEd25519Pub = recipientPrivKey.[32..63]

59 let recipientX25519Pub =

62 let recipientX25519Pub =

60 PublicKeyAuth.ConvertEd25519PublicKeyToCurve25519PublicKey(recipientEd25519Pub)

63 PublicKeyAuth.ConvertEd25519PublicKeyToCurve25519PublicKey(recipientEd25519Pub)

61− let salt = Array.append ephPub recipientX25519Pub

64+ let key = deriveKey ephPub recipientX25519Pub rawSecret

62− let info = Encoding.UTF8.GetBytes("skrepka-v1")

63− let key = HKDF.DeriveKey(HashAlgorithmName.SHA256, rawSecret, 32, salt, info)

64 let plaintext = SecretAeadXChaCha20Poly1305.Decrypt(ciphertext, nonce, key)

65 let plaintext = SecretAeadXChaCha20Poly1305.Decrypt(ciphertext, nonce, key)

65 Some(Encoding.UTF8.GetString(plaintext), toHex senderPub)

66 Some(Encoding.UTF8.GetString(plaintext), toHex senderPub)

66 with _ ->

67 with _ ->

server.knot+27−22

@@ -516,7 +516,7 @@ validGossipEvents = \events t -> do

516 where expiresAt > t

517 yield {eventType: e.eventType, pubkey: normalizeHex e.pubkey, server: server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}

518

519−sendToEach : [Text] -> (Text -> (a {})) -> a {}

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

520sendToEach = \servers action ->

521 case headOf servers of

522 Nothing {} -> yield {}

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

994 let updatesOnlyMerged = mergeByPubkeyServer presence updatesOnly in

995 let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged offlineOnlyKeys trustedOffline t in

996 let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in

997− let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e); where none updatesOnlyAfterOffline (\p -> samePubkeyServer p e); yield e in

997+ let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e) && none updatesOnlyAfterOffline (\p -> samePubkeyServer p e); yield e in

998 let reclaimedEntries = takeN newEntries reclaimSlots in

999 {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,

1000 appliedOnline: union

@@ -1029,12 +1029,14 @@ serve = \req -> case req of

1029 t <- now

1030 let authorized = verifyFederationAuth authorization

1031 let validOrigin = isFederatedOrigin originServer

1032− let clampedTs = clampTimestamp timestamp t

1033− result <- atomic do

1034− pr <- maybePrune t

1035− if not (authorized && validOrigin)

1032+ if not (authorized && validOrigin)

1033+ then do

1034+ maybePruneAndBroadcast t

1036− then yield {pr: pr, ok: False {}}

1035+ yield (respond {ok: False {}})

1037− else do

1036+ else do

1037+ let clampedTs = clampTimestamp timestamp t

1038+ result <- atomic do

1039+ pr <- maybePrune t

1038 messages <- *messages

1040 messages <- *messages

1039 ackedIds <- *ackedIds

1041 ackedIds <- *ackedIds

1040 if any messages (\m -> m.messageId == messageId && m.toKey == toKey)

1042 if any messages (\m -> m.messageId == messageId && m.toKey == toKey)

@@ -1050,27 +1052,30 @@ serve = \req -> case req of

1050 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

1052 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

1051 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]

1053 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]

1052 yield {pr: pr, ok: True {}}

1054 yield {pr: pr, ok: True {}}

1053− forkBroadcastOffline t result.pr

1055+ forkBroadcastOffline t result.pr

1054− yield (respond {ok: result.ok})

1056+ yield (respond {ok: result.ok})

1055

1057

1056 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do

1058 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do

1057 let fromServer = normalizeServerName fromServer

1059 let fromServer = normalizeServerName fromServer

1058 let originServer = normalizeServerName originServer

1060 let originServer = normalizeServerName originServer

1059 t <- now

1061 t <- now

1060 let authorized = verifyFederationAuth authorization

1062 let authorized = verifyFederationAuth authorization

1061− let validAck = authorized && originServer == serverHostN && not (fromServer == serverHostN)

1063+ if not authorized || not (originServer == serverHostN) || fromServer == serverHostN

1062− pruneResult <- atomic do

1064+ then do

1063− pr <- maybePrune t

1065+ maybePruneAndBroadcast t

1064− when validAck (do

1066+ yield (respond {ok: False {}})

1067+ else do

1065 let dedupedIds = dedupMessageIds messageIds

1068 let dedupedIds = dedupMessageIds messageIds

1069+ pruneResult <- atomic do

1070+ pr <- maybePrune t

1066− forwards <- *forwards

1071+ forwards <- *forwards

1067− set *forwards = do

1072+ set *forwards = do

1068− f <- forwards

1073+ f <- forwards

1069− where not (f.toServer == fromServer && any dedupedIds (\mid -> f.messageId == mid))

1074+ where not (f.toServer == fromServer && any dedupedIds (\mid -> f.messageId == mid))

1070− yield f)

1075+ yield f

1071− yield pr

1076+ yield pr

1072− forkBroadcastOffline t pruneResult

1077+ forkBroadcastOffline t pruneResult

1073− yield (respond {ok: validAck})

1078+ yield (respond {ok: True {}})

1074

1079

1075 Prune {authorization, respond} -> do

1080 Prune {authorization, respond} -> do

1076 t <- now

1081 t <- now