e3c6a4a · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Remove error field from JSON responses; use HTTP status codes instead

e3c6a4aiko5 months ago

client/ApiClient.fs+13−8

compare with master

unifiedsplit

@@ -49,14 +49,19 @@ module ApiClient =

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

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

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

52+ if response.IsSuccessStatusCode then

53+ return JsonDocument.Parse(text)

54+ else

55+ if response.StatusCode = System.Net.HttpStatusCode.Unauthorized then

56+ return raise Unauthorized

57+ let code =

58+ try

52− let doc = JsonDocument.Parse(text)

59+ use d = JsonDocument.Parse(text)

53− match doc.RootElement.TryGetProperty("error") with

60+ match d.RootElement.TryGetProperty("error") with

54− | true, err when not (String.IsNullOrEmpty(err.GetString())) ->

61+ | true, e -> e.GetString()

55− let code = err.GetString()

62+ | _ -> string (int response.StatusCode)

56− doc.Dispose()

63+ with _ -> string (int response.StatusCode)

57− if code = "unauthorized" then return raise Unauthorized

58− else return raise (ApiError $"{url}: {code}")

64+ return raise (ApiError $"{url}: {code}")

59− | _ -> return doc

60 }

65 }

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

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

server.knot+79−72

@@ -198,9 +198,9 @@ type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex}

198

199-- /messages signals failure via the per-entry `error` field on each result:

200-- empty = success (delivered, federated, or queued),

201−-- non-empty = "rate_limited" | "self_send". A non-empty top-level `error`

201+-- non-empty = "rate_limited" | "self_send". Top-level rejections (auth,

202−-- ("rate_limited" | "unauthorized") means the request was rejected before

202+-- global rate limit) come back as a non-2xx HTTP status with an empty

203−-- any entry was processed and `results` is empty.

203+-- response body.

204-- The sender's UI treats every success the same and learns "they got it"

205-- only via the recipient's E2E ack.

206

@@ -316,21 +316,22 @@ type RateEntry = {key: Text, windowStart: Timestamp, count: Int}

316-- ClientApi -- /poll, /messages (send)

317-- FederationApi -- inter-server gossip, forward (single + batch)

318-- ReadyApi -- observability

319−-- Response field shapes are kept stable for backwards compatibility even when

319+-- Handlers return `Result HttpError T`: `Ok` produces a 200 with the

320−-- the underlying value is no longer computed (zero-filled).

320+-- declared body shape, `Err` produces a non-2xx response whose body is

321+-- `{"error": "<code>"}`.

321

322

322route AuthApi where

323route AuthApi where

323− POST {pubkey: PubkeyHex} /auth/challenge headers {clientIp: Text} -> {challenge: Text, ok: Bool, expiresAt: Timestamp, retryAfterMs: Int, error: Text} = ReqChallenge

324+ POST {pubkey: PubkeyHex} /auth/challenge headers {clientIp: Text} -> {challenge: Text, expiresAt: Timestamp} = ReqChallenge

324− POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex, revokeOthers: Bool} /auth/verify headers {clientIp: Text} -> {token: Text, expiresAt: Timestamp, error: Text} = VerifyAuth

325+ POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex, revokeOthers: Bool} /auth/verify headers {clientIp: Text} -> {token: Text, expiresAt: Timestamp} = VerifyAuth

325

326

326route ClientApi where

327route ClientApi where

327 POST {cursor: Timestamp, generation: Int} /poll headers {authorization: Text, clientIp: Text} -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, generation: Int, heartbeat: Bool, retryAfterMs: Int, cursorReset: Bool, hasMore: Bool, cursorStale: Bool, loadPct: Int} = Poll

328 POST {cursor: Timestamp, generation: Int} /poll headers {authorization: Text, clientIp: Text} -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, generation: Int, heartbeat: Bool, retryAfterMs: Int, cursorReset: Bool, hasMore: Bool, cursorStale: Bool, loadPct: Int} = Poll

