store: merge the community list and terms

apps/simplex-store-service/README.md

@@ -120,7 +120,11 @@ Other options:
 section (omitting it disables card payments), an optional `[group]` section (omitting it
 turns off the group's commands, though a group created earlier still has its code messages updated),
 the poll cadence, and optional `[names]` and `[chain]` sections for the names store (omitting both
-turns it off), whose `[chain] service_key` is [the gas key](#the-gas-key).
+turns it off), whose `[chain] service_key` is [the gas key](#the-gas-key). `[names]` requires
+`terms_version` and `terms_url`, and an optional `[community]` section lists the community names
+(see [Terms and community names](#terms-and-community-names)). Write every setting as
+`key = value`: the parser also reads `key: value`, but drops the first character of its value. A
+key written twice in one section, or a section header written twice, stops the service at startup.
 `store_service.ini.example` is the committed template; `store_service.ini` itself is
 gitignored, since a real one holds API keys and webhook secrets.
 
@@ -493,6 +497,36 @@ docker compose exec store-service bash -c ': </dev/tcp/<gateway>/443'
 adds for that user or network, then the chain, in `iptables` and `ip6tables`. Running it again
 changes nothing, and `--check` then reports the chain absent.
 
+### Terms and community names
+
+`[names]` needs two settings, with no default:
+
+- `terms_version`: the version of the name terms buyers agree to, 1 to 32 letters, digits, dots,
+  underscores or hyphens, such as `2026-10-23`. Change it whenever the terms change.
+- `terms_url`: the `https://` page of those terms, which the order's checkbox links to.
+
+**Upgrading:** an ini written before these settings existed stops the service at startup until both
+are added under `[names]`.
+
+`[community]` lists the community names, one line per name: the label, as it is searched, then `=`
+and what the name is for:
+
+```
+[community]
+bakers = bakers and bakeries in Portugal
+```
+
+Search answers and the registration view carry a listed name's text, which the page shows with the
+name as a community name. Each label must be a valid name in lower case and listed once; each text is
+1 to 200 characters with no control, format or line separator characters, and should not end with a
+full stop, since the page adds one. The service refuses to start, naming the setting, on any other
+entry, on `[community]` without `[names]`, on a key written twice in a section (only the first would
+be read) and on a section header written twice in the file (only the last would be read). It logs
+how many community names it loaded.
+
+Both the terms and the list are read only at startup, so an edit applies after a restart. After a
+restart, search each listed name on the names site and check that it shows as a community name.
+
 ### The gas key
 
 `[chain] service_key` is the registrar key: an Ethereum account (EOA) that sends every names
@@ -503,10 +537,10 @@ names.
 
 The commands run from `scripts/store-service/` on the service host, with Foundry's `cast`
 ([getfoundry.sh](https://getfoundry.sh), checked with 1.5.1) and `jq`. They read the ini through this
-shell function, which takes a key's value without surrounding spaces, tabs or a CR:
+shell function, which takes a `[chain]` key's value without surrounding spaces, tabs or a CR:
 
 ```
-ini() { sudo sed -n "s/^$1[[:space:]]*=[[:space:]]*\([^[:space:]]*\).*/\1/p" "${2:-store_service.ini}"; }
+ini() { sudo sed -n "/^\[chain\]/,/^\[/s/^$1[[:space:]]*=[[:space:]]*\([^[:space:]]*\).*/\1/p" "${2:-store_service.ini}"; }
 ```
 
 Keys and the RPC URL are read through `ini`, so they stay out of the shell history. A key is in
@@ -940,6 +974,8 @@ payment against this service in Chromium, as they run against the webapp's mock.
    age of 5 seconds;
 2. builds the names site (`vite build`) into the run's folder;
 3. writes an ini for that deployment with `[names]` and `[chain]` and no `[btcpay]` or `[stripe]`,
+   with the terms version `2026-10-23` and the one community name `bakers`, which the webapp's
+   community case searches for,
    serving the names site all in one on the host `127.0.0.1`, and signing with the test suite's
    public issuer secret (`issuerSecret` in `tests/Bots/StoreService/ConfigTests.hs`), trusted through
    `[issuer] dev_keys`. That secret is public: never use it outside this script;

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)

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]

apps/simplex-store-service/src/StoreService/Names/View.hs

@@ -34,6 +34,7 @@ import Simplex.Messaging.Util (safeDecodeUtf8)
 import StoreService.Config (ChainConfig (..), NamesConfig (..))
 import StoreService.Names.Abi (hex)
 import StoreService.Names.Chain (TxHash (..))
+import StoreService.Names.Community (communityJSON)
 import StoreService.Names.Contracts (Contracts, sponsorNonce)
 import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Store (Balance (..), BalanceHold (..), LateWait (..), NamePhase (..), NameRegistration (..), NameReveal (..), RegistrationPayment (..), getBalance, getRegistration, heldBy, lateWait)
@@ -67,7 +68,7 @@ readViewChain ct NameRegistration {nrPhase, nrOwner} = case nrPhase of
     none = ViewReads {vrIntentNonce = Nothing, vrUnread = []}
 
 viewJSON :: NamesConfig -> NameRegistration -> Maybe Balance -> Maybe LateWait -> ViewReads -> J.Value
-viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r balance late ViewReads {vrIntentNonce, vrUnread} =
+viewJSON cfg@NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}} r balance late ViewReads {vrIntentNonce, vrUnread} =
   J.object
     [ "id" .= rid,
       "version" .= nrVersion,
@@ -96,7 +97,8 @@ viewJSON NamesConfig {nTLD, nChain = ChainConfig {cChainId, cResolver, cSponsor}
       "intentNonce" .= vrIntentNonce,
       "unread" .= vrUnread,
       "expiresAt" .= nrExpiresAt,
-      "error" .= nrError
+      "error" .= nrError,
+      "community" .= communityJSON cfg (nrLabelHash r)
     ]
   where
     NameRegistration {nrId = RegistrationId rid, nrVersion, nrMoves, nrLinksRefusedAt, nrPhase, nrLabelHash = LabelHash lh, nrReveal, nrOwner, nrCommitment, nrSealed} = r

apps/simplex-store-service/src/StoreService/Web/Names/Search.hs

@@ -26,6 +26,7 @@ import Simplex.Messaging.Util (tshow)
 import StoreService.Config (ChainConfig (..), NamesConfig (..))
 import StoreService.Log (logWarn)
 import StoreService.Names.Abi (bytes32FromHex)
+import StoreService.Names.Community (communityJSON, termsJSON)
 import StoreService.Names.Contracts
 import StoreService.Names.Links (LinkKind (..), linkKindOf)
 import StoreService.Names.Profiles (Entity, Profiles, linkEntity, linkPreview)
@@ -51,7 +52,7 @@ searchHandler cfg@NamesConfig {nYears} st ct ps hashText req respond = case Labe
     Just len -> do
       registering <- withTransaction st (`isLabelRegistering` lh)
       timeout (ctDeadline ct) (runExceptT $ found lh len registering) >>= \case
-        Just (Right f) -> respond =<< searchAnswer cfg ps f
+        Just (Right f) -> respond =<< searchAnswer cfg ps lh f
         Just (Left e) -> unavailable $ tshow e
         Nothing -> unavailable "timed out"
   where
@@ -76,13 +77,14 @@ queryLength req = case join $ lookup "length" $ queryString req of
       | n >= toInteger minNameLength && n <= toInteger maxNameLength = Just $ fromInteger n
       | otherwise = Nothing
 
-searchAnswer :: NamesConfig -> Profiles -> Found -> IO Response
-searchAnswer NamesConfig {nTLD, nYears, nTermStart, nChain = ChainConfig {cChainId, cResolver, cSponsor}} ps = \case
+searchAnswer :: NamesConfig -> Profiles -> LabelHash -> Found -> IO Response
+searchAnswer cfg@NamesConfig {nTLD, nYears, nTermStart, nChain = ChainConfig {cChainId, cResolver, cSponsor}} ps lh = \case
   FAvailable price ->
     ok $
       ["status" .= ("available" :: Text), "price" .= price, "currency" .= ("usd" :: Text), "years" .= nYears, "termStart" .= termStart]
         <> ["resolver" .= addressText cResolver, "sponsor" .= addressText cSponsor]
         <> chain
+        <> ["terms" .= termsJSON cfg]
   FRegistering -> ok ["status" .= ("registered" :: Text), "entities" .= ([] :: [Entity]), "tld" .= tldText nTLD]
   FReserved -> ok ["status" .= ("reserved" :: Text)]
   FRegistered RegisteredName {rnOwner, rnResolver, rnExpiresAt, rnGracePeriod} records_ -> do
@@ -94,7 +96,7 @@ searchAnswer NamesConfig {nTLD, nYears, nTermStart, nChain = ChainConfig {cChain
         <> chain
   where
     ok :: [JT.Pair] -> IO Response
-    ok = pure . jsonResponse status200 . J.object
+    ok fields = pure $ jsonResponse status200 $ J.object $ fields <> ["community" .= communityJSON cfg lh]
     chain = ["chainId" .= cChainId, "tld" .= tldText nTLD]
     termStart = floor (utcTimeToPOSIXSeconds nTermStart) :: Integer
     recordsJSON NameRecords {rdContact, rdChannel} = J.object ["contact" .= rdContact, "channel" .= rdChannel]

apps/simplex-store-service/store_service.ini.example

@@ -70,6 +70,10 @@ idle_seconds = 60
 ;[names]
 ; testing until the .simplex TLD is deployed
 ;tld = testing
+; the version of the name terms buyers agree to (1 to 32 letters, digits, dots, underscores or
+; hyphens), and the page the order's checkbox links to; both required, read only at startup
+;terms_version = 2026-10-23
+;terms_url = https://simplex.chat/
 ; the paid years of a name; at least 2, the controller's minimum
 ;years = 2
 ; a name's term starts here; the days until then are free
@@ -81,6 +85,12 @@ idle_seconds = 60
 ; how many times one order may move to another name
 ;max_order_moves = 3
 ;
+; community names, with [names] only: one line per name, `<label> = <what it is for>`, the label in
+; lower case and listed once, the text 1 to 200 characters without a full stop at the end, which
+; the page adds; read only at startup, see apps/simplex-store-service/README.md
+;[community]
+;bakers = bakers and bakeries in Portugal
+;
 ; the chain the names are registered on. rpc_url can carry a provider's API key and service_key
 ; pays for every commit and register: keep both secret. Neither is ever logged.
 ;[chain]

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

scripts/store-service/store_service.ini.example

@@ -62,6 +62,10 @@ private_key = replace-me
 ;[names]
 ; testing until the .simplex TLD is deployed
 ;tld = testing
+; the version of the name terms buyers agree to (1 to 32 letters, digits, dots, underscores or
+; hyphens), and the page the order's checkbox links to; both required, read only at startup
+;terms_version = 2026-10-23
+;terms_url = https://simplex.chat/
 ; the paid years of a name; at least 2, the controller's minimum
 ;years = 2
 ; a name's term starts here; the days until then are free
@@ -73,6 +77,12 @@ private_key = replace-me
 ; how many times one order may move to another name
 ;max_order_moves = 3
 ;
+; community names, with [names] only: one line per name, `<label> = <what it is for>`, the label in
+; lower case and listed once, the text 1 to 200 characters without a full stop at the end, which
+; the page adds; read only at startup, see apps/simplex-store-service/README.md
+;[community]
+;bakers = bakers and bakeries in Portugal
+;
 ; the chain the names are registered on. rpc_url can carry a provider's API key and service_key
 ; pays for every commit and register: keep both secret. Neither is ever logged.
 ;[chain]

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

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)

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

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)
@@ -173,6 +175,7 @@ namesOrdersTests = describe "StoreService names: orders" $ do
     it "agrees between the sweep and the overdue close on which invoices hold money" testFundedAgreement
   describe "registration view" $ do
     it "has the contract's fields" testViewFields
+    it "has the community entry of its label hash, null for an unlisted name" testViewCommunity
     it "reads the intent nonce in committed and nothing in taken" testViewReads
     it "leaves a failed intentNonce read null and named in unread, reading nothing in taken" testViewUnread
     it "reads the order's balance, held until its holder's invoice expires and free past it, and the cents its order took from another's" testViewBalance
@@ -292,7 +295,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
@@ -1361,12 +1374,12 @@ testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do
   sort (KM.keys v)
     `shouldBe` sort
       [ "id", "version", "moves", "linksRefused", "phase", "labelHash", "label", "owner", "commitment", "sealed", "resolver", "sponsor", "chainId", "tld",
-        "years", "duration", "price", "fromBalance", "balance", "latePayment", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error"
+        "years", "duration", "price", "fromBalance", "balance", "latePayment", "commitTx", "registerTx", "revealAfter", "revealBefore", "intentNonce", "unread", "expiresAt", "error", "community"
       ]
   field "latePayment" v `shouldBe` Just J.Null
   let waiting w = field "latePayment" $ objectOf $ viewJSON (testNamesConfig node) r Nothing (Just w) ViewReads {vrIntentNonce = Nothing, vrUnread = []}
   map waiting [LWConfirming, LWCrediting, LWSupport] `shouldBe` map (\t -> Just $ J.object ["waiting" .= (t :: Text)]) ["confirming", "crediting", "support"]
-  map (`field` v) ["id", "phase", "owner", "tld", "chainId", "linksRefused", "label", "unread", "sponsor", "fromBalance", "balance"]
+  map (`field` v) ["id", "phase", "owner", "tld", "chainId", "linksRefused", "label", "unread", "sponsor", "fromBalance", "balance", "community"]
     `shouldBe` map
       Just
       [ "r1",
@@ -1379,9 +1392,21 @@ testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do
         J.Array mempty,
         J.String $ safeDecodeUtf8 $ strEncode fakeSponsor,
         J.Number 0,
+        J.Null,
         J.Null
       ]
 
+testViewCommunity :: IO ()
+testViewCommunity = withServiceStore $ \st -> withFakeEthNode $ \node -> do
+  Right () <- placePaid st "r1" ownerA (order "alicebakery" 1) (addUTCTime 3600 t0)
+  r <- withTransaction st $ \db -> fromJust <$> getRegistration db (RegistrationId "r1")
+  let LabelHash aliceHash = labelHash "alicebakery"
+      listing :: [(ByteString, Text)] -> Maybe J.Value
+      listing entries = field "community" $ objectOf $ viewJSON (testNamesConfig node) {nCommunity = M.fromList entries} r Nothing Nothing ViewReads {vrIntentNonce = Nothing, vrUnread = []}
+  listing [(aliceHash, "bakers and bakeries in Lisbon")] `shouldBe` Just (J.object ["for" .= ("bakers and bakeries in Lisbon" :: Text)])
+  let LabelHash bobHash = labelHash "bobsbakery"
+  listing [(bobHash, "bakers of Porto")] `shouldBe` Just J.Null
+
 testViewReads :: IO ()
 testViewReads = withServiceStore $ \st -> withFakeEthNode $ \node -> do
   g <- C.newRandom

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,
@@ -33,9 +34,11 @@ import Control.Monad (forM_, replicateM_)
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson ((.=))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.KeyMap as KM
 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,8 +54,8 @@ 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.Names.Abi (AbiValue (..), abiBytes, abiTuple, uint256)
+import StoreService.Config (ListenerConfig (..), NamesConfig (..), TermsConfig (..))
+import StoreService.Names.Abi (AbiValue (..), abiBytes, abiTuple, bytes32FromHex, uint256)
 import StoreService.Names.Contracts (Contracts (..))
 import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Profiles (ChatKind (..), HostResolver, LinkProfile (..), ProfileFetcher, ProfileLimits (..), defaultProfileLimits, monotonicSeconds, newProfiles)
@@ -70,6 +73,7 @@ namesSearchTests = describe "StoreService names: search" $ do
     it "answers a reserved name" $ testReserved g
     it "answers a name the chain has available as registered while its register here is sent, without a price" $ testRegistering g
     it "answers a registered name with its entities, raw records, owner, resolver, nonce, expiry and grace period" $ testRegistered g
+    it "answers a listed name's community entry when available, reserved, being registered here and registered" $ testCommunity g
     it "makes one entity per short link of its record's kind, splitting on ';', and none from other values" $ testRecordLinks g
     it "makes entities of the first 5 short links of a record only, fetching no other" $ testRecordLinksCap g
     it "reads no records from another resolver" $ testOtherResolver g
@@ -92,12 +96,12 @@ namesSearchTests = describe "StoreService names: search" $ do
 data Search = Search {node :: FakeEthNode, store :: DBStore, client :: (Manager, String), fetched :: TVar [Text]}
 
 -- | The routes as namesRoutes registers them, since a NamesEnv needs a running chat controller.
-withSearch :: TVar ChaChaDRG -> (Contracts -> Contracts) -> (Search -> IO a) -> IO a
-withSearch g adjust action = withServiceStore $ \store -> withContracts g $ \node ct -> do
+withSearch :: TVar ChaChaDRG -> (NamesConfig -> NamesConfig) -> (Contracts -> Contracts) -> (Search -> IO a) -> IO a
+withSearch g adjustConfig adjust action = withServiceStore $ \store -> withContracts g $ \node ct -> do
   fetched <- newTVarIO []
   ps <- newProfiles defaultProfileLimits {fetchTimeout = fetchMicros} monotonicSeconds (fakeFetch fetched) stubResolver
   http <- newHttpEnv ListenerConfig {lHost = "127.0.0.1", lPort = 0, lStaticDir = "", lServeWebapp = False, lWebappExportDir = Nothing, lTrustForwardedFor = False, lNamesStaticDir = Nothing, lNamesExportDir = Nothing, lNamesHosts = []}
-  let cfg = namesConfig node
+  let cfg = adjustConfig $ namesConfig node
       routes = \case
         ["api", "link", "preview"] -> Just Route {rMethod = "POST", rLimit = previewLimit, rHandler = previewHandler ps}
         ["api", "name", hash] -> Just Route {rMethod = "GET", rLimit = searchLimit, rHandler = searchHandler cfg store (adjust ct) ps hash}
@@ -115,9 +119,26 @@ namesConfig node =
       nTermSlackSeconds = 3600,
       nRevealMarginSeconds = 900,
       nMaxOrderMoves = 3,
+      nTerms = TermsConfig {tVersion = termsVersion, tUrl = termsUrl},
+      nCommunity = M.empty,
       nChain = fakeChainConfig node
     }
 
+aliceCommunity :: Text
+aliceCommunity = "bakers and bakeries in Lisbon"
+
+listAlice :: NamesConfig -> NamesConfig
+listAlice cfg = cfg {nCommunity = M.singleton (fromJust $ bytes32FromHex aliceHex) aliceCommunity}
+
+-- | The answer as it reads for a name on the community list.
+listed :: Answer -> Answer
+listed (status, answer) = (status, withEntry <$> answer)
+  where
+    withEntry :: J.Value -> J.Value
+    withEntry = \case
+      J.Object o -> J.Object $ KM.insert "community" (J.object ["for" .= aliceCommunity]) o
+      v -> v
+
 fetchMicros :: Int
 fetchMicros = 500000
 
@@ -234,7 +255,9 @@ availableAnswer price =
       "resolver" .= resolverText,
       "sponsor" .= sponsorText,
       "chainId" .= fakeChainId,
-      "tld" .= str "simplex"
+      "tld" .= str "simplex",
+      "community" .= J.Null,
+      "terms" .= J.object ["version" .= termsVersion, "url" .= termsUrl]
     ]
 
 registeredAnswer :: [J.Value] -> J.Value -> Text -> J.Value -> Answer
@@ -249,9 +272,14 @@ registeredAnswer entities records resolver nonce =
       "expiresAt" .= (now + year),
       "gracePeriod" .= gracePeriod,
       "chainId" .= fakeChainId,
-      "tld" .= str "simplex"
+      "tld" .= str "simplex",
+      "community" .= J.Null
     ]
 
