minimal adjustment to make client compile against SMP-v22 PR (#7520)

* minimal adjustment to make client compile against SMP-v22 PR

* repin after upstream merge

cabal.project

@@ -21,7 +21,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 7f0218e1d588a6d18c46916c8095e4fd78e09421
+    tag: ea43df2349f6d3dedd60d5e4aed21fd99316cad9
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."7f0218e1d588a6d18c46916c8095e4fd78e09421" = "1y0y7kpdd6sn8hwb087avkkxza23l5xyaz3bgrzix8pnl2il52kj";
+  "https://github.com/simplex-chat/simplexmq.git"."ea43df2349f6d3dedd60d5e4aed21fd99316cad9" = "1jkh6zfyfxbx49s0pggina1yadk3zlb0ls5crgka6aiw1w25dxr0";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

src/Simplex/Chat/Library/Commands.hs

@@ -120,7 +120,7 @@ import Simplex.Messaging.Crypto.Ratchet (E2ERatchetParamsUri (..), InitialKeys (
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (base64P)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ErrorType (NAME), MsgFlags (..), NameRecord (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ErrorType (NAME), MsgFlags (..), NameRecord (..), NameRegistration (..), NameResponse (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -1604,7 +1604,7 @@ processChatCommand cxt nm = \case
             UserContactLink {shortLinkDataSet, connLinkContact = CCLink _ sl_} <- withFastStore (`getUserAddress` user)
             case sl_ of
               Just sl | shortLinkDataSet -> do
-                NameRecord {nrSimplexContact} <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) domain
+                NameRecord {nrSimplexContact} <- resolveNameRecord user nm domain
                 unless (nameResolvesTo sl nrSimplexContact) $ throwChatError $ CESimplexDomainNotReady domain SDENoValidLink
                 pure $ Just (CLShort sl)
               _ -> throwCmdError "create the address short link and add it to name"
@@ -2418,7 +2418,7 @@ processChatCommand cxt nm = \case
     claim <- maybe (throwCmdError "group has no name to verify") pure $ publicGroupAccess >>= groupDomainClaim
     -- checks the profile link, not the link we joined through (which may have rotated)
     (verified, reason) <-
-      tryAllErrors (withAgent $ \a -> resolveSimplexName a nm (aUserId user) (claimDomain claim)) >>= \case
+      tryAllErrors (resolveNameRecord user nm (claimDomain claim)) >>= \case
         Right NameRecord {nrSimplexChannel}
           | nameResolvesTo groupLink nrSimplexChannel -> pure (True, Nothing)
           | otherwise -> pure (False, Just "the name does not resolve to the link in the group profile")
@@ -3295,7 +3295,7 @@ processChatCommand cxt nm = \case
         let domainChanged = (claimDomain <$> newClaim) /= (claimDomain <$> (existingAccess >>= groupDomainClaim))
         forM_ (claimDomain <$> newClaim) $ \newDomain ->
           when domainChanged $ do
-            NameRecord {nrSimplexChannel} <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) newDomain
+            NameRecord {nrSimplexChannel} <- resolveNameRecord user nm newDomain
             unless (nameResolvesTo groupLink nrSimplexChannel) $ throwChatError $ CESimplexDomainNotReady newDomain SDENoValidLink
         runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just access}} (isJust newClaim && domainChanged)
       Nothing -> throwChatError $ CECommandError "not a public group"
@@ -4416,7 +4416,7 @@ processChatCommand cxt nm = \case
         -- local search only: look up #d then @d in the store, without online name resolution
         | resolveMode == PRMNever -> connectPlanNoName $ ChatError CENotResolvedLocally
         | otherwise ->
-            tryAllErrors (withAgent $ \a -> resolveSimplexName a nm (aUserId user) d) >>= \case
+            tryAllErrors (resolveNameRecord user nm d) >>= \case
               Right nr
                 | isJust (firstNameLink CCTChannel (nrSimplexChannel nr)) ->
                     (addOther nr <$> connectPlanName NTPublicGroup (Right nr)) `catchAllErrors` \e ->
@@ -4567,7 +4567,7 @@ processChatCommand cxt nm = \case
           -- resolve a name to its first contact/channel short link
           resolveNameLink :: SimplexNameInfo -> CM (ConnShortLink 'CMContact)
           resolveNameLink SimplexNameInfo {nameType, nameDomain} = do
-            NameRecord {nrSimplexContact, nrSimplexChannel} <- maybe (withAgent $ \a -> resolveSimplexName a nm (aUserId user) nameDomain) (ExceptT . pure) nameRec
+            NameRecord {nrSimplexContact, nrSimplexChannel} <- maybe (resolveNameRecord user nm nameDomain) (ExceptT . pure) nameRec
             let (candidates, ctType') = case nameType of
                   NTContact -> (nrSimplexContact, CCTContact)
                   NTPublicGroup -> (nrSimplexChannel, CCTChannel)
@@ -5078,12 +5078,20 @@ firstNameLink ctType = foldr (\t r -> nameLink t <|> r) Nothing
 nameResolvesTo :: ConnShortLink 'CMContact -> [Text] -> Bool
 nameResolvesTo sLnk = any (either (const False) (sameShortLinkContact sLnk) . strDecode . encodeUtf8)
 
+-- the resolver now also reports names that are not registered, which stay the agent's NAME NOT_FOUND
+resolveNameRecord :: User -> NetworkRequestMode -> SimplexDomain -> CM NameRecord
+resolveNameRecord user nm domain = do
+  NameResponse {registration} <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) domain
+  case registration of
+    NRRegistered {nameRecord} -> pure nameRecord
+    _ -> throwError $ chatErrorAgent $ SMP "" (NAME SMP.NOT_FOUND)
+
 verifyEntityDomain :: User -> NetworkRequestMode -> SimplexNameType -> SimplexDomainClaim -> Maybe AConnShortLink -> CM (Maybe Bool, Maybe Text)
 verifyEntityDomain user nm nameType SimplexDomainClaim {domain = StrJSON domain, proof = proof_} connLink_ = case (proof_, connLink_) of
   (Nothing, _) -> pure (Nothing, Just "no name proof to verify")
   (_, Nothing) -> pure (Nothing, Just "no connection link to check the name against")
   (Just proof, Just (ACSL SCMContact profileSLnk)) -> do
-    NameRecord {nrSimplexContact, nrSimplexChannel} <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) domain
+    NameRecord {nrSimplexContact, nrSimplexChannel} <- resolveNameRecord user nm domain
     let resolvedLinks = case nameType of
           NTContact -> nrSimplexContact
           NTPublicGroup -> nrSimplexChannel
@@ -5632,7 +5640,7 @@ sendServiceRequestTo nm user sendTarget requestTimeout signKey request = do
         _ -> throwCmdError "service request target must be a contact"
       CTDomain d -> resolveDomain d
     resolveDomain d = do
-      nr <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) d
+      nr <- resolveNameRecord user nm d
       case firstNameLink CCTContact (nrSimplexContact nr) of
         Just sLnk -> resolveShortLink sLnk
         Nothing -> throwChatError $ CESimplexDomainNotReady d SDENoValidLink