328− POST {messages: [{to: PubkeyHex, encryptedBlob: BlobHex}]} /messages headers {authorization: Text, clientIp: Text} -> {results: [{error: Text}], error: Text, retryAfterMs: Int} = SendMessages

329+ POST {messages: [{to: PubkeyHex, encryptedBlob: BlobHex}]} /messages headers {authorization: Text, clientIp: Text} -> {results: [{error: Text}]} = SendMessages

329

330

330route FederationApi where

331route FederationApi where

331− POST {events: [GossipEvent], fromServer: ServerName} /federation/gossip -> {ok: Bool, error: Text, retryAfterMs: Int} = RecvGossip

332+ POST {events: [GossipEvent], fromServer: ServerName} /federation/gossip -> {} = RecvGossip

332− POST {toKey: PubkeyHex, encryptedBlob: BlobHex, fromServer: ServerName} /federation/forward -> {ok: Bool, error: Text, retryAfterMs: Int} = ForwardMessage

333+ POST {toKey: PubkeyHex, encryptedBlob: BlobHex, fromServer: ServerName} /federation/forward -> {} = ForwardMessage

333− POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex}], fromServer: ServerName} /federation/forward-batch -> {ok: Bool, error: Text, results: [{ok: Bool}], retryAfterMs: Int} = FederationBatchForward

334+ POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex}], fromServer: ServerName} /federation/forward-batch -> {results: [{ok: Bool}]} = FederationBatchForward

334

335

335route ReadyApi where

336route ReadyApi where

336 GET /ready -> {ready: Bool} = Ready

337 GET /ready -> {ready: Bool} = Ready

@@ -524,13 +525,15 @@ extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""

524then Just {value: drop 7 h}

525then Just {value: drop 7 h}

525else Nothing {}

526else Nothing {}

526

527

527−-- Common gate for handlers: global rate, session auth.

528+-- Common gate for handlers: global rate, session auth. Short-circuits with

528−-- mkErr is called with one of: "rate_limited", "unauthorized".

529+-- an `Err` response on failure; the `onAuth` callback returns its own

530+-- `Result HttpError T` for the success path.

529−gateAuth : Text -> Text -> Timestamp -> (Text -> resp) -> (PubkeyHex -> IO {} resp) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} resp

531+gateAuth : Text -> Text -> Timestamp -> (PubkeyHex -> IO {} (Result HttpError t)) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} (Result HttpError t)

530−gateAuth = \auth ip t mkErr onAuth -> do

532+gateAuth = \auth ip t onAuth -> do

531 g <- checkGlobalRate t

533 g <- checkGlobalRate t

532− let err = \e -> yield (mkErr e)

534+ if g

535+ then yield (Err {error: {status: 429, message: "rate_limited"}})

533− if g then err "rate_limited" else withSessionAuth auth t ip (err "unauthorized") onAuth

536+ else withSessionAuth auth t ip (yield (Err {error: {status: 401, message: "unauthorized"}})) onAuth

534

537

535-- Resolve a Bearer token to its session pubkey if the session is unexpired and

538-- Resolve a Bearer token to its session pubkey if the session is unexpired and

536-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.

539-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.

@@ -765,9 +768,9 @@ retryPendingForwards = do

765 Err _ -> do

768 Err _ -> do

766 recordFailure server

769 recordFailure server

767 yield (False {})

770 yield (False {})

768− Ok {value: r} -> do

771+ Ok _ -> do

769− when r.ok (clearFailure server)

772+ clearFailure server

770− yield r.ok

773+ yield (True {})

771 let isMatch = \x -> x.encryptedBlob == f.encryptedBlob && x.toServer == server

774 let isMatch = \x -> x.encryptedBlob == f.encryptedBlob && x.toServer == server

772 let isDone = \x -> isMatch x && (success || x.retries + 1 >= maxForwardRetries)

775 let isDone = \x -> isMatch x && (success || x.retries + 1 >= maxForwardRetries)