+reservedAnswer, registeringAnswer :: Answer
+reservedAnswer = ok ["status" .= str "reserved", "community" .= J.Null]
+registeringAnswer = ok ["status" .= str "registered", "entities" .= ([] :: [J.Value]), "tld" .= str "simplex", "community" .= J.Null]
+
 recordsOf :: Text -> Text -> J.Value
 recordsOf contact channel = J.object ["contact" .= contact, "channel" .= channel]
 
@@ -299,7 +327,7 @@ setPhase st phase = withTransaction st $ \db -> do
 -- search
 
 testAvailable :: TVar ChaChaDRG -> IO ()
-testAvailable g = withSearch g id $ \s@Search {node} -> do
+testAvailable g = withSearch g id id $ \s@Search {node} -> do
   available node
   answerCall node fakeController (rentPriceCall 12) $ Returns $ rentPriceAnswer 10000
   answerCall node fakeController (rentPriceCall 6) $ Returns $ rentPriceAnswer 40000
@@ -307,24 +335,24 @@ testAvailable g = withSearch g id $ \s@Search {node} -> do
   searchAlice s 6 `shouldReturn` availableAnswer 40000
 
 testReserved :: TVar ChaChaDRG -> IO ()
-testReserved g = withSearch g id $ \s@Search {node} -> do
+testReserved g = withSearch g id id $ \s@Search {node} -> do
   reserved node
