c0cce11 · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: require normalized hex in types, inline PollResult/AckResult ADTs, make authenticateRequest read sessions internally

c0cce11iko6 months ago

server.knot+28−56

compare with master

unifiedsplit

@@ -53,10 +53,10 @@ type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server:

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

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

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

57−type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen)

57+type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s

58−type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen)

58+type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s

59−type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen)

59+type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s

60type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s)

61type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s))

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

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

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

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

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

74type DeliveryStatus = Text where \s -> s == "delivered" || s == "federated" || s == "queued"

73type DeliveryStatus = Text where \s -> s == "delivered" || s == "federated" || s == "queued"

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

74type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}

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

79-- ============================================

77-- ============================================

@@ -370,8 +368,9 @@ authenticateSession = \sessions token t ->

370 Nothing {} -> Unauthorized {}

368 Nothing {} -> Unauthorized {}

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

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

372

370

373−authenticateRequest = \sessions authorization t ->

371+authenticateRequest = \authorization t -> do

372+ sessions <- *sessions

374− authenticateSession sessions (extractToken authorization) t

373+ yield (authenticateSession sessions (extractToken authorization) t)

375

374

376extractToken = \authHeader ->

375extractToken = \authHeader ->

377 let token = drop 7 authHeader in

376 let token = drop 7 authHeader in

@@ -401,10 +400,9 @@ takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1,

401

400

402dedupMessageIds = \messageIds ->

401dedupMessageIds = \messageIds ->

403 fold (\acc mid ->

402 fold (\acc mid ->

404− let nmid = normalizeHex mid in

405 if count acc >= maxMessageIds then acc

403 if count acc >= maxMessageIds then acc

406− else if any acc (\a -> a == nmid) then acc

404+ else if any acc (\a -> a == mid) then acc

407− else union acc [nmid]) [] messageIds

405+ else union acc [mid]) [] messageIds

408

406

409boundedSmallest = \items n getKey ->

407boundedSmallest = \items n getKey ->

410 (fold (\acc a ->

408 (fold (\acc a ->

@@ -703,7 +701,7 @@ pollOnce = \token cursor -> do

703 let auth = authenticateSession sessions token t

701 let auth = authenticateSession sessions token t

704 case auth of

702 case auth of

705 Unauthorized {} ->

703 Unauthorized {} ->

706− yield PollUnauthorized {}

704+ yield {events: [], cursor: -1, authorized: False {}}

707 Authorized {pubkey} -> do

705 Authorized {pubkey} -> do

708 seqCounter <- *seqCounter

706 seqCounter <- *seqCounter

709 messages <- *messages

707 messages <- *messages

@@ -721,21 +719,16 @@ pollOnce = \token cursor -> do

721 encryptedBlob: m.encryptedBlob,

719 encryptedBlob: m.encryptedBlob,

722 timestamp: m.timestamp}}

720 timestamp: m.timestamp}}

723 let lastReceivedAt = fold (\acc m -> if m.receivedAt > acc then m.receivedAt else acc) clampedCursor limitedMsgs

721 let lastReceivedAt = fold (\acc m -> if m.receivedAt > acc then m.receivedAt else acc) clampedCursor limitedMsgs

724− yield PollAuthorized {events: evts, cursor: lastReceivedAt}

722+ yield {events: evts, cursor: lastReceivedAt, authorized: True {}}

725

723

726pollLoop = \token cursor deadline -> do

724pollLoop = \token cursor deadline -> do

727 result <- pollOnce token cursor

725 result <- pollOnce token cursor

728 t <- now

726 t <- now

729− case result of

730− PollUnauthorized {} -> yield result

731− PollAuthorized {events} ->

732− if count events == 0 && t < deadline

727+ if result.authorized && count result.events == 0 && t < deadline

733− then do

728+ then do

734− let remaining = deadline - t

729+ sleep (clamp 1 500 (deadline - t))

735− let sleepMs = if remaining > 500 then 500<Ms> else remaining

736− sleep sleepMs

737− pollLoop token cursor deadline

730+ pollLoop token cursor deadline

738− else yield result

731+ else yield result

739

732

740-- ============================================

733-- ============================================

741-- Request Handler

734-- Request Handler

@@ -744,7 +737,6 @@ pollLoop = \token cursor deadline -> do

744serve = \req -> case req of

737serve = \req -> case req of

745

738

746 ReqChallenge {pubkey, respond} -> do

739 ReqChallenge {pubkey, respond} -> do

747− let pubkey = normalizeHex pubkey

748 challenge <- genToken

740 challenge <- genToken

749 t <- now

741 t <- now

750 pruneResult <- atomic do

742 pruneResult <- atomic do

@@ -759,7 +751,6 @@ serve = \req -> case req of

759 yield (respond {challenge: challenge})

751 yield (respond {challenge: challenge})

760

752

761 VerifyAuth {pubkey, challenge, signature, respond} -> do

753 VerifyAuth {pubkey, challenge, signature, respond} -> do

762− let pubkey = normalizeHex pubkey

763 t <- now

754 t <- now

764 token <- genToken

755 token <- genToken

765 let expiry = t + sessionExpiry

756 let expiry = t + sessionExpiry

