@@ -413,10 +413,59 @@ isNumericHost = \sn -> do
413413 let host = beforeColon sn
414414 host != "" && all (\c -> contains c "0123456789") (chars host)
415415
416+-- Decimal value of a single hex/ascii digit character.
417+digitValue : Text -> Int
418+digitValue = \c -> if c == "0" then 0 else if c == "1" then 1 else if c == "2" then 2 else if c == "3" then 3 else if c == "4" then 4 else if c == "5" then 5 else if c == "6" then 6 else if c == "7" then 7 else if c == "8" then 8 else 9
419+
420+-- Value of an all-digits string (e.g. "172" -> 172); -1 when empty or
421+-- non-numeric. `chars` is fine for the membership guard (set semantics don't
422+-- matter there); the actual parse walks the string in order via take/drop.
423+decimalValue : Text -> Int
424+decimalValue = \s -> if s == "" || not all (\c -> contains c "0123456789") (chars s)
425+then -1
426+else decimalValueGo 0 s
427+decimalValueGo : Int -> Text -> Int
428+decimalValueGo = \acc s -> if s == ""
429+then acc
430+else decimalValueGo (acc * 10 + digitValue (take 1 s)) (drop 1 s)
431+
432+-- Substring of `s` before / after its first ".". `afterDot` is empty when
433+-- there is no dot. Used to pull the first two octets of a dotted IPv4 literal.
434+beforeDot : Text -> Text
435+beforeDot = \s -> if s == "" || take 1 s == "."
436+then ""
437+else take 1 s ++ beforeDot (drop 1 s)
438+afterDot : Text -> Text
439+afterDot = \s -> if s == ""
440+then ""
441+else if take 1 s == "."
442+then drop 1 s
443+else afterDot (drop 1 s)
444+
445+-- True when `host` is composed solely of digits and dots, i.e. a bare IPv4
446+-- literal rather than a hostname. Gates the numeric range checks below so a
447+-- legitimately-named peer like "224.example.com" is not misread as multicast.
448+isDottedNumeric : Text -> Bool
449+isDottedNumeric = \host -> host != "" && contains "." host && all (\c -> contains c "0123456789.") (chars host)
450+
451+-- Reserved/non-routable IPv4 ranges the dotted-octet prefix list misses:
452+-- CGNAT 100.64/10, benchmarking 198.18/15, and multicast + reserved/broadcast
453+-- (224/4 and 240/4, i.e. any first octet >= 224). Applied only to bare IPv4
454+-- literals (`isDottedNumeric`) so hostnames are never caught. Shorthand forms
455+-- like "100.64" still match — only the first two octets are inspected.
456+isReservedIPv4 : Text -> Bool
457+isReservedIPv4 = \host -> do
458+ let o1 = decimalValue (beforeDot host)
459+ let o2 = decimalValue (beforeDot (afterDot host))
460+ isDottedNumeric host && (o1 >= 224 || (o1 == 100 && o2 >= 64 && o2 <= 127) || (o1 == 198 && (o2 == 18 || o2 == 19)))
461+
416462-- Block private/reserved/internal hostnames (SSRF defense). Skips percent-encoding
417463-- tricks but covers the high-value cases: `localhost`, RFC1918 ranges (10/8,
418464-- 172.16/12, 192.168/16) plus link-local
419−-- 169.254/16, the IPv4 zero net, bare IPv6 literals (any string with more than one `:` — covers loopback
465+-- 169.254/16, the IPv4 zero net, CGNAT 100.64/10, benchmarking 198.18/15,
466+-- the TEST-NET ranges 192.0.2/24 and 203.0.113/24, and multicast/reserved
467+-- 224/4+240/4 (any first octet >= 224, via `isReservedIPv4`), bare IPv6
468+-- literals (any string with more than one `:` — covers loopback
420469-- `::`/`::1`, link-local `fe80::/10`, ULA `fc00::/7`, globals like `2001:db8::1`),
421470-- bracketed IPv6 literals, integer/octal "dword" IPv4 (`isNumericHost`) and the
422471-- `0x`-prefixed hex form, and the `.local` / `.internal` / `.arpa` / `.onion`
@@ -428,7 +477,7 @@ isNumericHost = \sn -> do
428477-- A legitimate `host:port` server name has exactly one `:`, so the multi-colon
429478-- check leaves that case intact.
430479isBadServerName : Text -> Bool
431−isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:" sn || isNumericHost sn || hasPrefix "0x" sn || any (\c -> not contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") (chars sn) || countChar ":" sn > 1 || any (\p -> hasPrefix p sn) [
480+isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:" sn || isNumericHost sn || isReservedIPv4 (beforeColon sn) || hasPrefix "0x" sn || any (\c -> not contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") (chars sn) || countChar ":" sn > 1 || any (\p -> hasPrefix p sn) [
432481 ".",
433482 ":",
434483 "[",
@@ -436,6 +485,8 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:"
436485 "10.",
437486 "192.168.",
438487 "169.254.",
488+ "192.0.2.",
489+ "203.0.113.",
439490 "0.",
440491 "172.16.",
441492 "172.17.",
@@ -773,7 +824,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
773824-- don't time us out mid-session, then runs `doPoll` to collect events (or
774825-- block until a matching message arrives or the timeout elapses) and
775826-- assembles the response.
776−handlePoll : Int -> Text -> Text -> IO {r *sessions, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, network, clock} (Result HttpError {cursor: Timestamp, events: [PollEvent]})
827+handlePoll : Int -> Text -> Text -> IO {r *seqCounter, r *sessions, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, network, clock} (Result HttpError {cursor: Timestamp, events: [PollEvent]})
777828handlePoll = \cursor authorization clientIp -> do
778829 t <- now
779830 setup <- atomic (do
@@ -781,7 +832,15 @@ handlePoll = \cursor authorization clientIp -> do
781832 case auth of
782833 Nothing {} -> yield (Nothing {})
783834 Just {value: pubkey} -> do
784− let clampedCursor = max 0 (min t cursor)
835+ -- Clamp the client cursor to the highest assigned sequence
836+ -- (`*seqCounter`), not wall-clock `t`. Under sustained high throughput
837+ -- `receivedAt` (= `seqTs`) can run ahead of `t`; clamping to `t` would
838+ -- drag a legitimately-returned cursor backward and re-deliver the
839+ -- in-between messages. `max t curSeq` keeps the old behaviour when the
840+ -- counter is idle/behind, while still refusing to ack beyond what's
841+ -- been issued.
842+ curSeq <- *seqCounter
843+ let clampedCursor = max 0 (min (max t curSeq) cursor)
785844 when (clampedCursor > 0) (ackPolledMessages pubkey clampedCursor)
786845 pres <- *presence
787846 let stale = not any (\p -> p.pubkey == pubkey && isLocalServer p.server && p.expiresAt - t >= sessionExpiry / 2) pres
@@ -880,7 +939,14 @@ handleSendMessages = \messages authorization clientIp -> do
880939 remoteServers: collectPeers (filter (\p -> p.pubkey == m.to && p.expiresAt > t) pres) (\p -> p.server)
881940 }) messages
882941 forEach staged (\c -> do
883− appendMessage c.to c.encryptedBlob t
942+ -- Dedupe like the federation ingress path (`handleForwardMessage`):
943+ -- a client retry after a lost response carries the identical
944+ -- ciphertext, and `appendMessage`'s fresh `seqTs` would otherwise
945+ -- make `union` keep both rows and double-deliver. Re-reading
946+ -- `*messages` each iteration also collapses duplicate blobs that
947+ -- appear twice within one batch.
948+ existingMsgs <- *messages
949+ when (not any (\m -> m.toKey == c.to && m.encryptedBlob == c.encryptedBlob) existingMsgs) (appendMessage c.to c.encryptedBlob t)
884950 -- Stage outbox rows for peers under their `maxForwardsPerServer`
885951 -- ceiling. Peers at the cap still get the immediate post-commit
886952 -- delivery attempt (`forkForwardsTo`) — only the retry-queue row