From d9b26ad997f5fe87ecd7d98f837bd71283405e51 Mon Sep 17 00:00:00 2001 From: shum Date: Fri, 23 Oct 2026 13:40:06 +0000 Subject: [PATCH] store: read the terms and community names --- .../src/StoreService/Config.hs | 96 +++++++++++-- .../src/StoreService/Names/Community.hs | 33 +++++ scripts/store-service/names-contract-run.sh | 10 ++ simplex-chat.cabal | 3 + tests/Bots/StoreService/ConfigTests.hs | 11 +- .../Bots/StoreService/NamesCommunityTests.hs | 133 ++++++++++++++++++ tests/Bots/StoreService/NamesOrdersTests.hs | 16 ++- tests/Bots/StoreService/NamesSearchTests.hs | 6 +- tests/Test.hs | 2 + 9 files changed, 291 insertions(+), 19 deletions(-) create mode 100644 apps/simplex-store-service/src/StoreService/Names/Community.hs create mode 100644 tests/Bots/StoreService/NamesCommunityTests.hs diff --git a/apps/simplex-store-service/src/StoreService/Config.hs b/apps/simplex-store-service/src/StoreService/Config.hs index fecd832f82..3b91e80a5f 100644 --- a/apps/simplex-store-service/src/StoreService/Config.hs +++ b/apps/simplex-store-service/src/StoreService/Config.hs @@ -13,6 +13,7 @@ module StoreService.Config BadgeIssuerKey (..), GroupConfig (..), NamesConfig (..), + TermsConfig (..), ChainConfig (..), ServiceConfig (..), defaultExpiryMinutes, @@ -26,14 +27,21 @@ module StoreService.Config where import qualified Control.Exception as E -import StoreService.Log (logWarn) -import Control.Monad (mfilter, unless, when) +import StoreService.Log (logInfo, logWarn) +import Control.Applicative (many) +import Control.Monad (forM_, mfilter, unless, when) +import Data.Attoparsec.Combinator (lookAhead) import Data.Attoparsec.Text (Parser, endOfInput, isEndOfLine, parseOnly, satisfy, skipMany, skipSpace, skipWhile) +import Data.Bifunctor (first) import qualified Data.ByteArray as BA import Data.ByteArray.Encoding (Base (Base16), convertFromBase) +import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B -import Data.Ini (Ini, iniGlobals, iniParser, keys, lookupValue, sections) -import Data.List (nub) +import Data.Char (GeneralCategory (..), generalCategory, isAsciiLower, isAsciiUpper, isControl, isDigit, isSpace) +import Data.Ini (Ini, iniGlobals, iniParser, keyValueParser, keys, lookupValue, sectionParser, sections) +import Data.List (nub, (\\)) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T @@ -42,12 +50,15 @@ import qualified Data.Text.IO as TIO import Data.Time.Clock (UTCTime) import Data.Time.Format.ISO8601 (iso8601ParseM) import Data.Word (Word64) +import Simplex.Chat.Badges.Code (maxNameLength, minNameLength) import Simplex.Chat.Library.Commands (mkValidName) import Simplex.Messaging.Crypto.BBS (BBSSecretKey) import Simplex.Messaging.Crypto.Secp256k1 (Secp256k1PrivateKey, mkPrivateKey) import Simplex.Messaging.Encoding.String (strDecode) import Simplex.Messaging.Eth.Address (Address) -import Simplex.Messaging.SimplexName (SimplexTLD (..)) +import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD (..), labelHash) +import Simplex.Messaging.Util (tshow) +import StoreService.Names.Label (LabelError (..), validLabel) import System.IO.Error (ioeGetErrorString) import Text.Read (readMaybe) @@ -132,10 +143,17 @@ data NamesConfig = NamesConfig nTermSlackSeconds :: Int, nRevealMarginSeconds :: Int, nMaxOrderMoves :: Int, + nTerms :: TermsConfig, + -- | The operator's community names, keyed by the label hash's bytes, as search receives a name. + nCommunity :: Map ByteString Text, nChain :: ChainConfig } deriving (Eq, Show) +-- | The name terms buyers agree to, and the page the order's checkbox links to. +data TermsConfig = TermsConfig {tVersion :: Text, tUrl :: Text} + deriving (Eq, Show) + data ChainConfig = ChainConfig { cRpcUrl :: String, cChainId :: Word64, @@ -188,6 +206,12 @@ requireHttps u | "https://" `T.isPrefixOf` u = Right u | otherwise = Left "btcpay.host must be an absolute https URL" +maxTermsVersionLength :: Int +maxTermsVersionLength = 32 + +maxCommunityTextLength :: Int +maxCommunityTextLength = 200 + -- | The controller refuses a registration under 730 days. minNameYears :: Int minNameYears = 2 @@ -215,11 +239,28 @@ readServiceConfig path = E.try (TIO.readFile path) >>= \case Left (e :: E.IOException) -> pure (Left (ioeGetErrorString e)) -- Data.Ini stops at the first unparseable line and keeps what it has, so a missing `=` silently drops every section below. - Right text -> case parseOnly (iniParser <* trailingNoise <* endOfInput) text of + Right text -> case parseOnly ((,) <$> lookAhead (many keyValueParser *> many sectionParser) <*> iniParser <* trailingNoise <* endOfInput) text of Left _ -> pure (Left "could not be read as an ini file: a line is malformed") - Right ini -> do - mapM_ (\k -> logWarn (T.pack path <> ": nothing reads " <> k <> ", so it was ignored")) (unknownKeys ini) - pure (parseConfig ini) + Right (written, ini) -> case repeatedSetting written of + Just e -> pure (Left e) + Nothing -> do + mapM_ (\k -> logWarn (T.pack path <> ": nothing reads " <> k <> ", so it was ignored")) (unknownKeys ini) + let cfg = parseConfig ini + forM_ (either (const Nothing) names cfg) $ \NamesConfig {nCommunity} -> + logInfo ("names: " <> tshow (M.size nCommunity) <> " community names loaded") + pure cfg + +-- | Data.Ini keeps only the last section of a name and the first value of a key in a section, +-- so the sections are read in order to refuse a repeated one. +repeatedSetting :: [(Text, [(Text, Text)])] -> Maybe String +repeatedSetting written = case repeated (map fst written) of + h : _ -> Just ("[" <> T.unpack h <> "] is written twice, and only the last of them would be read") + [] -> case [(s, k) | (s, kvs) <- written, k <- repeated (map fst kvs)] of + (s, k) : _ -> Just (T.unpack s <> "." <> T.unpack k <> " is written twice, and only the first of them would be read") + [] -> Nothing + +repeated :: Eq a => [a] -> [a] +repeated xs = nub (xs \\ nub xs) -- | iniParser stops before a trailing comment, so endOfInput alone would reject a valid file. trailingNoise :: Parser () @@ -246,7 +287,7 @@ knownSettings = ("poll", ["waiting_seconds", "idle_seconds"]), ("group", ["display_name", "description"]), ("issuer", ["index", "private_key", "dev_keys"]), - ("names", ["tld", "years", "term_start", "term_slack_seconds", "reveal_margin_seconds", "max_order_moves"]), + ("names", ["tld", "terms_version", "terms_url", "years", "term_start", "term_slack_seconds", "reveal_margin_seconds", "max_order_moves"]), ("chain", ["rpc_url", "chain_id", "controller", "sponsor", "base_registrar", "resolver", "service_key", "confirmations", "gas_limit_cap", "max_fee_per_gas"]) ] @@ -254,7 +295,8 @@ unknownKeys :: Ini -> [Text] unknownKeys ini = beforeAnySection <> unknownSections <> settings where beforeAnySection = [k <> ", written above the first section header" | (k, _) <- iniGlobals ini] - unknownSections = ["[" <> s <> "]" | s <- sections ini, T.strip s `notElem` map fst knownSettings] + -- [community] keys are labels, which parseConfig checks. + unknownSections = ["[" <> s <> "]" | s <- sections ini, T.strip s `notElem` ("community" : map fst knownSettings)] settings = [ section <> "." <> key | (section, known) <- knownSettings, @@ -403,7 +445,9 @@ parseConfig ini = do let sHost = defaultStripeHost pure (Just StripeConfig {sSecretKey, sPublishableKey, sWebhookSecret, sSessionMinutes, sHost}) namesSection - | not (hasSection "names") = if hasSection "chain" then Left "[chain] is set but [names] is absent, so nothing would use it" else Right Nothing + | not (hasSection "names") = case filter hasSection ["chain", "community"] of + s : _ -> Left ("[" <> T.unpack s <> "] is set but [names] is absent, so nothing would use it") + [] -> Right Nothing | not (hasSection "chain") = Left "[names] needs a [chain] section" | otherwise = do nTLD <- tldSetting @@ -413,8 +457,10 @@ parseConfig ini = do nTermSlackSeconds <- atLeast 0 "names" "term_slack_seconds" 3600 nRevealMarginSeconds <- atLeast 0 "names" "reveal_margin_seconds" 900 nMaxOrderMoves <- atLeast 0 "names" "max_order_moves" 3 + nTerms <- termsSetting + nCommunity <- communityList nTLD nChain <- chainSection - pure (Just NamesConfig {nTLD, nYears, nTermStart, nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves, nChain}) + pure (Just NamesConfig {nTLD, nYears, nTermStart, nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves, nTerms, nCommunity, nChain}) tldSetting = required "names" "tld" >>= \case "simplex" -> Right TLDSimplex @@ -423,6 +469,30 @@ parseConfig ini = do termStart = maybe (Left ("names.term_start must be an ISO 8601 UTC time such as " <> defaultTermStart)) Right $ iso8601ParseM (maybe defaultTermStart T.unpack (present "names" "term_start")) + termsSetting = do + tVersion <- required "names" "terms_version" + unless (T.length tVersion <= maxTermsVersionLength && T.all versionChar tVersion) $ + Left ("names.terms_version must be 1 to " <> show maxTermsVersionLength <> " letters, digits, dots, underscores or hyphens") + tUrl <- required "names" "terms_url" + unless (httpsUrl tUrl) $ Left "names.terms_url must be an https URL" + pure TermsConfig {tVersion, tUrl} + versionChar c = isAsciiUpper c || isAsciiLower c || isDigit c || c `elem` ("._-" :: String) + httpsUrl u = case T.stripPrefix "https://" u of + Just rest -> not (T.null rest) && T.all (\c -> not (isSpace c || isControl c)) rest + Nothing -> False + communityList tld = M.fromList <$> mapM (communityEntry tld) (either (const []) id (keys "community" ini)) + communityEntry tld label = do + let k = "community." <> T.unpack label + text = fromMaybe "" (look "community" label) + valid <- first (labelRefusal k) (validLabel tld label) + when (T.null text || T.length text > maxCommunityTextLength) $ Left (k <> " must be 1 to " <> show maxCommunityTextLength <> " characters") + when (T.any invisible text) $ Left (k <> " has a control, format or line separator character") + let LabelHash h = labelHash valid + pure (h, text) + invisible c = isControl c || generalCategory c `elem` [Format, LineSeparator, ParagraphSeparator] + labelRefusal k = \case + LELength -> k <> " must be " <> show minNameLength <> " to " <> show maxNameLength <> " characters" + LEChars -> k <> " must be lower-case letters and digits, with single hyphens between them" atLeast lowest s k d = do v <- num s k d if v >= lowest then Right v else Left (T.unpack s <> "." <> T.unpack k <> " must be at least " <> show lowest) diff --git a/apps/simplex-store-service/src/StoreService/Names/Community.hs b/apps/simplex-store-service/src/StoreService/Names/Community.hs new file mode 100644 index 0000000000..bde20b99fa --- /dev/null +++ b/apps/simplex-store-service/src/StoreService/Names/Community.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module StoreService.Names.Community + ( communityFor, + termsFor, + communityJSON, + termsJSON, + ) +where + +import Data.Aeson ((.=)) +import qualified Data.Aeson as J +import qualified Data.Map.Strict as M +import Data.Text (Text) +import Simplex.Messaging.SimplexName (LabelHash (..)) +import StoreService.Config (NamesConfig (..), TermsConfig (..)) + +communityFor :: NamesConfig -> LabelHash -> Maybe Text +communityFor NamesConfig {nCommunity} (LabelHash h) = M.lookup h nCommunity + +-- | The suffix records that the buyer agreed to the community wording, under the same version. +termsFor :: NamesConfig -> LabelHash -> Text +termsFor cfg@NamesConfig {nTerms = TermsConfig {tVersion}} lh = maybe tVersion (const $ tVersion <> communityTermsSuffix) (communityFor cfg lh) + +communityTermsSuffix :: Text +communityTermsSuffix = "/community" + +communityJSON :: NamesConfig -> LabelHash -> J.Value +communityJSON cfg lh = maybe J.Null (\t -> J.object ["for" .= t]) (communityFor cfg lh) + +termsJSON :: NamesConfig -> J.Value +termsJSON NamesConfig {nTerms = TermsConfig {tVersion, tUrl}} = J.object ["version" .= tVersion, "url" .= tUrl] diff --git a/scripts/store-service/names-contract-run.sh b/scripts/store-service/names-contract-run.sh index 354b607075..69215ca484 100755 --- a/scripts/store-service/names-contract-run.sh +++ b/scripts/store-service/names-contract-run.sh @@ -30,6 +30,11 @@ CLI_TIMEOUT_SECONDS=120 # through [issuer] dev_keys, which the service accepts only on chain 31337. Never use it elsewhere. DEV_ISSUER_INDEX=999 DEV_ISSUER_SECRET=Ea5wG-J2mQjPBu9YfSJRKPnGnzoIdEE-8VaMh_wY2Bg= +TERMS_VERSION=2026-10-23 +TERMS_URL=https://simplex.chat/ +# the community name the webapp's community case searches for +COMMUNITY_LABEL=bakers +COMMUNITY_TEXT="bakers and bakeries in Portugal" # The cases at webapp 915a550. Each case is its own client by X-Forwarded-For, which the service trusts # here, as the mock does. Each takes its prepaid code from POST /control/code, which the code server @@ -136,6 +141,11 @@ dev_keys = $DEV_ISSUER_INDEX:$DEV_ISSUER_SECRET [names] tld = $(jq -r .tld "$chain") +terms_version = $TERMS_VERSION +terms_url = $TERMS_URL + +[community] +$COMMUNITY_LABEL = $COMMUNITY_TEXT [chain] rpc_url = $RPC_URL diff --git a/simplex-chat.cabal b/simplex-chat.cabal index d76b76ea2c..295564258e 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -446,6 +446,7 @@ executable simplex-store-service StoreService.Names.Balances StoreService.Names.Chain StoreService.Names.Codes + StoreService.Names.Community StoreService.Names.Contracts StoreService.Names.Env StoreService.Names.Label @@ -772,6 +773,7 @@ test-suite simplex-chat-test Bots.StoreService.NamesBalancesTests Bots.StoreService.NamesChainTests Bots.StoreService.NamesCodesTests + Bots.StoreService.NamesCommunityTests Bots.StoreService.NamesContractsTests Bots.StoreService.NamesLabelTests Bots.StoreService.NamesLateCreditTests @@ -814,6 +816,7 @@ test-suite simplex-chat-test StoreService.Names.Balances StoreService.Names.Chain StoreService.Names.Codes + StoreService.Names.Community StoreService.Names.Contracts StoreService.Names.Env StoreService.Names.Label diff --git a/tests/Bots/StoreService/ConfigTests.hs b/tests/Bots/StoreService/ConfigTests.hs index 24b0cbdd3e..c870af0923 100644 --- a/tests/Bots/StoreService/ConfigTests.hs +++ b/tests/Bots/StoreService/ConfigTests.hs @@ -449,8 +449,12 @@ sponsorAddr = "0x0B306BF915C4d645ff596e518fAf3F9669b97016" registrarAddr = "0x014f9c09CcEeDEF1B713110d04D3a07d5B5D9b73" resolverAddr = "0x8A791620dd6260079BF849Dc5567aDC3F2FdC318" +termsVersion, termsUrl :: T.Text +termsVersion = "2026-10-23" +termsUrl = "https://simplex.chat/" + namesSection :: [T.Text] -namesSection = ["[names]", "tld = testing"] +namesSection = ["[names]", "tld = testing", "terms_version = " <> termsVersion, "terms_url = " <> termsUrl] chainSection :: [T.Text] chainSection = @@ -503,10 +507,11 @@ testNamesDefaults = do testNamesWrittenOut :: IO () testNamesWrittenOut = do - let ns = ["[names]", "tld = simplex", "years = 5", "term_start = 2027-03-01T12:00:00Z", "term_slack_seconds = 60", "reveal_margin_seconds = 0", "max_order_moves = 0"] + let ns = ["[names]", "tld = simplex", "terms_version = 2027-01.b", "terms_url = https://simplex.chat/names/terms", "years = 5", "term_start = 2027-03-01T12:00:00Z", "term_slack_seconds = 60", "reveal_margin_seconds = 0", "max_order_moves = 0"] cs = chainSection <> ["confirmations = 0", "gas_limit_cap = 500000", "max_fee_per_gas = 30000000000"] - NamesConfig {nTLD, nYears, nTermStart, nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves, nChain = ChainConfig {cConfirmations, cGasLimitCap, cMaxFeePerGas}} <- parsedNames ns cs + NamesConfig {nTLD, nTerms, nYears, nTermStart, nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves, nChain = ChainConfig {cConfirmations, cGasLimitCap, cMaxFeePerGas}} <- parsedNames ns cs nTLD `shouldBe` TLDSimplex + nTerms `shouldBe` TermsConfig {tVersion = "2027-01.b", tUrl = "https://simplex.chat/names/terms"} nYears `shouldBe` 5 nTermStart `shouldBe` UTCTime (fromGregorian 2027 3 1) (12 * 3600) (nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves) `shouldBe` (60, 0, 0) diff --git a/tests/Bots/StoreService/NamesCommunityTests.hs b/tests/Bots/StoreService/NamesCommunityTests.hs new file mode 100644 index 0000000000..b77252395e --- /dev/null +++ b/tests/Bots/StoreService/NamesCommunityTests.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Bots.StoreService.NamesCommunityTests (namesCommunityTests) where + +import Bots.StoreService.ConfigTests (chainSection, namesIni, namesRefusal, namesSection, parseIni, parsedNames, termsUrl, termsVersion, withIni) +import Bots.StoreService.NamesSearchTests (aliceHex) +import Bots.StoreService.WebTests (capturingStderr) +import Control.Monad (forM_, void) +import Data.Ini (readIniFile) +import qualified Data.Map.Strict as M +import Data.Maybe (fromJust) +import Data.Text (Text) +import qualified Data.Text as T +import Simplex.Messaging.SimplexName (LabelHash (..), labelHash) +import StoreService.Config (NamesConfig (..), TermsConfig (..), unknownKeys) +import StoreService.Names.Abi (bytes32FromHex) +import StoreService.Names.Community (communityFor, termsFor) +import Test.Hspec + +namesCommunityTests :: Spec +namesCommunityTests = describe "StoreService names: community" $ do + it "reads the terms, and the list keyed by the label's keccak256, empty without [community]" testCommunityParsed + it "refuses [community] without [names]" testCommunityWithoutNames + it "refuses a section header written twice, naming it" testRepeatedHeader + it "refuses a key written twice in any section, naming it" testRepeatedKey + it "refuses a label that is not a valid name, upper case included, naming it" testBadLabel + it "refuses an empty or over-long text, or one with a control, format or line separator character" testBadText + it "refuses a missing or malformed terms_version or terms_url" testBadTerms + it "names no community label as a setting nothing reads" testNoUnknownKeys + it "logs how many community names it loaded" testLoadedCount + it "gives the version for an unlisted name and its community variant for a listed one" testTermsFor + +bakersText :: Text +bakersText = "bakers and bakeries in Portugal" + +communityLines :: [Text] -> [Text] +communityLines entries = "[community]" : entries + +withCommunity :: [Text] -> IO NamesConfig +withCommunity entries = parsedNames namesSection (chainSection <> communityLines entries) + +refusedCommunity :: [Text] -> IO String +refusedCommunity entries = namesRefusal namesSection (chainSection <> communityLines entries) + +-- viem: keccak256 of "alicebakery", as the page sends it +aliceHash :: LabelHash +aliceHash = LabelHash $ fromJust $ bytes32FromHex aliceHex + +testCommunityParsed :: IO () +testCommunityParsed = do + NamesConfig {nTerms, nCommunity} <- parsedNames namesSection chainSection + nTerms `shouldBe` TermsConfig {tVersion = termsVersion, tUrl = termsUrl} + nCommunity `shouldBe` M.empty + cfg@NamesConfig {nCommunity = listed} <- withCommunity ["bakers = " <> bakersText, "alicebakery = Alice's bakery, Lisbon; open daily"] + M.size listed `shouldBe` 2 + communityFor cfg aliceHash `shouldBe` Just "Alice's bakery, Lisbon; open daily" + communityFor cfg (labelHash "bakers") `shouldBe` Just bakersText + communityFor cfg (labelHash "bobsbakery") `shouldBe` Nothing + +testCommunityWithoutNames :: IO () +testCommunityWithoutNames = + namesRefusal [] (communityLines ["bakers = " <> bakersText]) `shouldReturn` "[community] is set but [names] is absent, so nothing would use it" + +testRepeatedHeader :: IO () +testRepeatedHeader = do + refusedCommunity ["bakers = " <> bakersText, "[community]", "florists = florists in Lisbon"] + `shouldReturn` "[community] is written twice, and only the last of them would be read" + namesRefusal (namesSection <> chainSection <> namesSection) [] `shouldReturn` "[names] is written twice, and only the last of them would be read" + namesRefusal namesSection (chainSection <> ["[legacy]", "a = 1", " [ legacy ] "]) `shouldReturn` "[legacy] is written twice, and only the last of them would be read" + +testRepeatedKey :: IO () +testRepeatedKey = do + refusedCommunity ["bakers = " <> bakersText, "florists = florists in Lisbon", "bakers = bakers of Porto"] + `shouldReturn` "community.bakers is written twice, and only the first of them would be read" + namesRefusal (namesSection <> ["terms_version = 2026-11-01"]) chainSection + `shouldReturn` "names.terms_version is written twice, and only the first of them would be read" + +testBadLabel :: IO () +testBadLabel = do + forM_ ["Bakers", "bak--ers", "bakers-", "bak_ers", "bäkers"] $ \l -> + refusedCommunity [l <> " = " <> bakersText] `shouldReturn` ("community." <> T.unpack l <> " must be lower-case letters and digits, with single hyphens between them") + forM_ ["baker", T.replicate 64 "a"] $ \l -> + refusedCommunity [l <> " = " <> bakersText] `shouldReturn` ("community." <> T.unpack l <> " must be 6 to 63 characters") + +testBadText :: IO () +testBadText = do + let badLength = "community.bakers must be 1 to 200 characters" + invisible = "community.bakers has a control, format or line separator character" + refusedCommunity ["bakers ="] `shouldReturn` badLength + refusedCommunity ["bakers = " <> T.replicate 201 "a"] `shouldReturn` badLength + forM_ ["bakers\tand bakeries", "bakers \ESC[31m", "bakers\DEL"] $ \t -> + refusedCommunity ["bakers = " <> t] `shouldReturn` invisible + -- right-to-left override and zero-width space (format), line and paragraph separators + forM_ ["bakers \x202E and bakeries", "bakers\x200B and bakeries", "bakers\x2028 and bakeries", "bakers\x2029 and bakeries"] $ \t -> + refusedCommunity ["bakers = " <> t] `shouldReturn` invisible + NamesConfig {nCommunity} <- withCommunity ["bakers = " <> T.replicate 200 "é"] + M.elems nCommunity `shouldBe` [T.replicate 200 "é"] + +testBadTerms :: IO () +testBadTerms = do + let without k = filter (not . (k `T.isPrefixOf`)) namesSection + withValue k v = without k <> [k <> " = " <> v] + badVersion = "names.terms_version must be 1 to 32 letters, digits, dots, underscores or hyphens" + badUrl = "names.terms_url must be an https URL" + namesRefusal (without "terms_version") chainSection `shouldReturn` "names.terms_version is required" + namesRefusal (withValue "terms_version" "") chainSection `shouldReturn` "names.terms_version is required" + forM_ ["2026/10/23", "2026 10 23", "v1+2", "версия", T.replicate 33 "a"] $ \v -> + namesRefusal (withValue "terms_version" v) chainSection `shouldReturn` badVersion + NamesConfig {nTerms = TermsConfig {tVersion}} <- parsedNames (withValue "terms_version" ("Az09._-" <> T.replicate 25 "a")) chainSection + tVersion `shouldBe` "Az09._-" <> T.replicate 25 "a" + namesRefusal (without "terms_url") chainSection `shouldReturn` "names.terms_url is required" + forM_ ["http://simplex.chat/terms", "simplex.chat/terms", "https://", "https://simplex.chat/name terms", "HTTPS://simplex.chat/terms"] $ \u -> + namesRefusal (withValue "terms_url" u) chainSection `shouldReturn` badUrl + +testNoUnknownKeys :: IO () +testNoUnknownKeys = + withIni (namesIni namesSection (chainSection <> communityLines ["bakers = " <> bakersText, "florists = florists in Lisbon"])) $ \p -> do + Right ini <- readIniFile p + unknownKeys ini `shouldBe` [] + +testLoadedCount :: IO () +testLoadedCount = do + listed <- capturingStderr $ void $ parseIni (namesIni namesSection (chainSection <> communityLines ["bakers = " <> bakersText, "florists = florists in Lisbon"])) + listed `shouldSatisfy` T.isInfixOf "names: 2 community names loaded" + none <- capturingStderr $ void $ parseIni (namesIni namesSection chainSection) + none `shouldSatisfy` T.isInfixOf "names: 0 community names loaded" + +testTermsFor :: IO () +testTermsFor = do + cfg <- withCommunity ["bakers = " <> bakersText] + termsFor cfg (labelHash "bakers") `shouldBe` termsVersion <> "/community" + termsFor cfg aliceHash `shouldBe` termsVersion diff --git a/tests/Bots/StoreService/NamesOrdersTests.hs b/tests/Bots/StoreService/NamesOrdersTests.hs index 8ad51262a1..53a02bed8b 100644 --- a/tests/Bots/StoreService/NamesOrdersTests.hs +++ b/tests/Bots/StoreService/NamesOrdersTests.hs @@ -37,6 +37,7 @@ module Bots.StoreService.NamesOrdersTests ) where +import Bots.StoreService.ConfigTests (termsUrl, termsVersion) import Bots.StoreService.FakeBTCPay (FakeBTCPay (..), setInvoiceState, withFakeBTCPay) import Bots.StoreService.FakeEthNode import Bots.StoreService.NamesContractsTests (alice, answerRegistered, answerRegistrar, nameExpiresCall, noncesCall, registrarOf, rentPriceAnswer, rentPriceCall, reservedNamesCall, unhex) @@ -60,6 +61,7 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy.Char8 as LB import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef) import Data.List (sort) +import qualified Data.Map.Strict as M import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T @@ -82,7 +84,7 @@ import Simplex.Messaging.Eth.Address (Address) import Simplex.Messaging.Eth.EIP712 (serializeSignature) import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD (..), labelHash) import Simplex.Messaging.Util (safeDecodeUtf8, tshow) -import StoreService.Config (ChainConfig (..), NamesConfig (..), ServiceConfig (..)) +import StoreService.Config (ChainConfig (..), NamesConfig (..), ServiceConfig (..), TermsConfig (..)) import StoreService.Names.Abi (hex, uint256) import StoreService.Names.Chain (newChainClient) import StoreService.Names.Contracts (newContracts) @@ -292,7 +294,17 @@ data Ctx = Ctx testNamesConfig :: FakeEthNode -> NamesConfig testNamesConfig node = - NamesConfig {nTLD = TLDSimplex, nYears = 2, nTermStart = termStart, nTermSlackSeconds = slackSeconds, nRevealMarginSeconds = 900, nMaxOrderMoves = 3, nChain = fakeChainConfig node} + NamesConfig + { nTLD = TLDSimplex, + nYears = 2, + nTermStart = termStart, + nTermSlackSeconds = slackSeconds, + nRevealMarginSeconds = 900, + nMaxOrderMoves = 3, + nTerms = TermsConfig {tVersion = termsVersion, tUrl = termsUrl}, + nCommunity = M.empty, + nChain = fakeChainConfig node + } -- | Each invoice the stub creates gets its own provider ref, and a card invoice its client secret. freshRefs :: IORef Int -> Provider -> Provider diff --git a/tests/Bots/StoreService/NamesSearchTests.hs b/tests/Bots/StoreService/NamesSearchTests.hs index 291bce6568..662331da74 100644 --- a/tests/Bots/StoreService/NamesSearchTests.hs +++ b/tests/Bots/StoreService/NamesSearchTests.hs @@ -6,6 +6,7 @@ module Bots.StoreService.NamesSearchTests (namesSearchTests, aliceHex) where +import Bots.StoreService.ConfigTests (termsUrl, termsVersion) import Bots.StoreService.FakeEthNode import Bots.StoreService.NamesContractsTests ( answerRegistered, @@ -36,6 +37,7 @@ import qualified Data.Aeson as J import qualified Data.Aeson.Types as JT import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LB +import qualified Data.Map.Strict as M import Data.Maybe (fromJust, fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -51,7 +53,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String (strEncode) import Simplex.Messaging.SimplexName (SimplexTLD (..)) import Simplex.Messaging.Transport.Client (TransportHost (..)) -import StoreService.Config (ListenerConfig (..), NamesConfig (..)) +import StoreService.Config (ListenerConfig (..), NamesConfig (..), TermsConfig (..)) import StoreService.Names.Abi (AbiValue (..), abiBytes, abiTuple, uint256) import StoreService.Names.Contracts (Contracts (..)) import StoreService.Names.Phases (RegistrationId (..)) @@ -115,6 +117,8 @@ namesConfig node = nTermSlackSeconds = 3600, nRevealMarginSeconds = 900, nMaxOrderMoves = 3, + nTerms = TermsConfig {tVersion = termsVersion, tUrl = termsUrl}, + nCommunity = M.empty, nChain = fakeChainConfig node } diff --git a/tests/Test.hs b/tests/Test.hs index a79265dbd5..0391d7fc93 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -14,6 +14,7 @@ import Bots.StoreService.NamesBalancesTests import Bots.StoreService.NamesLateCreditTests import Bots.StoreService.NamesChainTests import Bots.StoreService.NamesCodesTests +import Bots.StoreService.NamesCommunityTests import Bots.StoreService.NamesContractsTests import Bots.StoreService.NamesLabelTests import Bots.StoreService.NamesLinksTests @@ -111,6 +112,7 @@ main = do namesLateCreditTests namesChainTests namesCodesTests + namesCommunityTests namesContractsTests namesLabelTests namesLinksTests