-  searchAlice s 12 `shouldReturn` ok ["status" .= str "reserved"]
+  searchAlice s 12 `shouldReturn` reservedAnswer
 
 testRegistering :: TVar ChaChaDRG -> IO ()
-testRegistering g = withSearch g id $ \s@Search {node, store} -> do
+testRegistering g = withSearch g id id $ \s@Search {node, store} -> do
   available node
   code <- issue store 1 usable
   placeCode store "r1" ownerA (order "alicebakery" 1) code `shouldReturn` Right ()
   setPhase store PRegistering
   -- no price is answered, so reading one would fail the search
-  searchAlice s 12 `shouldReturn` ok ["status" .= str "registered", "entities" .= ([] :: [J.Value]), "tld" .= str "simplex"]
+  searchAlice s 12 `shouldReturn` registeringAnswer
   setPhase store PRegistered
   answerCall node fakeController (rentPriceCall 12) $ Returns $ rentPriceAnswer 10000
   searchAlice s 12 `shouldReturn` availableAnswer 10000
 
 testRegistered :: TVar ChaChaDRG -> IO ()
-testRegistered g = withSearch g id $ \s@Search {node} -> do
+testRegistered g = withSearch g id id $ \s@Search {node} -> do
   registeredWith node bakeryLink newsLink
   searchAlice s 12
     `shouldReturn` registeredAnswer
