447fba9 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Simplify server.knot: drop redundant checks, streamline error paths, remove unused helper

447fba9iko5 months ago

server.knot+16−22

compare with master

unifiedsplit

@@ -155,7 +155,7 @@ impl ToJSON MessageStatus where

155 MsDraining {} -> "draining")

156

157isValidBoundedHex : Int -> Text -> Bool

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

158+isValidBoundedHex = \maxLen s -> not (tooLong s maxLen) && isValidHex s

159type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen

160type BlobHex = Text where isValidBoundedHex maxBlobLen

161type SignatureHex = Text where isValidBoundedHex maxSignatureLen

@@ -565,9 +565,6 @@ isValidHex = \s ->

565 let cs = chars s in

566 count cs > 0 && mod (count cs) 2 == 0 && all cs (\c -> contains c "0123456789abcdef")

567

568−normalizeHex : Text -> Text

569−normalizeHex = \s -> bytesToHex (bytesFromHex s)

570−

571stripTrailingDot : Text -> Text

568stripTrailingDot : Text -> Text

572stripTrailingDot = \s -> if containsSuffix "." s then stripTrailingDot (take (count (chars s) - 1) s) else s

569stripTrailingDot = \s -> if containsSuffix "." s then stripTrailingDot (take (count (chars s) - 1) s) else s

573

570

@@ -606,9 +603,7 @@ matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp

606

603

607extractToken = \authHeader ->

604extractToken = \authHeader ->

608 let rest = drop 7 authHeader in

605 let rest = drop 7 authHeader in

609− if hasPrefix "Bearer " authHeader && rest != "" && not (tooLong rest maxTokenLen)

606+ if hasPrefix "Bearer " authHeader && rest != "" then Just {value: rest} else Nothing {}

610− then Just {value: rest}

611− else Nothing {}

612

607

613verifyMaintenanceAuth : Text -> IO Bool

608verifyMaintenanceAuth : Text -> IO Bool

614verifyMaintenanceAuth = \authorization -> do

609verifyMaintenanceAuth = \authorization -> do

@@ -688,17 +683,17 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do

688withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do

683withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do

689 blocked <- *blockedPeers

684 blocked <- *blockedPeers

690 allowed <- *allowedPeers

685 allowed <- *allowedPeers

691− let err = \e retry -> respond {ok: False {}, error: e, retryAfterMs: retry}

686+ let err = \e -> yield (respond {ok: False {}, error: e, retryAfterMs: 0})

692− if elem blocked fromServer then yield (err "blocked" 0)

687+ if elem blocked fromServer then err "blocked"

693− else if count allowed > 0 && not (elem allowed fromServer) then yield (err "not_allowed" 0)

688+ else if count allowed > 0 && not (elem allowed fromServer) then err "not_allowed"

694− else if not precondition then yield (err "invalid_request" 0)

689+ else if not precondition then err "invalid_request"

695− else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then yield (err "clock_skew" 0)

690+ else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then err "clock_skew"

696 else do

691 else do

697 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp

692 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp

698− if not verified then yield (err "unauthorized" 0)

693+ if not verified then err "unauthorized"

699 else do

694 else do

700 limited <- checkServerRateGate fromServer t

695 limited <- checkServerRateGate fromServer t

701− if limited then yield (err "rate_limited" federationRateWindowMs)

696+ if limited then yield (respond {ok: False {}, error: "rate_limited", retryAfterMs: federationRateWindowMs})

702 else action

697 else action

703

698

704-- ============================================

699-- ============================================

@@ -775,10 +770,10 @@ recordFailure = \server -> do

775 atomic do

770 atomic do

776 failures <- *forwardFailures

771 failures <- *forwardFailures

777 let prev = case findFirst failures (\f -> f.server == server) of

772 let prev = case findFirst failures (\f -> f.server == server) of

778− Just {value: f} -> {count: f.failures, firstFailedAt: f.firstFailedAt}

773+ Just {value: f} -> {count: f.failures + 1, firstFailedAt: f.firstFailedAt}

779− _ -> {count: 0, firstFailedAt: t}

774+ _ -> {count: 1, firstFailedAt: t}

780 set *forwardFailures = union (removeWhere failures (\f -> f.server == server))

775 set *forwardFailures = union (removeWhere failures (\f -> f.server == server))

781− [{server: server, failedAt: t, failures: min (prev.count + 1) 10, firstFailedAt: prev.firstFailedAt}]

776+ [{server: server, failedAt: t, failures: prev.count, firstFailedAt: prev.firstFailedAt}]

782

777

783clearFailure = \server -> atomic (pruneRef forwardFailures (\f -> f.server != server))

778clearFailure = \server -> atomic (pruneRef forwardFailures (\f -> f.server != server))

784

779

@@ -887,12 +882,11 @@ applyCancel = \msgs matches to mid t -> do

887

882

888-- Cancel one message if `ownerPred` holds for it; returns whether a cancel happened.

883-- Cancel one message if `ownerPred` holds for it; returns whether a cancel happened.

889cancelOne = \mid to ownerPred t -> atomic do

884cancelOne = \mid to ownerPred t -> atomic do

890− let matches = \x -> x.messageId == mid && x.toKey == to

891 msgs <- *messages

885 msgs <- *messages

886+ let matches = \x -> x.messageId == mid && x.toKey == to

892− if any msgs (\m -> matches m && ownerPred m) then do

887+ let owns = any msgs (\m -> matches m && ownerPred m)

893− _ <- applyCancel msgs matches to mid t

888+ when owns (do _ <- applyCancel msgs matches to mid t; yield {})

894− yield True

895− else yield False

889+ yield owns

896

890

897sendBatchedGossip = \peers events hops -> forEach peers id (\server -> do

891sendBatchedGossip = \peers events hops -> forEach peers id (\server -> do

898 t <- now

892 t <- now