tests/Bots/DirectoryTests.hs

@@ -2185,7 +2185,7 @@ testDirectoryChannelName ps = withSmpServerAndNames $ \reg ->
         enableNamesRole bob
         bob `connectVia` dsLink
         (shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay
-        registerName reg newsName (channelNameRecord "news" (T.pack shortLink))
+        registerName reg newsName (channelNameRecord "news.simplex" (T.pack shortLink))
         bob ##> "/public group access #news domain=news.simplex"
         bob <## "updated public group access: domain=news.simplex"
         relay <## "bob updated group #news: (signed)"
@@ -2226,13 +2226,13 @@ testDirectoryChannelNameNotVerified ps = withSmpServerAndNames $ \reg ->
         enableNamesRole bob
         bob `connectVia` dsLink
         (shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay
-        registerName reg newsName (channelNameRecord "news" (T.pack shortLink))
+        registerName reg newsName (channelNameRecord "news.simplex" (T.pack shortLink))
         bob ##> "/public group access #news domain=news.simplex"
         bob <## "updated public group access: domain=news.simplex"
         relay <## "bob updated group #news: (signed)"
         relay <## "updated public group access: domain=news.simplex"
         -- the name is re-pointed to a different link after the owner set it
-        registerName reg newsName (channelNameRecord "news" "https://simplex.chat/other")
+        registerName reg newsName (channelNameRecord "news.simplex" "https://simplex.chat/other")
         bob ##> "/share chat #news @'SimpleX Directory'"
         bob <# "@'SimpleX Directory' link to join channel #news (signed):"
         _ <- getTermLine bob -- short link

tests/ChatTests/Names.hs

@@ -36,7 +36,7 @@ testConnectByName ps = withSmpServerAndNames $ \reg ->
       mapM_ enableNamesRole [alice, bob]
       alice ##> "/ad"
       (shortLink, _) <- getContactLinks alice True
-      registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
+      registerName reg aliceName (contactNameRecord "alice.simplex" (T.pack shortLink))
       alice ##> "/_set domain 1 alice.simplex"
       alice <## "new contact address set"
       bob ##> "/c @alice.simplex"
@@ -71,7 +71,7 @@ testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg ->
       mapM_ enableNamesRole [alice, bob]
       alice ##> "/ad"
       (shortLink, _) <- getContactLinks alice True
-      registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
+      registerName reg aliceName (contactNameRecord "alice.simplex" (T.pack shortLink))
       bob ##> "/c @alice.simplex"
       bob <## "SimpleX name alice.simplex is not included in the connection link's profile"
 
@@ -94,7 +94,7 @@ testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames $ \reg ->
       concurrently_
         (bob <## "alice (Alice): contact is connected")
         (alice <## "bob (Bob): contact is connected")
-      registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
+      registerName reg aliceName (contactNameRecord "alice.simplex" (T.pack shortLink))
       bob ##> "/c @alice.simplex"
       bob <## "SimpleX name alice.simplex is not included in the connection link's profile"
 
@@ -116,7 +116,7 @@ testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg ->
       mapM_ enableNamesRole [alice, bob]
       bob ##> "/ad"
       (bobShortLink, _) <- getContactLinks bob True
-      registerName reg aliceName (contactNameRecord "alice" (T.pack bobShortLink))
+      registerName reg aliceName (contactNameRecord "alice.simplex" (T.pack bobShortLink))
       alice ##> "/ad"
       _ <- getContactLinks alice True
       alice ##> "/_set domain 1 alice.simplex"
@@ -130,7 +130,7 @@ testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames $ \reg ->
       withNewTestChat ps "bob" bobProfile $ \bob -> do
         mapM_ enableNamesRole [alice, cath, bob]
         (shortLink, fullLink) <- prepareChannel1Relay "team" alice cath
-        registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
+        registerName reg teamName (channelNameRecord "team.simplex" (T.pack shortLink))
         alice ##> "/public group access #team domain=team.simplex"
         alice <## "updated public group access: domain=team.simplex"
         cath <## "alice updated group #team: (signed)"
@@ -150,7 +150,7 @@ testChannelDomainVerify ps = withSmpServerAndNames $ \reg ->
       withNewTestChat ps "bob" bobProfile $ \bob -> do
         mapM_ enableNamesRole [alice, cath, bob]
         (shortLink, fullLink) <- prepareChannel1Relay "team" alice cath
-        registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
+        registerName reg teamName (channelNameRecord "team.simplex" (T.pack shortLink))
         alice ##> "/public group access #team domain=team.simplex"
         alice <## "updated public group access: domain=team.simplex"
         cath <## "alice updated group #team: (signed)"
@@ -162,7 +162,7 @@ testChannelDomainVerify ps = withSmpServerAndNames $ \reg ->
         bob ##> "/_verify domain #1"
         bob <## "SimpleX name #team verified"
         -- the name is re-pointed to a different link: verification fails
-        registerName reg teamName (channelNameRecord "team" "https://simplex.chat/other")
+        registerName reg teamName (channelNameRecord "team.simplex" "https://simplex.chat/other")
         bob ##> "/_verify domain #1"
         bob <## "SimpleX name #team not verified: the name does not resolve to the link in the group profile"
         -- a link-data refresh keeps the failed status, not overwritten with verified
@@ -180,7 +180,7 @@ testConnectByChannelName ps = withSmpServerAndNames $ \reg ->
       withNewTestChat ps "bob" bobProfile $ \bob -> do
         mapM_ enableNamesRole [alice, cath, bob]
         (shortLink, _) <- prepareChannel1Relay "team" alice cath
-        registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
+        registerName reg teamName (channelNameRecord "team.simplex" (T.pack shortLink))
         alice ##> "/public group access #team domain=team.simplex"
         alice <## "updated public group access: domain=team.simplex"
         cath <## "alice updated group #team: (signed)"
@@ -216,7 +216,7 @@ testConnectByNameChannelAndContact ps = withSmpServerAndNames $ \reg ->
         (channelLink, _) <- prepareChannel1Relay "team" alice cath
         alice ##> "/ad"
         (contactLink, _) <- getContactLinks alice True
-        registerName reg teamName (contactAndChannelNameRecord "team" (T.pack contactLink) (T.pack channelLink))
+        registerName reg teamName (contactAndChannelNameRecord "team.simplex" (T.pack contactLink) (T.pack channelLink))
         alice ##> "/public group access #team domain=team.simplex"
         alice <## "updated public group access: domain=team.simplex"
         cath <## "alice updated group #team: (signed)"
@@ -255,7 +255,7 @@ testConnectByNameContactAndChannel ps = withSmpServerAndNames $ \reg ->
         (channelLink, _) <- prepareChannel1Relay "acme" alice cath
         alice ##> "/ad"
         (contactLink, _) <- getContactLinks alice True
-        registerName reg acmeName (contactAndChannelNameRecord "acme" (T.pack contactLink) (T.pack channelLink))
+        registerName reg acmeName (contactAndChannelNameRecord "acme.simplex" (T.pack contactLink) (T.pack channelLink))
         alice ##> "/_set domain 1 acme.simplex"
         alice <## "new contact address set"
         bob ##> "/_connect plan 1 acme.simplex"
@@ -274,7 +274,7 @@ testConnectByNameBusinessAndChannel ps = withSmpServerAndNames $ \reg ->
         (channelLink, _) <- prepareChannel1Relay "biz" alice cath
         alice ##> "/ad"
         (contactLink, fullLink) <- getContactLinks alice True
-        registerName reg bizName (contactAndChannelNameRecord "biz" (T.pack contactLink) (T.pack channelLink))
+        registerName reg bizName (contactAndChannelNameRecord "biz.simplex" (T.pack contactLink) (T.pack channelLink))
         alice ##> "/auto_accept on business"
         alice <## "auto_accept on, business"
         alice ##> "/_set domain 1 biz.simplex"

tests/NameResolver.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Local HTTP names resolver for chat tests, copied from simplexmq's
--- NamesResolverServer and made dynamic: it answers /resolve/<domain> from a
+-- NamesResolverServer and made dynamic: it answers /v2/resolve/<query> from a
 -- mutable name -> NameRecord registry, so a test can resolve a name to the
 -- address it just created.
 module NameResolver
@@ -21,17 +21,19 @@ import qualified Data.Aeson as J
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1)
 import Network.HTTP.Types (hContentType, notFound404, ok200)
 import Network.Wai (Application, pathInfo, responseLBS)
 import qualified Network.Wai.Handler.Warp as Warp
-import Simplex.Messaging.Names.Record (NameRecord (..))
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Names.Record (NamePricing (..), NameRecord (..), NameRegistration (..), NameResponse (..), USDCents (..))
 import Simplex.Messaging.Server.Names (NamesConfig (..))
-import Simplex.Messaging.SimplexName (SimplexNameInfo (..), fullDomainName)
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexNameInfo (..), labelHash)
 
 type NameRegistry = TVar (Map Text NameRecord)
 
 -- | Run an action with a local resolver on a free port and its registry (keyed
--- by full domain name, what the resolver looks the name up by).
+-- by the query the resolver looks the name up by).
 withNameResolver :: (Int -> TVar (Map Text NameRecord) -> IO a) -> IO a
 withNameResolver action = do
   reg <- newTVarIO M.empty
@@ -41,14 +43,16 @@ withNameResolver action = do
     app reg req send = do
       (st, body) <- case pathInfo req of
         ["health"] -> pure (ok200, "{}")
-        ["resolve", d] -> maybe (notFound404, "{}") (\r -> (ok200, J.encode r)) . M.lookup d <$> readTVarIO reg
+        ["v2", "resolve", q] -> (\r -> (ok200, J.encode $ nameResponse r)) . M.lookup q <$> readTVarIO reg
         _ -> pure (notFound404, "{}")
       send $ responseLBS st [(hContentType, "application/json")] body
+    nameResponse (Just nameRecord) = NameResponse {lastBlockTs = Nothing, registration = NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Nothing, nameRecord}}
+    nameResponse Nothing = NameResponse {lastBlockTs = Nothing, registration = NRAvailable {pricing = NamePricing {registrationPrices = M.empty, basePrice = USDCents 1000, minLabelLength = 1}}}
 
 -- | Register a name's domain to resolve to the given record.
 registerName :: TVar (Map Text NameRecord) -> SimplexNameInfo -> NameRecord -> IO ()
-registerName reg SimplexNameInfo {nameDomain} r =
-  atomically $ modifyTVar' reg $ M.insert (fullDomainName nameDomain) r
+registerName reg SimplexNameInfo {nameDomain = SimplexDomain {nameTLD, domain}} r =
+  atomically $ modifyTVar' reg $ M.insert (decodeLatin1 $ strEncode (labelHash domain) <> strEncode nameTLD) r
 
 contactNameRecord :: Text -> Text -> NameRecord
 contactNameRecord name link = (emptyRecord name) {nrSimplexContact = [link]}