@@ -335,8 +363,23 @@ testRegistered g = withSearch g id $ \s@Search {node} -> do
       resolverText
       (J.toJSON (0 :: Int))
 
+testCommunity :: TVar ChaChaDRG -> IO ()
+testCommunity g = withSearch g listAlice id $ \s@Search {node, store} -> do
+  available node
+  answerCall node fakeController (rentPriceCall 12) $ Returns $ rentPriceAnswer 10000
+  searchAlice s 12 `shouldReturn` listed (availableAnswer 10000)
+  reserved node
+  searchAlice s 12 `shouldReturn` listed reservedAnswer
+  available node
+  code <- issue store 1 usable
+  placeCode store "r1" ownerA (order "alicebakery" 1) code `shouldReturn` Right ()
+  setPhase store PRegistering
+  searchAlice s 12 `shouldReturn` listed registeringAnswer
+  registeredWith node fullLink ""
+  searchAlice s 12 `shouldReturn` listed (registeredAnswer [] (recordsOf fullLink "") resolverText (J.toJSON (0 :: Int)))
+
 testRecordLinks :: TVar ChaChaDRG -> IO ()
-testRecordLinks g = withSearch g id $ \s@Search {node} -> do
+testRecordLinks g = withSearch g id id $ \s@Search {node} -> do
   let botLink = taggedLink "smp8.simplex.im" 'a' "Bot"
       contact = bakeryLink <> ";" <> botLink <> " ; " <> newsLink <> ";" <> fullLink <> ";;"
       channel = " " <> newsLink <> ";" <> bakeryLink <> ";hello"
