53111fd · skrepka · git.iko.soy

git.iko.soy/skrepka

Simplify code and improve type safety: introduce ForwardInfo type, optimize any helper, remove no-ops, merge conditions

53111fdiko6 months ago

server.knot+14−18

compare with master

unifiedsplit

@@ -68,6 +68,7 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T

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

69type AuthResult = {authorized: Bool, pubkey: Text}

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

71+type ForwardInfo = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, toServer: ServerName}

72-- ============================================

73-- ============================================

73-- Persisted State

74-- Persisted State

@@ -140,7 +141,7 @@ route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi

140-- Helpers

141-- Helpers

141-- ============================================

142-- ============================================

142

143

143−any = \xs pred -> count (do x <- xs; where pred x; yield x) > 0

144+any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs

144none = \xs pred -> not (any xs pred)

145none = \xs pred -> not (any xs pred)

145headOf = \items -> fold (\acc x -> case acc of

146headOf = \items -> fold (\acc x -> case acc of

146 Nothing {} -> Just {value: x}

147 Nothing {} -> Just {value: x}

@@ -374,7 +375,7 @@ extractToken = \authHeader ->

374 else ""

375 else ""

375

376

376verifySecret = \token secret ->

377verifySecret = \token secret ->

377− safeCompare token (if secret == "" then "x" else secret) && not (secret == "")

378+ not (secret == "") && safeCompare token secret

378

379

379verifyFederationAuth = \authorization ->

380verifyFederationAuth = \authorization ->

380 verifySecret (extractToken authorization) federationSecret

381 verifySecret (extractToken authorization) federationSecret

@@ -609,7 +610,7 @@ removeForward = \mid srv -> atomic do

609 where not (x.messageId == mid && x.toServer == srv)

610 where not (x.messageId == mid && x.toServer == srv)

610 yield x

611 yield x

611

612

612−retryForwardsForServer : [{encryptedBlob: BlobHex, fromKey: PubkeyHex, messageId: MessageIdHex, timestamp: Timestamp, toKey: PubkeyHex, toServer: ServerName}] -> Int -> IO {network} {}

613+retryForwardsForServer : [ForwardInfo] -> Int -> IO {network} {}

613retryForwardsForServer = \entries remaining ->

614retryForwardsForServer = \entries remaining ->

614 if remaining <= 0

615 if remaining <= 0

615 then yield {}

616 then yield {}

@@ -628,7 +629,7 @@ retryForwardsForServer = \entries remaining ->

628 Err _ -> yield {}

629 Err _ -> yield {}

629 retryForwardsForServer rest (remaining - 1)

630 retryForwardsForServer rest (remaining - 1)

630

631

631−retryPendingForwards : [{encryptedBlob: BlobHex, fromKey: PubkeyHex, messageId: MessageIdHex, timestamp: Timestamp, toKey: PubkeyHex, toServer: ServerName}] -> IO {network} {}

632+retryPendingForwards : [ForwardInfo] -> IO {network} {}

632retryPendingForwards = \pending -> do

633retryPendingForwards = \pending -> do

633 let servers = collectPeerServers pending (\x -> x.toServer)

634 let servers = collectPeerServers pending (\x -> x.toServer)

634 sendToEach servers (\server ->

635 sendToEach servers (\server ->

@@ -975,13 +976,11 @@ serve = \req -> case req of

975 where p.pubkey == pubkey

976 where p.pubkey == pubkey

976 where p.expiresAt > t

977 where p.expiresAt > t

977 yield p

978 yield p

978− let foundServer = if not authorized

979+ let foundServer = if not authorized || count valid == 0

979 then ""

980 then ""

980− else if count valid == 0

981− then ""

982− else if any valid (\p -> p.server == serverHostN)

981+ else if any valid (\p -> p.server == serverHostN)

983− then serverHostN

982+ then serverHostN

984− else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

983+ else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

985 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

984 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

986 forkBroadcastOffline t result

985 forkBroadcastOffline t result

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

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

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

1108 let originServer = normalizeServerName originServer

1107 let originServer = normalizeServerName originServer

1109 t <- now

1108 t <- now

1110 let authorized = verifyFederationAuth authorization

1109 let authorized = verifyFederationAuth authorization

1111− let validOrigin = not (originServer == serverHostN)

1110+ let validOrigin = isFederatedOrigin originServer

1112 let clampedTs = clampTimestamp timestamp t

1111 let clampedTs = clampTimestamp timestamp t

1113 result <- atomic do

1112 result <- atomic do

1114 pr <- maybePrune t

1113 pr <- maybePrune t

@@ -1127,9 +1126,9 @@ serve = \req -> case req of

1127 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

1126 [{messageId: messageId, toKey: toKey, fromKey: fromKey,

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

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

1129 else messages

1128 else messages

1130− yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, inserted: shouldInsert, alreadyExists: exists}

1129+ yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, ok: shouldInsert || exists}

1131 forkBroadcastOffline t result

1130 forkBroadcastOffline t result

1132− yield (respond {ok: result.inserted || result.alreadyExists})

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

1133

1132

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

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

1135 let fromServer = normalizeServerName fromServer

1134 let fromServer = normalizeServerName fromServer

@@ -1157,11 +1156,8 @@ serve = \req -> case req of

1157 Prune {authorization, respond} -> do

1156 Prune {authorization, respond} -> do

1158 t <- now

1157 t <- now

1159 let authorized = verifyMaintenanceAuth authorization

1158 let authorized = verifyMaintenanceAuth authorization

1160− if authorized

1161− then do

1162− fork (pruneAndRetry t)

1159+ if authorized then fork (pruneAndRetry t) else yield {}

1163− yield (respond {ok: True {}})

1160+ yield (respond {ok: authorized})

1164− else yield (respond {ok: False {}})

1165

1161

1166-- ============================================

1162-- ============================================

1167-- Entry Point

1163-- Entry Point