From f229e6158596ac62d17126376e2f2bde3c752ac2 Mon Sep 17 00:00:00 2001 From: Alain Brenzikofer Date: Tue, 8 Sep 2026 17:51:10 +0200 Subject: [PATCH] trim diff --- protocol/simplex-messaging.md | 70 ++++++------ scripts/resolver/service/snrc-resolve.py | 30 +++--- src/Simplex/Messaging/Client.hs | 5 +- src/Simplex/Messaging/Protocol.hs | 86 ++++++--------- src/Simplex/Messaging/Server/Names.hs | 30 +++--- .../Messaging/Server/Names/HttpResolver.hs | 100 +++++++----------- src/Simplex/Messaging/SimplexName.hs | 12 +-- tests/RSLVTests.hs | 9 +- tests/SMPNamesTests.hs | 29 +++-- 9 files changed, 157 insertions(+), 214 deletions(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index 9835b5d77..f894f1047 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -1475,19 +1475,18 @@ domain = 1*253 OCTET ; the name as text explicit (e.g. `privacy.simplex`, `test.testing`, `example.com`), bounded to 253 bytes. -**Hashed labels.** `RSLV` does not carry a name. It carries a query, whose -second-level label is either the label itself or the keccak-256 of it, tagged so -that the two are told apart by the encoding rather than by their shape. Nothing -decides what a label is by counting characters or looking for punctuation. +**Hashed labels.** The query's second-level label is either the label itself or +the keccak-256 of it, tagged, so the two are told apart by the tag and never by +the shape of the value. Only the second-level label may be hashed: subname labels are needed as text to reach the record, and a web TLD has no registry to key on. `sub..simplex` reaches the node `sub.name.simplex` does. From v22 a client MUST send the hash. Older routers can only read the name, so a -client on an older session sends it, and gets what it always got. A router -answering a hashed query does not know the name's length, so it cannot check a -minimum-length policy either — the client does that, from the pricing it is sent. +client on an older session sends the name. A router answering a hashed query +does not know the label's length, so it cannot check a minimum-length policy +either: the client does that, from the pricing it is sent. The hash reaches the backing resolver as `[` + 64 lowercase hex + `]`, ENS's encoding for a label whose text is unknown, because that is what its HTTP API @@ -1525,9 +1524,9 @@ fact that this router cannot resolve, so iterating past it is safe. #### Name response -Resolving a name and asking whether it can be registered are one question to the -registry, and one lookup answers both: a client offering a taken name to -register wants to show what took it. `RNAME` carries what the registry holds. +Resolving a name and asking whether it can be registered are one lookup in the +registry, and `RNAME` answers both: a client offering to register a name that +turns out to be taken can show what took it. ```abnf rname = %s"RNAME" SP registration @@ -1560,25 +1559,25 @@ seconds since the Unix epoch. Lengths are characters. | `A` | available: held by nobody and registrable now, at `pricing` | | `R` | reserved: held back by the registry and not registered | -Availability is not a state of its own but the conjunction the registry itself -computes: registrable means `A`, since a name that is held back answers `R` instead. A reservation on a name that *is* registered rides along in -the `reserved` field, and is why that name will not free up when it expires. +`A` alone means registrable: a name the registry holds back answers `R` +instead, so a client has no flags to combine. A reservation on a name that *is* +registered is carried in the `reserved` field, and is why that name will not +free up when it expires. -An auction is not a state either. A name past its grace period answers `A` -with the ordinary price, plus the time its surcharge expires. The -surcharge itself is deliberately not carried: it decays continuously, so it -cannot be quoted as a purchase price. A client shows the ordinary price and -counts down to when it applies. +There is no separate answer for an auction. A name past its grace period answers +`A` with the ordinary price and the time its surcharge expires. The surcharge +itself is not carried: it decays continuously, so it cannot be quoted as a +purchase price. A client shows the ordinary price and counts down to when it +applies. -A router MUST NOT quote a price for a reserved name. A name the registry holds -back is not for sale at the registry's price, and quoting one would be an offer -the registry will not honour - which is why `R` has no pricing field at all -rather than an empty one. +A router MUST NOT quote a price for a reserved name: it is not for sale at the +registry's price, and quoting one would be an offer the registry will not +honour. That is why `R` has no pricing field. -The record travels while a name is registered, through its grace period, and -stops at the moment the name becomes registrable by anyone. Keeping it that far -lets whoever opens the name tell its owner that it is about to lapse; keeping it -past that would show a record whose owner no longer holds the name. How long a +The record is carried while a name is registered and through its grace period, +and stops once the name is registrable by anyone. Keeping it through grace lets +whoever opens the name tell its owner that it is about to lapse; keeping it +longer would show a record whose owner no longer holds the name. How long a client goes on opening an expiring name is its own decision. **Computing the price.** In US cents, for a duration in seconds: @@ -1599,12 +1598,12 @@ Below v22, `RNAME` carries the bare record and nothing else, and every answer without one is `ERR NAME NOT_FOUND`, as it was before this version. A name in its grace period therefore resolves for those clients too, without the expiry they have no field to carry. In the other direction a v22 client reads such an -answer as `N` with no expiry, grace or reservation - which is the only -reason those three fields are optional. +answer as `N` with no expiry, grace or reservation, which is the only reason +those three fields are optional. -From v22 a client MUST NOT read `ERR NAME NOT_FOUND` as "registrable" - only `A` -says that. `NOT_FOUND` means the router has nothing to say about the -name, which includes a backing resolver whose answer it could not read. +From v22 a client MUST NOT read `ERR NAME NOT_FOUND` as "registrable": only `A` +says that. `NOT_FOUND` means the router has nothing to say about the name, which +includes a backing resolver whose answer it could not read. A router that cannot state an answer completely MUST say so as `ERR NAME RESOLVER ` rather than answer partially. That covers a TLD with no @@ -1617,12 +1616,11 @@ name that may be held. A client MUST read a `reason` it does not know as unknown and still treat the name as reserved: a later version may reserve names for reasons this one cannot name, and losing the reservation over that would offer a name that cannot be -registered. The word itself travels, unchanged, so that a later client can act -on it and a current one can show or log it - which is why the set is open rather -than an enumeration. A router sends at most one bounded token of printable -ASCII, since the field ends at a space. +registered. The word itself travels unchanged, so a later client can act on it +and a current one can show or log it, which is why the set is open rather than +an enumeration. A router sends at most one token of printable ASCII, since the +field ends at a space. -`json-bytes` MUST be a UTF-8 JSON object with the following schema: `json-bytes` MUST be a UTF-8 JSON object with the following schema: | Field | JSON type | Constraints | diff --git a/scripts/resolver/service/snrc-resolve.py b/scripts/resolver/service/snrc-resolve.py index 23f54f837..f83f773da 100755 --- a/scripts/resolver/service/snrc-resolve.py +++ b/scripts/resolver/service/snrc-resolve.py @@ -106,9 +106,8 @@ CONTROLLERS = { } # `reservedNames` holds a SimplexController.Reason; 0 means not reserved. A -# controller from before the enum stores a bool, whose `true` decodes as 1. -# SimplexController.Reason. 1 is also what the boolean reservedNames of the -# first .testing deployment set, which is why it reads as "internal". +# controller from before the enum stores a bool, whose `true` decodes as 1, +# which is why 1 reads as "internal". RESERVED_REASONS = { 1: ("internal", "reserved for SimpleX"), 2: ("trademark", "reserved to protect a trademark"), @@ -240,7 +239,7 @@ def reservation_reason(tld: str, token: int) -> int: def pricing_params(tld: str): - """What it costs to register a name under this TLD, in MicroUSD, or None + """What it costs to register a name under this TLD, in US cents, or None when no controller or price oracle is configured.""" return cached(("pricing", tld), lambda: read_pricing_params(tld)) @@ -327,7 +326,7 @@ def name_status(name: str): status = expiry_status(expires, grace, now) # A reservation is orthogonal to the registration: a registered name can be - # held back too, and that is why it will not free up when it expires. + # held back too. code = reservation_reason(tld, token) reason = RESERVED_REASONS.get(code, UNKNOWN_REASON) if code else None @@ -375,18 +374,16 @@ def decode_bytes(hex_data: str) -> bytes: def registered_label(registrar: str, token: int) -> str: - """The registrar records the plaintext label at registration, keyed by its - own hash, so a hashed query still answers with the name it asked about. A - name registered without registerWithLabel has none, which is an error we - name rather than paper over.""" + """The plaintext label the registrar recorded at registration, keyed by the + hash of that label. A name registered without registerWithLabel has none, + and answers "unknown" instead.""" raw = decode_bytes(eth_call(registrar, selector("labelOf(uint256)") + encode_uint(token))) return raw.decode("utf-8", errors="replace") if raw else "unknown" def canonical_name(name: str) -> str: - """The name the registry holds. A hashed query never told anyone the name, - so the registrar's own record of it is what comes back; a plaintext query - already carries it.""" + """The name to answer with: a hashed query does not carry one, so the + registrar's record of the label fills it in.""" labels = name.split(".") registrar = REGISTRARS.get(labels[-1]) if not registrar or len(labels) < 2 or not is_encoded_labelhash(labels[-2]): @@ -688,8 +685,7 @@ def resolve(name: str): # Before the resolver lookup, so a lapsed name is not reported as noResolver. reg = name_status(name) if reg["status"] in ("unregistered", "expired"): - # A name in grace is not here: its record still resolves, so that whoever - # opens it can tell the owner it is about to lapse. + # A name in grace is not here: its record still resolves. body = { "name": name, **reg, @@ -705,9 +701,9 @@ def resolve(name: str): resolver_raw = eth_call(registry, selector("resolver(bytes32)") + node_hex) resolver_addr = decode_address(resolver_raw) if resolver_addr == ZERO_ADDR: - # A registered name always resolves. With no resolver set the record is - # still returned, every field unset, so that "taken until " stays - # answerable for the name a would-be registrant is asking about. + # A registered name always resolves: with no resolver set the record is + # still returned with every field unset, so "taken until " stays + # answerable. owner = decode_address(eth_call(registry, selector("owner(bytes32)") + node_hex)) return 200, { "name": canonical_name(name), diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index c5444f41f..12c67e725 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -1080,9 +1080,8 @@ directResolveName c nm name where v = thVersion (thParams c) --- | The record must name the name that was asked for. A hashed query does not --- tell the router which name it is, so the record's own name is the router's --- word until the client checks it here. +-- | The record must name the name that was asked for: a hashed query does not +-- tell the router which name it is, so the router is not trusted for it. resolvedName :: SimplexDomain -> NameRegistration -> Bool resolvedName d = \case NRRegistered {nameRecord} -> T.toLower (nrName nameRecord) == fullDomainName d diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 467527e2a..3899d6b9c 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -88,7 +88,6 @@ module Simplex.Messaging.Protocol NamePricing (..), USDCents (..), NameReservedReason (..), - parseReservedReason, oldRegistration, NameErrorType (..), BrokerErrorType (..), @@ -1602,12 +1601,12 @@ data ErrorType DUPLICATE_ -- not part of SMP protocol, used internally deriving (Eq, Show) --- | What RSLV asks about. Distinct from SimplexDomain, which stays a name a --- person can type and a UI can show: only this may name a label by its hash. +-- | What RSLV asks about. Unlike SimplexDomain, which is always text, this may +-- name a label by its hash. data NameQuery = NameQuery { queryTLD :: SimplexTLD, - -- | only the second-level label may be hashed - subnames are needed as text - -- to reach the record, so they are not part of this choice + -- | only the second-level label may be hashed: subname labels are needed as + -- text to reach the record queryLabel :: NameQueryLabel, -- | parent to child, as in SimplexDomain querySub :: [Text] @@ -1634,8 +1633,8 @@ queryName :: NameQuery -> Text queryName = fullDomainName . queryDomain -- | The query as a name: what RSLV carries below v22, and what the resolver's --- HTTP API takes. The only place a hashed label is written as text - the SMP --- protocol tags the choice instead of spelling it. +-- HTTP API takes. The only place a hashed label is written as text; SMP tags +-- the choice instead. queryDomain :: NameQuery -> SimplexDomain queryDomain NameQuery {queryTLD, queryLabel, querySub} = SimplexDomain {nameTLD = queryTLD, domain = label, subDomain = querySub} @@ -1663,23 +1662,20 @@ instance Encoding NameQuery where (queryTLD, queryLabel, EncList querySub) <- smpP pure NameQuery {queryTLD, queryLabel, querySub} --- | US cents. Rounded up wherever the registry's unit does not divide evenly, --- so a quote is never below what is charged; the exact figure is settled on --- chain at registration. +-- | US cents, rounded up where the registry's unit does not divide evenly, so +-- a quote is never below what is charged. The exact price is settled on chain. newtype USDCents = USDCents Int64 deriving (Eq, Ord, Show) - deriving newtype (Encoding, ToJSON, FromJSON) + deriving newtype (Encoding) --- | What the registry holds for a name. A TLD with no registrar or no price --- oracle configured is not a case here - it is ERR NAME RESOLVER, because a --- name that cannot be dated or priced is not one this router can report on. +-- | What the registry holds for a name. A name that cannot be dated or priced +-- is not a case here: the router answers ERR NAME RESOLVER instead. data NameRegistration - = -- | Held by someone. A registered name always resolves: where its owner set - -- no records the record is still present, every field unset and nrResolver - -- the zero address, so "taken until " stays answerable. + = -- | Held by someone. Always carries a record: where the owner set none, + -- every field is unset and the resolver address is zero. NRRegistered { -- | unix seconds the registration runs out. Absent only from a v20/v21 - -- router, whose answer carried the record and nothing else. + -- router, whose answer carried the record alone. expires :: Maybe SystemSeconds, -- | unix seconds, > expires: until here only the owner may renew graceUntil :: Maybe SystemSeconds, @@ -1691,14 +1687,12 @@ data NameRegistration NRAvailable { pricing :: NamePricing, -- | while set, the name also costs a surcharge above `pricing` that - -- decays to nothing at this time. The surcharge itself is deliberately - -- not carried: it changes continuously, so it cannot be an in-app - -- purchase price. A client counts down to the ordinary price instead. + -- decays to nothing at this time. The surcharge itself is not carried: + -- it changes continuously, so it cannot be quoted as a price. auctionUntil :: Maybe SystemSeconds } - | -- | Held back by the registry and not registered. No price: what it costs, - -- and whether it can be had at all, is a conversation with SimpleX. This is - -- also why a reserved name never frees up on its own. + | -- | Held back by the registry and not registered. No price: it is not for + -- sale at the registry's price. NRReserved {reservedReason :: NameReservedReason} deriving (Eq, Show) @@ -1722,21 +1716,14 @@ instance Encoding NameRegistration where _ -> fail "bad NameRegistration" -- | Enough to price the name locally. The client knows the label, so it knows --- both which tier applies and whether the label is long enough - neither of --- which the router can see behind a hash. --- --- price len duration = fromMaybe basePrice (M.lookup len rentPrices) --- * duration `div` 31536000 --- --- The registry's minimum registration is 28 days, a contract constant rather --- than a per-deployment value, so it is specified rather than sent. +-- which tier applies and whether the label is long enough; the router, behind a +-- hash, knows neither. The formula is in protocol/simplex-messaging.md. data NamePricing = NamePricing - { -- | US cents per year for the label lengths the registry prices specially. - -- Lengths below minLabelLength are absent, being unregistrable. + { -- | US cents per year, for the lengths the registry prices specially rentPrices :: Map Int USDCents, - -- | US cents per year for every length not in rentPrices. + -- | US cents per year for every other length basePrice :: USDCents, - -- | characters: the registry refuses shorter, so the client must check it. + -- | characters; the registry refuses shorter labels minLabelLength :: Int } deriving (Eq, Show) @@ -1754,16 +1741,14 @@ instance Encoding NamePricing where tierMap :: [(Word16, USDCents)] -> Map Int USDCents tierMap = M.fromList . map (\(len, price) -> (fromIntegral len, price)) --- | Why the registry holds a name back. A reason this version has no word for --- keeps its own word rather than losing the reservation. +-- | Why the registry holds a name back. data NameReservedReason - = -- | held for SimpleX. On chain this is 1, which is also what the boolean - -- reservedNames of the first .testing deployment set. + = -- | held for SimpleX NRRInternal | NRRTrademark | NRRCommunity | -- | a reason added to the registry after this version: still reserved, and - -- carrying its own word so a later version can name it + -- carries its own word so a later version can name it NRRUnknown Text deriving (Eq, Show) @@ -1774,22 +1759,19 @@ instance StrEncoding NameReservedReason where NRRTrademark -> "trademark" NRRCommunity -> "community" NRRUnknown t -> encodeUtf8 t - strP = parseReservedReason . safeDecodeUtf8 <$> A.takeTill (== ' ') + strP = reservedReasonOf . safeDecodeUtf8 <$> A.takeTill (== ' ') + where + reservedReasonOf = \case + "internal" -> NRRInternal + "trademark" -> NRRTrademark + "community" -> NRRCommunity + t -> NRRUnknown t instance Encoding NameReservedReason where smpEncode = strEncode smpP = strP --- | Keeps its word rather than losing the reservation. -parseReservedReason :: Text -> NameReservedReason -parseReservedReason = \case - "internal" -> NRRInternal - "trademark" -> NRRTrademark - "community" -> NRRCommunity - t -> NRRUnknown t - --- | What a v20/v21 router's answer amounts to: it resolves, and nothing else --- was said about it. +-- | A v20/v21 router's answer: the name resolves, and nothing else was said. oldRegistration :: NameRecord -> NameRegistration oldRegistration nameRecord = NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Nothing, nameRecord} diff --git a/src/Simplex/Messaging/Server/Names.hs b/src/Simplex/Messaging/Server/Names.hs index 985cf21a3..f360789cf 100644 --- a/src/Simplex/Messaging/Server/Names.hs +++ b/src/Simplex/Messaging/Server/Names.hs @@ -17,11 +17,13 @@ where import qualified Control.Exception as E import Control.Logger.Simple (logError) +import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Map.Strict as M import qualified Data.Text as T -import Simplex.Messaging.Protocol (NameErrorType (..), NamePricing (..), NameRecord, NameQuery, NameRegistration (..), NameReservedReason, USDCents (..), oldRegistration, parseReservedReason, queryName) +import Data.Text.Encoding (encodeUtf8) +import Simplex.Messaging.Encoding.String (strDecode) +import Simplex.Messaging.Protocol (NameErrorType (..), NamePricing (..), NameQuery, NameRecord, NameRegistration (..), NameReservedReason (..), USDCents (..), oldRegistration, queryName) import Simplex.Messaging.Server.Names.HttpResolver ( NameStatusResp (..), ResolverEnv, @@ -75,17 +77,15 @@ fetch :: NamesEnv -> NameQuery -> IO (Either NameErrorType NameRegistration) fetch NamesEnv {resolverEnv} q = either (Left . mapResolverError) nameRegistration <$> resolveHttp resolverEnv (queryName q) --- | A resolver that reports no status at all is an older one, and only ever --- returned a record for a live registration - which is what oldRegistration says. +-- | A resolver that reports no status is an older one, which returned a record +-- only for a live registration. nameRegistration :: (Maybe NameRecord, Maybe NameStatusResp) -> Either NameErrorType NameRegistration nameRegistration = \case (rec_, Just ns) -> mapStatus rec_ ns (Just rec, Nothing) -> Right (oldRegistration rec) (Nothing, Nothing) -> Left NOT_FOUND --- | The resolver's vocabulary. A status this router has no word for is not an --- answer: a registration would assert one nobody read, and availability would --- offer a name that may be held. +-- | The resolver's status words. An unknown status is not an answer. mapStatus :: Maybe NameRecord -> NameStatusResp -> Either NameErrorType NameRegistration mapStatus rec_ ns@NameStatusResp {nsStatus, nsExpires, nsGraceEnds, nsReasonCode, nsAuctionUntil} = case nsStatus of @@ -96,27 +96,25 @@ mapStatus rec_ ns@NameStatusResp {nsStatus, nsExpires, nsGraceEnds, nsReasonCode s -> Left (RESOLVER (T.take 32 s)) where reservedReason_ = resolverReason <$> nsReasonCode - -- A registered name resolves: where the owner set no records the resolver - -- still returns one, every field unset. And a registration this router - -- could not date is not one it can report. + -- A registered name always has a record, and a registration this router + -- cannot date is not one it can report. registered = case (rec_, nsExpires, nsGraceEnds) of (Just nameRecord, Just expires, Just graceUntil) -> Right NRRegistered {expires = Just (RoundedSystemTime expires), graceUntil = Just (RoundedSystemTime graceUntil), reservedReason_, nameRecord} (Nothing, _, _) -> Left (RESOLVER "no record") _ -> Left (RESOLVER "no expiry") - -- A held-back name is quoted no price: what it costs, and whether it can be - -- had at all, is a conversation with SimpleX. available = case reservedReason_ of Just r -> Right (NRReserved r) Nothing -> case namePricing ns of Just pricing -> Right NRAvailable {pricing, auctionUntil = RoundedSystemTime <$> nsAuctionUntil} Nothing -> Left (RESOLVER "no price oracle") --- | A code this router has no word for still reserves the name, and travels on --- as itself. Bounded to one wire token: it is the resolver's text, and the slot --- it goes into ends at a space. +-- | An unknown code still reserves the name, and travels on as itself. Cut to +-- one printable token: the wire slot it goes into ends at a space. resolverReason :: Text -> NameReservedReason -resolverReason = parseReservedReason . T.take 32 . T.takeWhile (\c -> c > ' ' && c < '\DEL') +resolverReason t = either (const (NRRUnknown t')) id (strDecode (encodeUtf8 t')) + where + t' = T.take 32 (T.takeWhile (\c -> c > ' ' && c < '\DEL') t) namePricing :: NameStatusResp -> Maybe NamePricing namePricing NameStatusResp {nsRentPrices, nsBasePrice, nsMinLabelLength} = do diff --git a/src/Simplex/Messaging/Server/Names/HttpResolver.hs b/src/Simplex/Messaging/Server/Names/HttpResolver.hs index e0106a3ad..69d2c4e65 100644 --- a/src/Simplex/Messaging/Server/Names/HttpResolver.hs +++ b/src/Simplex/Messaging/Server/Names/HttpResolver.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} -- | HTTP transport for the public-namespace resolver. @@ -37,8 +38,9 @@ where import qualified Control.Exception as E import qualified Data.Aeson as J import Data.Aeson.Key (Key) -import qualified Data.Aeson.Types as JT import qualified Data.Aeson.KeyMap as JKM +import qualified Data.Aeson.TH as JQ +import qualified Data.Aeson.Types as JT import Data.Bifunctor (first) import qualified Data.ByteArray.Encoding as BAE import Data.ByteString.Char8 (ByteString) @@ -66,6 +68,7 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified Network.HTTP.Types as HT import Network.HTTP.Types.URI (urlEncode) import Simplex.Messaging.Names.Record (NameRecord) +import Simplex.Messaging.Parsers (defaultJSON, dropPrefix) data RpcAuth = AuthBearer Text | AuthBasic Text Text @@ -89,21 +92,19 @@ data NameStatusResp = NameStatusResp { nsStatus :: Text, nsExpires :: Maybe Int64, nsGraceEnds :: Maybe Int64, - -- | reported alongside the status: a reservation is orthogonal to it nsReasonCode :: Maybe Text, - -- | when the post-grace surcharge decays to nothing, so the client can - -- count down to the ordinary price. The surcharge itself never travels. + -- | when the post-grace surcharge decays to nothing nsAuctionUntil :: Maybe Int64, - -- | the TLD's price oracle, in US cents per year: the lengths it prices - -- specially, and the price for every other length. The resolver converts - -- from the registry's attoUSD, so nothing 256-bit gets this far and every - -- value fits a JSON number exactly. + -- | US cents per year, by label length nsRentPrices :: Maybe (Map Int Int64), + -- | US cents per year for every other length nsBasePrice :: Maybe Int64, nsMinLabelLength :: Maybe Int } deriving (Show) +$(JQ.deriveFromJSON defaultJSON {J.fieldLabelModifier = dropPrefix "ns"} ''NameStatusResp) + data ResolverError = HttpFailure HttpException | HttpStatusErr Int @@ -138,63 +139,41 @@ authHeader = \case in ("Authorization", "Basic " <> encoded) -- | GET /resolve/, returning the record when the --- name resolves and what the resolver says about the name either way. The --- status code cannot tell an unregistered name from a reserved or lapsed one; --- that is in the body, under "status" on a 200 and "error" otherwise. Older --- resolvers omit it, hence the Maybe. The name is percent-encoded (every --- non-unreserved byte per RFC 3986): the resolver expects raw labels, so --- slashes/punctuation must not alter the path. +-- name resolves and what the resolver says about the name either way. The status +-- code cannot tell an unregistered name from a reserved or lapsed one, so on the +-- two codes that carry availability the body is read as well. The name is +-- percent-encoded (every non-unreserved byte per RFC 3986): the resolver expects +-- raw labels, so slashes/punctuation must not alter the path. resolveHttp :: ResolverEnv -> Text -> IO (Either ResolverError (Maybe NameRecord, Maybe NameStatusResp)) -resolveHttp ResolverEnv {manager, baseUrl, authHdr, timeoutMicro, maxResponseBytes} name = do - req0 <- parseRequest (baseUrl <> "/resolve/" <> B.unpack (urlEncode True (encodeUtf8 name))) - let req = - req0 - { redirectCount = 0, - requestHeaders = ("Accept", "application/json") : authHdr, - HC.responseTimeout = responseTimeoutMicro timeoutMicro - } - result <- E.try $ withResponse req manager $ \res -> do - let status = HT.statusCode (responseStatus res) - bs <- brReadSome (responseBody res) (maxResponseBytes + 1) - pure $ - if BL.length bs > fromIntegral maxResponseBytes - then Left BodyTooLarge - else case J.decode bs of - Just v@(J.Object o) - | status < 400 -> (,statusResp o "status") . Just <$> first InvalidJson (JT.parseEither J.parseJSON v) - | otherwise -> maybe (Left $ HttpStatusErr status) (Right . (Nothing,) . Just) (statusResp o "error") - _ - | status < 400 -> Left (InvalidJson "not a JSON object") - | otherwise -> Left (HttpStatusErr status) - pure (either (Left . HttpFailure) id result) +resolveHttp env name = + (>>= nameResp) <$> httpGet env ("/resolve/" <> B.unpack (urlEncode True (encodeUtf8 name))) where - statusResp o field = mkResp <$> jsonField o field - where - mkResp t = - NameStatusResp - { nsStatus = t, - nsExpires = jsonField o "expires", - nsGraceEnds = jsonField o "graceEnds", - nsReasonCode = jsonField o "reasonCode", - nsAuctionUntil = jsonField o "auctionUntil", - nsRentPrices = jsonField o "rentPrices", - nsBasePrice = jsonField o "basePrice", - nsMinLabelLength = jsonField o "minLabelLength" - } + nameResp (status, bs) + | status < 400 = (,statusResp bs "status") . Just <$> first InvalidJson (J.eitherDecode bs) + | status == 404 || status == 410 = + maybe (Left $ HttpStatusErr status) (Right . (Nothing,) . Just) (statusResp bs "error") + | otherwise = Left (HttpStatusErr status) --- | A field the resolver omits or nulls for statuses that do not carry it. -jsonField :: J.FromJSON a => J.Object -> Key -> Maybe a -jsonField o k = JT.parseMaybe J.parseJSON =<< JKM.lookup k o +-- | What the resolver says about the name, under "status" on a 200 and "error" +-- on the codes that carry availability. Older resolvers send neither. +statusResp :: BL.ByteString -> Key -> Maybe NameStatusResp +statusResp bs k = case J.decode bs of + Just (J.Object o) -> do + v <- JKM.lookup k o + JT.parseMaybe J.parseJSON (J.Object (JKM.insert "status" v o)) + _ -> Nothing -- | GET /health; success = reachable with status < 400. The body is -- size-capped but NOT decoded — the probe only checks reachability. healthHttp :: ResolverEnv -> IO (Either ResolverError ()) -healthHttp env = (() <$) <$> httpGet env "/health" +healthHttp env = (>>= statusOk . fst) <$> httpGet env "/health" + where + statusOk status = if status >= 400 then Left (HttpStatusErr status) else Right () --- | GET , returning the response body bytes on status < 400 --- within the size cap. Redirects are disabled and Authorization is attached --- only when configured. -httpGet :: ResolverEnv -> String -> IO (Either ResolverError BL.ByteString) +-- | GET , returning the response status and body bytes within the +-- size cap. Redirects are disabled and Authorization is attached only when +-- configured. +httpGet :: ResolverEnv -> String -> IO (Either ResolverError (Int, BL.ByteString)) httpGet ResolverEnv {manager, baseUrl, authHdr, timeoutMicro, maxResponseBytes} path = do req0 <- parseRequest (baseUrl <> path) let req = @@ -205,9 +184,6 @@ httpGet ResolverEnv {manager, baseUrl, authHdr, timeoutMicro, maxResponseBytes} } result <- E.try $ withResponse req manager $ \res -> do let status = HT.statusCode (responseStatus res) - if status >= 400 - then pure (Left (HttpStatusErr status)) - else do - bs <- brReadSome (responseBody res) (maxResponseBytes + 1) - pure $ if BL.length bs > fromIntegral maxResponseBytes then Left BodyTooLarge else Right bs + bs <- brReadSome (responseBody res) (maxResponseBytes + 1) + pure $ if BL.length bs > fromIntegral maxResponseBytes then Left BodyTooLarge else Right (status, bs) pure (either (Left . HttpFailure) id result) diff --git a/src/Simplex/Messaging/SimplexName.hs b/src/Simplex/Messaging/SimplexName.hs index 34e242100..c81dbd4cb 100644 --- a/src/Simplex/Messaging/SimplexName.hs +++ b/src/Simplex/Messaging/SimplexName.hs @@ -77,8 +77,8 @@ nameLabelP = do -- (Cyrillic а vs ASCII a hash to different on-chain records). isNameLetter c = c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' --- | The registry's key for a label, and what BaseRegistrarImplementation.labelOf --- is keyed on. Always 32 bytes. +-- | The registry's key for a label, and what +-- BaseRegistrarImplementation.labelOf takes. Always 32 bytes. newtype LabelHash = LabelHash ByteString deriving (Eq, Show) @@ -86,14 +86,12 @@ instance Encoding LabelHash where smpEncode (LabelHash h) = h smpP = LabelHash <$> A.take 32 --- | keccak-256 of the lowercased label. Only a second-level label is a registry --- key: subname labels are needed as text to reach the record. +-- | keccak-256 of the lowercased label, as the registry keys it. labelHash :: Text -> LabelHash labelHash label = LabelHash $ BA.convert (hash (encodeUtf8 (T.toLower label)) :: Digest Keccak_256) --- | How the backing resolver is addressed for a hashed label: ENS's encoding --- for a label whose text is unknown. The SMP protocol never parses this form - --- it tags the choice instead - so the brackets live here alone. +-- | ENS's encoding for a label whose text is unknown, which is what the +-- backing resolver's HTTP API takes. labelHashText :: LabelHash -> Text labelHashText (LabelHash h) = "[" <> decodeLatin1 (BAE.convertToBase BAE.Base16 h) <> "]" diff --git a/tests/RSLVTests.hs b/tests/RSLVTests.hs index 1cd5d8cde..a199dbb31 100644 --- a/tests/RSLVTests.hs +++ b/tests/RSLVTests.hs @@ -217,8 +217,8 @@ oldClient = do g <- C.newRandom ts <- getCurrentTime let srv = SMPServer testHost testPort testKeyHash - -- the version just below the gate: a lower ceiling would also pass for a - -- gate at 20 or 21 and prove nothing about v22 + -- the version just below the gate: a lower ceiling would pass even if + -- the gate were at 20 or 21 oldCfg = defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion serverInfoSMPVersion} pcE <- getProtocolClient g NRMInteractive (1, srv, Nothing) oldCfg [] Nothing ts (\_ -> pure ()) either (fail . show) pure pcE @@ -269,7 +269,7 @@ auctionPricing = aliceHash :: Text aliceHash = "[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]" --- | A current client must never put a registrable name on the wire. +-- | The paths the client asked the resolver for. resolvePaths :: IORef [[Text]] -> IO [[Text]] resolvePaths reqs = filter isResolve <$> readIORef reqs where @@ -289,8 +289,7 @@ testRslvSendsTheHash = pc <- currentClient r <- runExceptT' (directResolveName pc NRMInteractive (domain "alice.simplex")) resolvePaths reqs `shouldReturn` [["resolve", aliceHash <> ".simplex"]] - -- the client never sent the name, and the record still names it: the - -- registrar records the label at registration, keyed by its own hash + -- the client never sent the name, and the record still names it case r of NRRegistered {nameRecord} -> SMP.nrName nameRecord `shouldBe` "alice.simplex" _ -> expectationFailure $ "expected NRRegistered, got: " <> show r diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 5d7eb76b7..8c1795cfd 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -121,19 +121,16 @@ rslvWireSpec = do availabilitySpec :: Spec availabilitySpec = do -- one lookup answers what the name points to, whether it can be taken, and - -- whether the registry holds it back + -- whether it is held back it "a registered name answers with its record and dates" $ answers status200 (recordWith "\"status\":\"registered\",\"expires\":1813853483,\"graceEnds\":1821629483") $ NRRegistered {expires = Just (RoundedSystemTime 1813853483), graceUntil = Just (RoundedSystemTime 1821629483), reservedReason_ = Nothing, nameRecord = testNameRecord} - -- the record travels through grace: the UI decides how long to keep opening it it "a name in grace keeps its record" $ answers status200 (recordWith "\"status\":\"grace\",\"expires\":1785000000,\"graceEnds\":1792776000") $ NRRegistered {expires = Just (RoundedSystemTime 1785000000), graceUntil = Just (RoundedSystemTime 1792776000), reservedReason_ = Nothing, nameRecord = testNameRecord} - -- reservation is orthogonal: it is why the name will not free up at expiry it "a registered name can be held back too" $ answers status200 (recordWith "\"status\":\"registered\",\"expires\":1813853483,\"graceEnds\":1821629483,\"reasonCode\":\"internal\"") $ NRRegistered {expires = Just (RoundedSystemTime 1813853483), graceUntil = Just (RoundedSystemTime 1821629483), reservedReason_ = Just NRRInternal, nameRecord = testNameRecord} - -- an older resolver reports no status; the record is still the answer it "a resolver that sends no status still answers with the record" $ answers status200 (J.encode testNameRecord) $ NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Nothing, nameRecord = testNameRecord} @@ -143,16 +140,14 @@ availabilitySpec = do it "expired is available, counting down to the ordinary price" $ answers status410 (jsonBody ("{\"error\":\"expired\",\"auctionUntil\":1790294400," <> pricingJson <> "}")) $ NRAvailable {pricing = testPricing, auctionUntil = Just (RoundedSystemTime 1790294400)} - -- a held-back name is not for sale at the registry's price it "reserved carries the reason and no price" $ answers status404 (jsonBody ("{\"error\":\"unregistered\",\"reasonCode\":\"trademark\"," <> pricingJson <> "}")) $ NRReserved NRRTrademark - -- a later version may reserve names for reasons this one cannot name; the - -- reservation must survive that, or a client would offer a name it cannot get + -- losing the reservation would offer a name that cannot be registered it "a reason from a later version still reserves the name" $ answers status404 "{\"error\":\"unregistered\",\"reasonCode\":\"seasonal\"}" (NRReserved (NRRUnknown "seasonal")) - -- the reason re-encodes into a slot that ends at a space, so the router keeps - -- it to one bounded token rather than trusting the resolver's text + -- the reason re-encodes into a slot that ends at a space, so it is cut to one + -- token it "a reason with a space is cut at the space" $ answers status404 "{\"error\":\"unregistered\",\"reasonCode\":\"two words\"}" (NRReserved (NRRUnknown "two")) it "an over-long reason is truncated" $ @@ -165,16 +160,18 @@ availabilitySpec = do refuses status404 "{\"error\":\"registered\",\"expires\":1813853483,\"graceEnds\":1821629483}" (RESOLVER "no record") it "no price oracle is a resolver error" $ refuses status404 "{\"error\":\"unregistered\"}" (RESOLVER "no price oracle") + -- only 404 and 410 carry availability, so only their bodies are read as a + -- status it "upstream failure is a resolver error" $ - refuses status502 "{\"error\":\"upstreamError\"}" (RESOLVER "upstreamError") - it "unconfigured TLD is a resolver error" $ - refuses status400 "{\"error\":\"tldNotConfigured\"}" (RESOLVER "tldNotConfigured") + refuses status502 "{\"error\":\"upstreamError\"}" (RESOLVER "HTTP 502") + it "unconfigured TLD is not found" $ + refuses status400 "{\"error\":\"tldNotConfigured\"}" NOT_FOUND it "unreadable status is a resolver error" $ refuses status404 "{\"error\":\"unknown\"}" (RESOLVER "unknown") it "long status is truncated" $ - refuses status502 (jsonBody ("{\"error\":\"" <> replicate 400 'e' <> "\"}")) (RESOLVER (T.replicate 32 "e")) - -- a body the router cannot read is the pre-v22 answer, unchanged: NOT_FOUND - -- says the router has nothing to say, never that the name is registrable + refuses status404 (jsonBody ("{\"error\":\"" <> replicate 400 'e' <> "\"}")) (RESOLVER (T.replicate 32 "e")) + -- NOT_FOUND says the router has nothing to say, never that the name is + -- registrable it "unreadable 404 body stays NOT_FOUND" $ refuses status404 "gateway" NOT_FOUND it "over-cap body is a resolver error" $ @@ -223,7 +220,7 @@ pricingJson = "\"rentPrices\":{\"3\":12793,\"4\":3198},\"basePrice\":100,\"minLa parseNameSpec :: Spec parseNameSpec = do - -- a name is a name: the hashed form is a query, and has its own type + -- the hashed form is a query, not a name: it has its own type it "a name is never a hash" $ parseN ("[" <> T.replicate 64 "b" <> "].simplex") `shouldSatisfy` isLeft -- keccak-256("alice"), the same constant the resolver's own tests use