773 atomic (do

776 atomic (do

@@ -844,50 +847,48 @@ refreshLocalPresence = \t -> do

844-- POST /auth/challenge: issue a fresh signed-nonce challenge for `pubkey`.

847-- POST /auth/challenge: issue a fresh signed-nonce challenge for `pubkey`.

845-- Capped per-key (maxChallengesPerKey) and rate-limited; the IP is recorded

848-- Capped per-key (maxChallengesPerKey) and rate-limited; the IP is recorded

846-- so /auth/verify can require the same client.

849-- so /auth/verify can require the same client.

847−handleChallenge : PubkeyHex -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challengeRates, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, clock, random} {challenge: Text, error: Text, expiresAt: Int, ok: Bool, retryAfterMs: Int}

850+handleChallenge : PubkeyHex -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challengeRates, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, clock, random} (Result HttpError {challenge: Text, expiresAt: Int})

848handleChallenge = \pubkey clientIp -> do

851handleChallenge = \pubkey clientIp -> do

849 t <- now

852 t <- now

850 preErr <- if requireClientIp && clientIp == ""

853 preErr <- if requireClientIp && clientIp == ""

851 then yield "client_ip_required"

854 then yield "client_ip_required"

852 else authPreCheck clientIp t

855 else authPreCheck clientIp t

853 if preErr != ""

856 if preErr != ""

854− then yield {challenge: "", ok: False {}, expiresAt: 0, retryAfterMs: 0, error: preErr}

857+ then yield (Err {

858+ error: {status: if preErr == "client_ip_required" then 400 else 429, message: preErr}

859+ })

855 else do

860 else do

856 challenge <- genToken

861 challenge <- genToken

857 result <- atomic (do

862 result <- atomic (do

858 ch <- *challenges

863 ch <- *challenges

859 let cappedActive = capPerKey (filter ch (\c -> c.expiresAt > t)) (\c -> c.pubkey == pubkey) maxChallengesPerKey (\c -> c.expiresAt)

864 let cappedActive = capPerKey (filter ch (\c -> c.expiresAt > t)) (\c -> c.pubkey == pubkey) maxChallengesPerKey (\c -> c.expiresAt)

860 if count cappedActive >= maxChallenges

865 if count cappedActive >= maxChallenges

861− then yield {ok: False {}, error: "capacity"}

866+ then yield "capacity"

862 else do

867 else do

863 chRates <- *challengeRates

868 chRates <- *challengeRates

864 let chR = checkRate chRates pubkey maxChallengeRatePerKey challengeRateWindowMs t

869 let chR = checkRate chRates pubkey maxChallengeRatePerKey challengeRateWindowMs t

865 *challengeRates = chR.entries

870 *challengeRates = chR.entries

866 if chR.limited

871 if chR.limited

867− then yield {ok: False {}, error: "rate_limited"}

872+ then yield "rate_limited"

868 else do

873 else do

869 *challenges = union cappedActive [

874 *challenges = union cappedActive [

870 {pubkey, challenge, expiresAt: t + challengeExpiry, ip: clientIp}

875 {pubkey, challenge, expiresAt: t + challengeExpiry, ip: clientIp}

871 ]

876 ]

872− yield {ok: True {}, error: ""})

877+ yield "")

873− yield {

878+ if result == ""

874− challenge: if result.ok then challenge else "",

875− result.ok,

876− expiresAt: if result.ok then t + challengeExpiry else 0,

879+ then yield (Ok {value: {challenge, expiresAt: t + challengeExpiry}})

877− retryAfterMs: 0,

880+ else yield (Err {error: {status: if result == "capacity" then 503 else 429, message: result}})

878− result.error

879− }

880

881

881-- POST /auth/verify: validate `signature` over `challenge` for `pubkey`.

882-- POST /auth/verify: validate `signature` over `challenge` for `pubkey`.

882-- On success, mints a session token, records local presence (`pubkey` is now

883-- On success, mints a session token, records local presence (`pubkey` is now

883-- live on this server), and gossips an `online` event to known peers. If

884-- live on this server), and gossips an `online` event to known peers. If

884-- `revokeOthers` is set, all other sessions for the same pubkey are dropped.

885-- `revokeOthers` is set, all other sessions for the same pubkey are dropped.