@@ -349,7 +392,7 @@ testRecordLinks g = withSearch g id $ \s@Search {node} -> do
   searchAlice s 12 `shouldReturn` registeredAnswer [] (recordsOf fullLink "") resolverText (J.toJSON (0 :: Int))
 
 testRecordLinksCap :: TVar ChaChaDRG -> IO ()
-testRecordLinksCap g = withSearch g id $ \s@Search {node} -> do
+testRecordLinksCap g = withSearch g id id $ \s@Search {node} -> do
   let contacts = map (\n -> taggedLink "smp8.simplex.im" 'a' ("Bot" <> T.pack (show n))) [1 .. 7 :: Int]
   -- a value of another kind first, so the cap counts only the record's own links
   registeredWith node (T.intercalate ";" $ newsLink : contacts) newsLink
@@ -359,13 +402,13 @@ testRecordLinksCap g = withSearch g id $ \s@Search {node} -> do
   length . filter (T.isInfixOf "#Bot") <$> fetchedLinks s `shouldReturn` 5
 
 testOtherResolver :: TVar ChaChaDRG -> IO ()
-testOtherResolver g = withSearch g id $ \s@Search {node} -> do
+testOtherResolver g = withSearch g id id $ \s@Search {node} -> do
   nameState node (toInteger $ now + year) 0
   answerRegistered node otherResolver
   searchAlice s 12 `shouldReturn` registeredAnswer [] J.Null otherResolverText J.Null
 
 testEntityProfiles :: TVar ChaChaDRG -> IO ()