@@ -809,20 +800,15 @@ serve = \req -> case req of

809 result <- pollLoop token cursor deadline

800 result <- pollLoop token cursor deadline

810 tAfterPoll <- now

801 tAfterPoll <- now

811 maybePruneAndBroadcast tAfterPoll

802 maybePruneAndBroadcast tAfterPoll

812− yield (case result of

803+ yield (respond result)

813− PollUnauthorized {} -> respond {events: [], cursor: -1, authorized: False {}}

814− PollAuthorized {events, cursor: c} -> respond {events: events, cursor: c, authorized: True {}})

815

804

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

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

817− let to = normalizeHex to

818− let encryptedBlob = normalizeHex encryptedBlob

819 t <- now

806 t <- now

820 msgId <- genToken

807 msgId <- genToken

821 let clampedTs = clampTimestamp timestamp t

808 let clampedTs = clampTimestamp timestamp t

822 result <- atomic do

809 result <- atomic do

823 pr <- maybePrune t

810 pr <- maybePrune t

824− sessions <- *sessions

825− let auth = authenticateRequest sessions authorization t

811+ auth <- authenticateRequest authorization t

826 case auth of

812 case auth of

827 Unauthorized {} ->

813 Unauthorized {} ->

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

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

@@ -875,11 +861,10 @@ serve = \req -> case req of

875 let dedupedIds = dedupMessageIds messageIds

861 let dedupedIds = dedupMessageIds messageIds

876 result <- atomic do

862 result <- atomic do

877 pr <- maybePrune t

863 pr <- maybePrune t

878− sessions <- *sessions

879− let auth = authenticateRequest sessions authorization t

864+ auth <- authenticateRequest authorization t

880 case auth of

865 case auth of

881 Unauthorized {} ->

866 Unauthorized {} ->

882− yield {pr: pr, ack: AckUnauthorized {}}

867+ yield {pr: pr, ok: False {}, pendingAcks: [], evictedEntries: []}

883 Authorized {pubkey} -> do

868 Authorized {pubkey} -> do

884 messages <- *messages

869 messages <- *messages

885 let ackedMessages = do

870 let ackedMessages = do

@@ -896,27 +881,20 @@ serve = \req -> case req of

896 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in

881 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in

897 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)

882 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)

898 set *ackedIds = diff combinedAckedIds evictedEntries

883 set *ackedIds = diff combinedAckedIds evictedEntries

899− yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}

884+ yield {pr: pr, ok: True {}, pendingAcks: ackedFederated, evictedEntries: evictedEntries}

900 fork (do

885 fork (do

901− case result.ack of

902− AckDone {pendingAcks, evictedEntries} ->

903− when federationEnabled (do

886+ when (result.ok && federationEnabled) (do

904− let originServers = collectPeerServers pendingAcks (\a -> a.originServer)

887+ let originServers = collectPeerServers result.pendingAcks (\a -> a.originServer)

905− sendAcksAndClean pendingAcks originServers

888+ sendAcksAndClean result.pendingAcks originServers

906− retryEvictedAcks evictedEntries pendingAcks)

889+ retryEvictedAcks result.evictedEntries result.pendingAcks)

907− _ -> yield {}

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

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

909− yield (case result.ack of

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

910− AckUnauthorized _ -> respond {ok: False {}}

911− AckDone _ -> respond {ok: True {}})

912

892

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

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

914− let pubkey = normalizeHex pubkey

915 t <- now

894 t <- now

916 result <- atomic do

895 result <- atomic do

917 pr <- maybePrune t

896 pr <- maybePrune t

918− sessions <- *sessions

919− let auth = authenticateRequest sessions authorization t

897+ auth <- authenticateRequest authorization t

920 case auth of

898 case auth of

921 Unauthorized {} ->

899 Unauthorized {} ->

922 yield {pr: pr, authorized: False {}, foundServer: ""}

900 yield {pr: pr, authorized: False {}, foundServer: ""}

@@ -933,9 +911,7 @@ serve = \req -> case req of

933 else acc) {server: "", best: 0} valid).server

911 else acc) {server: "", best: 0} valid).server

934 yield {pr: pr, authorized: True {}, foundServer: foundServer}

912 yield {pr: pr, authorized: True {}, foundServer: foundServer}

935 forkBroadcastOffline t result.pr

913 forkBroadcastOffline t result.pr

936− yield (if result.authorized

937− then respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: True {}}

914+ yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})

938− else respond {online: False {}, server: "", authorized: False {}})

939

915

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

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

941 t <- now

917 t <- now

@@ -1019,10 +995,6 @@ serve = \req -> case req of

1019 yield (respond {ok: True {}})

995 yield (respond {ok: True {}})

1020

996

1021 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do

997 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do

1022− let toKey = normalizeHex toKey

1023− let fromKey = normalizeHex fromKey

1024− let encryptedBlob = normalizeHex encryptedBlob

1025− let messageId = normalizeHex messageId

1026 let originServer = normalizeServerName originServer

998 let originServer = normalizeServerName originServer

1027 t <- now

999 t <- now

1028 let authorized = verifyFederationAuth authorization

1000 let authorized = verifyFederationAuth authorization