885−handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, rw *presence, rw *sessions, clock, random} {error: Text, expiresAt: Int, token: Text}

886+handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, rw *presence, rw *sessions, clock, random} (Result HttpError {expiresAt: Int, token: Text})

886handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do

887handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do

887 t <- now

888 t <- now

888 preErr <- authPreCheck clientIp t

889 preErr <- authPreCheck clientIp t

889 if preErr != ""

890 if preErr != ""

890− then yield {token: "", expiresAt: 0, error: preErr}

891+ then yield (Err {error: {status: 429, message: preErr}})

891 else do

892 else do

892 let expiry = t + sessionExpiry

893 let expiry = t + sessionExpiry

893 token <- genToken

894 token <- genToken

@@ -917,12 +918,12 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do

917 *presence = newPres

918 *presence = newPres

918 yield {valid: True {}, peers: knownPeerServersFromPresence newPres})

919 yield {valid: True {}, peers: knownPeerServersFromPresence newPres})

919 if not result.valid

920 if not result.valid

920− then yield {token: "", expiresAt: 0, error: "invalid"}

921+ then yield (Err {error: {status: 401, message: "invalid"}})

921 else do

922 else do

922 when federationEnabled (fork (sendBatchedGossip result.peers [

923 when federationEnabled (fork (sendBatchedGossip result.peers [

923 mkGossip (GossipOnline {}) pubkey

924 mkGossip (GossipOnline {}) pubkey

924 ]))

925 ]))

925− yield {token, expiresAt: expiry, error: ""}

926+ yield (Ok {value: {token, expiresAt: expiry}})

926

927

927-- ============================================

928-- ============================================

928-- Handler: poll

929-- Handler: poll

@@ -937,13 +938,15 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do

937-- POST /poll: top-level dispatch. Validates the global rate gate, detects a

938-- POST /poll: top-level dispatch. Validates the global rate gate, detects a

938-- generation mismatch (server restart) to force a cursor reset, then hands

939-- generation mismatch (server restart) to force a cursor reset, then hands

939-- off to `pollOnce` for the actual long-poll body.

940-- off to `pollOnce` for the actual long-poll body.

940−handlePoll : Int -> Int -> Text -> Text -> IO {r *pollWakeup, r *serverGeneration, r *sessions, rw *forwards, rw *globalRateCount, rw *globalRateWindowStart, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}

941+handlePoll : Int -> Int -> Text -> Text -> IO {r *pollWakeup, r *serverGeneration, r *sessions, rw *forwards, rw *globalRateCount, rw *globalRateWindowStart, rw *messages, clock} (Result HttpError {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int})

941handlePoll = \cursor generation authorization clientIp -> do

942handlePoll = \cursor generation authorization clientIp -> do

942 t <- now

943 t <- now

943 serverGen <- *serverGeneration

944 serverGen <- *serverGeneration

944 g <- checkGlobalRate t

945 g <- checkGlobalRate t

945 let cursorWasReset = generation != serverGen && cursor > 0

946 let cursorWasReset = generation != serverGen && cursor > 0

947+ let er = \auth rate retryRate -> yield (Ok {

946− let er = \auth rate retryRate -> yield (emptyPollResp 0 auth rate serverGen retryRate cursorWasReset)

948+ value: emptyPollResp 0 auth rate serverGen retryRate cursorWasReset

949+ })

947 if g

950 if g

948 then er (False {}) (True {}) globalRateWindowMs

951 then er (False {}) (True {}) globalRateWindowMs

949 else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset clientIp serverGen t

952 else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset clientIp serverGen t

@@ -951,7 +954,7 @@ handlePoll = \cursor generation authorization clientIp -> do

951-- Body of a single poll. Treats the cursor advance as an implicit ack

954-- Body of a single poll. Treats the cursor advance as an implicit ack

952-- (`ackPolledMessages`), then runs `doPoll` to collect events (or block

955-- (`ackPolledMessages`), then runs `doPoll` to collect events (or block

953-- until wakeup) and assembles the response.

956-- until wakeup) and assembles the response.

954−pollOnce : Text -> Int -> Bool -> Text -> Int -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *forwards, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}