-testEntityProfiles g = withSearch g id $ \s@Search {node} -> do
+testEntityProfiles g = withSearch g id id $ \s@Search {node} -> do
   let gone = taggedLink "smp8.simplex.im" 'a' "Gone"
       privateName = taggedLink "private.test" 'a' "Y8m3"
       privateLiteral = taggedLink "10.0.0.1" 'c' "Rk27"
@@ -384,7 +427,7 @@ testEntityProfiles g = withSearch g id $ \s@Search {node} -> do
     deepLinkAt host kind tag = "simplex:/" <> T.singleton kind <> "#" <> snd (T.breakOnEnd "#" $ taggedLink host kind tag) <> "?h=" <> host
 
 testFailedReads :: TVar ChaChaDRG -> IO ()
-testFailedReads g = withSearch g id $ \s@Search {node} -> do
+testFailedReads g = withSearch g id id $ \s@Search {node} -> do
   let unavailable = refused 503 "provider_unavailable"
   available node
   searchAlice s 12 `shouldReturn` unavailable
@@ -406,7 +449,7 @@ testFailedReads g = withSearch g id $ \s@Search {node} -> do
 
 -- | Each slow read takes 40% of the deadline: the status's two concurrent rounds meet it, the records' third round passes it.
 testOneDeadline :: TVar ChaChaDRG -> IO ()
-testOneDeadline g = withSearch g (\ct -> ct {ctDeadline = deadline}) $ \s@Search {node} -> do
+testOneDeadline g = withSearch g id (\ct -> ct {ctDeadline = deadline}) $ \s@Search {node} -> do
   registeredWith node bakeryLink newsLink
   -- reads the registrar's constants, which a running service has read once
   fst <$> searchAlice s 12 `shouldReturn` 200
@@ -420,7 +463,7 @@ testOneDeadline g = withSearch g (\ct -> ct {ctDeadline = deadline}) $ \s@Search
     deadline = 2000000
 
 testBadHash :: TVar ChaChaDRG -> IO ()
-testBadHash g = withSearch g id $ \s -> do
+testBadHash g = withSearch g id id $ \s -> do
   let hexDigits = T.drop 2 aliceHex
   forM_ [T.toUpper aliceHex, "0x" <> T.toUpper hexDigits, hexDigits, "0x" <> T.drop 1 hexDigits, aliceHex <> "0", "0x" <> T.replicate 64 "g", "0X" <> hexDigits] $ \h ->
     (h, searchName s h "?length=12") `shouldReturnPair` refused 400 "bad_request"
@@ -429,15 +472,15 @@ testBadHash g = withSearch g id $ \s -> do
     shouldReturnPair (h, act) expected = act >>= \a -> (h, a) `shouldBe` (h, expected)
 
 testBadLength :: TVar ChaChaDRG -> IO ()
-testBadLength g = withSearch g id $ \s@Search {node} -> do
+testBadLength g = withSearch g id id $ \s@Search {node} -> do
   reserved node
   forM_ ["?length=5", "?length=64", "", "?length=", "?length", "?length=abc", "?length=6.0", "?length=%2B7", "?length=-6", "?length=%207", "?length=0x6", "?length=18446744073709551622"] $ \q ->
     searchName s aliceHex q >>= \a -> (q, a) `shouldBe` (q, refused 400 "invalid_name")
   forM_ ["?length=6", "?length=63", "?length=007"] $ \q ->