957+pollOnce : Text -> Int -> Bool -> Text -> Int -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *forwards, rw *messages, clock} (Result HttpError {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int})

955pollOnce = \authorization cursor cursorWasReset clientIp serverGen t -> do

958pollOnce = \authorization cursor cursorWasReset clientIp serverGen t -> do

956 setup <- atomic withSessionAuth authorization t clientIp (yield (Nothing {})) (\pubkey -> do

959 setup <- atomic withSessionAuth authorization t clientIp (yield (Nothing {})) (\pubkey -> do

957 let clampedCursor = clamp 0 t cursor

960 let clampedCursor = clamp 0 t cursor

@@ -959,22 +962,26 @@ pollOnce = \authorization cursor cursorWasReset clientIp serverGen t -> do

959 startWakeup <- *pollWakeup

962 startWakeup <- *pollWakeup

960 yield (Just {value: {pubkey, clampedCursor, startWakeup}}))

963 yield (Just {value: {pubkey, clampedCursor, startWakeup}}))

961 case setup of

964 case setup of

965+ Nothing {} -> yield (Ok {

962− Nothing {} -> yield (emptyPollResp 0 (False {}) (False {}) serverGen 0 cursorWasReset)

966+ value: emptyPollResp 0 (False {}) (False {}) serverGen 0 cursorWasReset

967+ })

963 Just {value: s} -> do

968 Just {value: s} -> do

964 pollResult <- doPoll s t

969 pollResult <- doPoll s t

965− yield {

970+ yield (Ok {

971+ value: {

966− pollResult.events,

972+ pollResult.events,

967− pollResult.cursor,

973+ pollResult.cursor,

968− authorized: True {},

974+ authorized: True {},

969− rateLimited: False {},

975+ rateLimited: False {},

970− generation: serverGen,

976+ generation: serverGen,

971− heartbeat: count pollResult.events == 0,

977+ heartbeat: count pollResult.events == 0,

972− retryAfterMs: 0,

978+ retryAfterMs: 0,

973− cursorReset: cursorWasReset,

979+ cursorReset: cursorWasReset,

974− pollResult.hasMore,

980+ pollResult.hasMore,

975− cursorStale: False {},

981+ cursorStale: False {},

976− loadPct: 0

982+ loadPct: 0

983+ }

977− }

984+ })

978

985

979-- One pass: collect events at `t`. If empty, retry-wait on `pollWakeup`

986-- One pass: collect events at `t`. If empty, retry-wait on `pollWakeup`

980-- (bumped by send/heartbeat) and re-collect once at the new wall time.

987-- (bumped by send/heartbeat) and re-collect once at the new wall time.

@@ -1029,19 +1036,17 @@ ackPolledMessages = \pubkey cursor -> do

1029

1036

1030-- POST /messages: send a list of ciphertexts. Each entry runs through

1037-- POST /messages: send a list of ciphertexts. Each entry runs through

1031-- `sendMessageCore` separately so per-entry rate limits/errors don't abort

1038-- `sendMessageCore` separately so per-entry rate limits/errors don't abort

1032−-- the rest; federated forwards are forked per entry. Top-level `error`

1039+-- the rest; federated forwards are forked per entry. Top-level rejections

1033−-- carries global gate failures ("rate_limited" | "unauthorized") and

1040+-- (auth, global rate) come back as a non-2xx HTTP status via `gateAuth`.

1034−-- short-circuits with empty `results`.

1035−handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {error: Text, results: [{error: Text}], retryAfterMs: Int}

1041+handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} (Result HttpError {results: [{error: Text}]})

1036handleSendMessages = \messages authorization clientIp -> do

1042handleSendMessages = \messages authorization clientIp -> do

1037 t <- now

1043 t <- now

1038− let mkErr = \e -> {results: [], error: e, retryAfterMs: 0}