-    searchName s aliceHex q >>= \a -> (q, a) `shouldBe` (q, ok ["status" .= str "reserved"])
+    searchName s aliceHex q >>= \a -> (q, a) `shouldBe` (q, reservedAnswer)
 
 testSearchLimit :: TVar ChaChaDRG -> IO ()
-testSearchLimit g = withSearch g id $ \s -> do
+testSearchLimit g = withSearch g id id $ \s -> do
   replicateM_ 30 $ searchName s "0x00" "?length=12" `shouldReturn` refused 400 "bad_request"
   r <- send s ("/api/name/" <> T.unpack aliceHex <> "?length=12") id
   answerOf r `shouldBe` refused 429 "rate_limited"
@@ -449,7 +492,7 @@ testSearchLimit g = withSearch g id $ \s -> do
 -- link preview
 
 testPreviewKinds :: TVar ChaChaDRG -> IO ()
-testPreviewKinds g = withSearch g id $ \s -> do
+testPreviewKinds g = withSearch g id id $ \s -> do
   previewOf s bakeryLink `shouldReturn` ok bakeryChat
   previewOf s newsLink `shouldReturn` ok newsChat
   previewOf s "simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA?h=smp9.simplex.im" `shouldReturn` ok newsChat
@@ -457,7 +500,7 @@ testPreviewKinds g = withSearch g id $ \s -> do
   previewOf s (taggedLink "smp8.simplex.im" 'a' "Biz") `shouldReturn` ok (chat "address" "business" "helper" "" Nothing Nothing "ok")
 
 testPreviewInvalid :: TVar ChaChaDRG -> IO ()
-testPreviewInvalid g = withSearch g id $ \s -> do
+testPreviewInvalid g = withSearch g id id $ \s -> do
   let base = bakeryLink <> "?x="
       padded n = base <> T.replicate (n - T.length base) "a"
       invalid = refused 400 "invalid_link"
@@ -469,23 +512,23 @@ testPreviewInvalid g = withSearch g id $ \s -> do
   fst <$> previewOf s (padded 4096) `shouldReturn` 200
 
 testPreviewBadBody :: TVar ChaChaDRG -> IO ()
-testPreviewBadBody g = withSearch g id $ \s -> do
+testPreviewBadBody g = withSearch g id id $ \s -> do
   forM_ ["[]", "\"link\"", "not json", "", J.encode (J.object ["link" .= T.replicate 9000 "a"])] $ \body ->
     answerOf <$> postPreview s body >>= \a -> (body, a) `shouldBe` (body, refused 400 "bad_request")
 
 testPreviewPrivateHost :: TVar ChaChaDRG -> IO ()
-testPreviewPrivateHost g = withSearch g id $ \s -> do
+testPreviewPrivateHost g = withSearch g id id $ \s -> do
   previewOf s (taggedLink "10.0.0.1" 'a' "Y8m3") `shouldReturn` ok (unreadChat "address" "contact" "unavailable")
   previewOf s (taggedLink "private.test" 'c' "Rk27") `shouldReturn` ok (unreadChat "channel" "channel" "unavailable")
   fetchedLinks s `shouldReturn` []
 
 testPreviewUnread :: TVar ChaChaDRG -> IO ()
-testPreviewUnread g = withSearch g id $ \s -> do
+testPreviewUnread g = withSearch g id id $ \s -> do
   previewOf s (taggedLink "smp8.simplex.im" 'c' "Gone") `shouldReturn` ok (unreadChat "channel" "channel" "unread")
   length <$> fetchedLinks s `shouldReturn` 1
 
 testPreviewLimit :: TVar ChaChaDRG -> IO ()
-testPreviewLimit g = withSearch g id $ \s -> do
+testPreviewLimit g = withSearch g id id $ \s -> do
   replicateM_ 20 $ previewOf s "hello" `shouldReturn` refused 400 "invalid_link"
   r <- postPreview s (J.encode $ J.object ["link" .= bakeryLink])
   answerOf r `shouldBe` refused 429 "rate_limited"

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