1039− gateAuth authorization clientIp t mkErr (\senderKey -> do

1044+ gateAuth authorization clientIp t (\senderKey -> do

1040 results <- mapEach (takeRelation maxBatchSize messages) (\m -> do

1045 results <- mapEach (takeRelation maxBatchSize messages) (\m -> do

1041 r <- atomic (do sendMessageCore senderKey m.to m.encryptedBlob t)

1046 r <- atomic (do sendMessageCore senderKey m.to m.encryptedBlob t)

1042 when federationEnabled (fork (forkForwardsTo m.to m.encryptedBlob r.remoteServers))

1047 when federationEnabled (fork (forkForwardsTo m.to m.encryptedBlob r.remoteServers))

1043 yield {r.error})

1048 yield {r.error})

1044− yield {results, error: "", retryAfterMs: 0})

1049+ yield (Ok {value: {results}}))

1045

1050

1046-- Atomic core of /messages. Charges send/pair/recv rate

1051-- Atomic core of /messages. Charges send/pair/recv rate

1047-- counters together (so any limit denies the message), enforces caps and

1052-- counters together (so any limit denies the message), enforces caps and

@@ -1114,7 +1119,7 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do

1114 })

1119 })

1115 case result of

1120 case result of

1116 Err _ -> recordFailure server

1121 Err _ -> recordFailure server

1117− Ok {value: r} -> when r.ok (do

1122+ Ok _ -> do

1118 clearFailure server

1123 clearFailure server

1119 atomic (do

1124 atomic (do

1120 fwds2 <- *forwards

1125 fwds2 <- *forwards

@@ -1125,7 +1130,7 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do

1125 let othersPending = any remaining (\x -> x.encryptedBlob == encryptedBlob)

1130 let othersPending = any remaining (\x -> x.encryptedBlob == encryptedBlob)

1126 when (not stillLocal && not othersPending) (do

1131 when (not stillLocal && not othersPending) (do

1127 msgs <- *messages

1132 msgs <- *messages

1128− *messages = filter msgs (\m -> m.encryptedBlob != encryptedBlob)))))

1133+ *messages = filter msgs (\m -> m.encryptedBlob != encryptedBlob))))

1129

1134

1130-- ============================================

1135-- ============================================

1131-- Handler: federation receive

1136-- Handler: federation receive

@@ -1140,11 +1145,11 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do

1140-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys

1145-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys

1141-- that transition offline → online, flushes any locally-buffered messages via

1146-- that transition offline → online, flushes any locally-buffered messages via

1142-- `forwardQueuedToServer`.

1147-- `forwardQueuedToServer`.

1143−handleRecvGossip : [{eventType: <GossipOffline {} | GossipOnline {} | a>, pubkey: PubkeyHex | b}] -> Text -> IO {rw *presence, clock} {error: Text, ok: Bool, retryAfterMs: Int}

1148+handleRecvGossip : [{eventType: <GossipOffline {} | GossipOnline {} | a>, pubkey: PubkeyHex | b}] -> Text -> IO {rw *presence, clock} (Result HttpError {})

1144handleRecvGossip = \events fromServer -> do

1149handleRecvGossip = \events fromServer -> do

1145 t <- now

1150 t <- now

1146 if not isRemote fromServer || isBadServerName fromServer || count events > maxGossipEvents

1151 if not isRemote fromServer || isBadServerName fromServer || count events > maxGossipEvents

1147− then yield {ok: False {}, error: "invalid_request", retryAfterMs: 0}

1152+ then yield (Err {error: {status: 400, message: "invalid_request"}})

1148 else do

1153 else do

1149 newlyOnline <- atomic (do

1154 newlyOnline <- atomic (do

1150 pres <- *presence

1155 pres <- *presence

@@ -1157,7 +1162,7 @@ handleRecvGossip = \events fromServer -> do

1157 *presence = union kept added

1162 *presence = union kept added

1158 yield (filter onlinePubkeys (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t))))

1163 yield (filter onlinePubkeys (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t))))

1159 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))

1164 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))

1160− yield {ok: True {}, error: "", retryAfterMs: 0}

1165+ yield (Ok {value: {}})

1161

1166

1162-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.

1167-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.

1163-- Returns "" on success, otherwise an error code:

1168-- Returns "" on success, otherwise an error code:

@@ -1195,24 +1200,26 @@ storeFederated = \toKey encryptedBlob checkRecvRate t -> do

1195-- POST /federation/forward: receive a single federated message destined for

1200-- POST /federation/forward: receive a single federated message destined for

1196-- a local key. Delegates the actual store decision to `storeFederated`,

1201-- a local key. Delegates the actual store decision to `storeFederated`,

1197-- which returns "" on success.

1202-- which returns "" on success.

1198−handleForwardMessage : PubkeyHex -> BlobHex -> Text -> IO {rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock} {error: Text, ok: Bool, retryAfterMs: Int}

1203+handleForwardMessage : PubkeyHex -> BlobHex -> Text -> IO {rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock} (Result HttpError {})

1199handleForwardMessage = \toKey encryptedBlob _ -> do

1204handleForwardMessage = \toKey encryptedBlob _ -> do

1200 t <- now

1205 t <- now

1201 result <- atomic storeFederated toKey encryptedBlob (True {}) t

1206 result <- atomic storeFederated toKey encryptedBlob (True {}) t

1202− yield {ok: result == "", error: result, retryAfterMs: 0}

1207+ if result == ""

1208+ then yield (Ok {value: {}})

1209+ else yield (Err {error: {status: if result == "no_presence" then 404 else 429, message: result}})

1203

1210

1204-- POST /federation/forward-batch: bulk variant of `handleForwardMessage`.

1211-- POST /federation/forward-batch: bulk variant of `handleForwardMessage`.

1205-- Skips per-entry recv-rate charging.

1212-- Skips per-entry recv-rate charging.

1206−handleFederationBatchForward : [{encryptedBlob: BlobHex, toKey: PubkeyHex | a}] -> Text -> IO {clock} {error: Text, ok: Bool, results: [{ok: Bool}], retryAfterMs: Int}

1213+handleFederationBatchForward : [{encryptedBlob: BlobHex, toKey: PubkeyHex | a}] -> Text -> IO {clock} (Result HttpError {results: [{ok: Bool}]})

1207handleFederationBatchForward = \forwards _ -> do

1214handleFederationBatchForward = \forwards _ -> do

1208 t <- now

1215 t <- now

1209 if count forwards > maxBatchSize

1216 if count forwards > maxBatchSize

1210− then yield {ok: False {}, error: "invalid_request", results: [], retryAfterMs: 0}

1217+ then yield (Err {error: {status: 400, message: "invalid_request"}})

1211 else do

1218 else do

1212 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do

1219 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do

1213 result <- atomic storeFederated e.toKey e.encryptedBlob (False {}) t

1220 result <- atomic storeFederated e.toKey e.encryptedBlob (False {}) t

1214 yield {ok: result == ""})

1221 yield {ok: result == ""})

1215− yield {ok: True {}, error: "", results, retryAfterMs: 0}

1222+ yield (Ok {value: {results}})

1216

1223

1217-- ============================================

1224-- ============================================

1218-- Readiness handlers

1225-- Readiness handlers

@@ -1220,11 +1227,11 @@ handleFederationBatchForward = \forwards _ -> do

1220

1227

1221-- GET /ready: signals readiness once the first background prune has run

1228-- GET /ready: signals readiness once the first background prune has run

1222-- (load-balancer / orchestrator probe).

1229-- (load-balancer / orchestrator probe).

1223−handleReady : IO {r *lastPrunedAt, r *startedAt} {ready: Bool}

1230+handleReady : IO {r *lastPrunedAt, r *startedAt} (Result HttpError {ready: Bool})

1224handleReady = do

1231handleReady = do

1225 sa <- *startedAt

1232 sa <- *startedAt

1226 lastPrune <- *lastPrunedAt

1233 lastPrune <- *lastPrunedAt

1227− yield {ready: lastPrune > 0 && lastPrune >= sa}

1234+ yield (Ok {value: {ready: lastPrune > 0 && lastPrune >= sa}})

1228

1235

1229-- ============================================

1236-- ============================================

1230-- Dispatch

1237-- Dispatch