store: read a landed register at the confirmed block

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

@@ -16,8 +16,10 @@ module StoreService.Names.Chain
     BlockTag (..),
     newChainClient,
     ethCall,
+    ethCallAt,
     latestBlock,
     blockAt,
+    confirmedNumber,
     transactionReceipt,
     transactionByHash,
     transactionCount,
@@ -103,7 +105,7 @@ data Receipt = Receipt {receiptSuccess :: Bool, receiptBlock :: Word64}
 data TxState = TxPending | TxMined Word64
   deriving (Eq, Show)
 
-data BlockTag = Latest | Pending
+data BlockTag = Latest | Pending | AtBlock Word64
 
 rpcTimeout :: Int
 rpcTimeout = 10000000
@@ -133,14 +135,21 @@ newChainClient g ccConfig@ChainConfig {cServiceKey} = do
   pure ChainClient {ccManager, ccConfig, ccRegistrar, ccTimeout = rpcTimeout}
 
 ethCall :: ChainClient -> Address -> ByteString -> IO (Either ChainError ByteString)
-ethCall c to calldata = rpc c "eth_call" [J.object ["to" .= to, "data" .= hex calldata], "latest"] bytes
+ethCall c = ethCallAt c Latest
+
+ethCallAt :: ChainClient -> BlockTag -> Address -> ByteString -> IO (Either ChainError ByteString)
+ethCallAt c tag to calldata = rpc c "eth_call" [J.object ["to" .= to, "data" .= hex calldata], blockTagParam tag] bytes
 
 latestBlock :: ChainClient -> IO (Either ChainError Block)
 latestBlock c = blockByNumber c "latest"
 
 -- | A block the node does not have is a failed read.
 blockAt :: ChainClient -> Word64 -> IO (Either ChainError Block)
-blockAt c number = blockByNumber c $ J.String $ "0x" <> T.pack (showHex number "")
+blockAt c = blockByNumber c . blockTagParam . AtBlock
+
+-- | The newest block at the configured confirmation depth below this latest one, as the sender counts it.
+confirmedNumber :: ChainClient -> Word64 -> Word64
+confirmedNumber ChainClient {ccConfig = ChainConfig {cConfirmations}} latest = latest - min latest (fromIntegral (max 1 cConfirmations) - 1)
 
 blockByNumber :: ChainClient -> J.Value -> IO (Either ChainError Block)
 blockByNumber c tag =
@@ -166,11 +175,13 @@ transactionByHash c (TxHash h) =
     maybe TxPending TxMined <$> (traverse quantity =<< t .:? "blockNumber")
 
 transactionCount :: ChainClient -> Address -> BlockTag -> IO (Either ChainError Word64)
-transactionCount c a tag = rpc c "eth_getTransactionCount" [J.toJSON a, blockTag] quantity
-  where
-    blockTag = case tag of
-      Latest -> "latest"
-      Pending -> "pending"
+transactionCount c a tag = rpc c "eth_getTransactionCount" [J.toJSON a, blockTagParam tag] quantity
+
+blockTagParam :: BlockTag -> J.Value
+blockTagParam = \case
+  Latest -> "latest"
+  Pending -> "pending"
+  AtBlock number -> J.String $ "0x" <> T.pack (showHex number "")
 
 -- | The dry run of a registrar transaction; an estimate above the configured cap is refused.
 estimateGas :: ChainClient -> Address -> ByteString -> IO (Either ChainError Word64)

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

@@ -17,6 +17,7 @@ module StoreService.Names.Contracts
     codeLengthFor,
     sponsorNonce,
     resolverNonce,
+    confirmedTag,
     ownerOfToken,
     nameExpires,
     commitmentTime,
@@ -43,7 +44,7 @@ import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD)
 import Simplex.Messaging.Util (tshow)
 import StoreService.Config (ChainConfig (..))
 import StoreService.Names.Abi
-import StoreService.Names.Chain (Block (..), ChainClient (..), ChainError (..), ethCall, latestBlock)
+import StoreService.Names.Chain (Block (..), BlockTag (..), ChainClient (..), ChainError (..), confirmedNumber, ethCallAt, latestBlock)
 import StoreService.Names.Registration (channelRecordKey, contactRecordKey, labelNode, nodeBytes)
 import StoreService.Names.Revert (RevertName (..))
 import System.Timeout (timeout)
@@ -98,7 +99,7 @@ newContracts ctTLD ctChain = do
 nameStatus :: Contracts -> LabelHash -> IO (Either ChainError NameStatus)
 nameStatus ct@Contracts {ctChain} lh = withinDeadline ct "name status" $ runExceptT $ do
   (RegistrarConstants {rcRegistry, rcGracePeriod}, expires, Block {blockTimestamp}) <-
-    ExceptT $ together $ (,,) <$> concurrent (registrarConstants ct) <*> concurrent (nameExpires ct lh) <*> concurrent (latestBlock ctChain)
+    ExceptT $ together $ (,,) <$> concurrent (registrarConstants ct) <*> concurrent (nameExpires ct Latest lh) <*> concurrent (latestBlock ctChain)
   if toInteger expires + rcGracePeriod >= toInteger blockTimestamp
     then do
       let node = nodeArg ct lh
@@ -153,16 +154,20 @@ sponsorNonce ct owner = call ct (cSponsor $ chainConfig ct) ("nonces(address)",
 resolverNonce :: Contracts -> Address -> IO (Either ChainError Word64)
 resolverNonce ct owner = call ct (resolver ct) ("nonces(address)", addressWord owner) decodeWord64
 
+-- | The newest block at the configured confirmation depth, so a read there sees only what a reorg cannot undo.
+confirmedTag :: Contracts -> IO (Either ChainError BlockTag)
+confirmedTag Contracts {ctChain} = fmap (AtBlock . confirmedNumber ctChain . blockNumber) <$> latestBlock ctChain
+
 -- | Nothing when nobody holds the name: @ownerOf@ then fails the registrar's bare @require@ on the expiry,
 -- a revert without data. Any other revert is a failed read.
-ownerOfToken :: Contracts -> LabelHash -> IO (Either ChainError (Maybe Address))
-ownerOfToken ct lh =
-  call ct (baseRegistrar ct) ("ownerOf(uint256)", labelHashArg lh) decodeAddress >>= \case
+ownerOfToken :: Contracts -> BlockTag -> LabelHash -> IO (Either ChainError (Maybe Address))
+ownerOfToken ct tag lh =
+  callAt ct tag (baseRegistrar ct) ("ownerOf(uint256)", labelHashArg lh) decodeAddress >>= \case
     Left (ChainReverted (Just RNWithoutData)) -> pure $ Right Nothing
     r -> pure $ Just <$> r
 
-nameExpires :: Contracts -> LabelHash -> IO (Either ChainError Word64)
-nameExpires ct lh = call ct (baseRegistrar ct) ("nameExpires(uint256)", labelHashArg lh) decodeWord64
+nameExpires :: Contracts -> BlockTag -> LabelHash -> IO (Either ChainError Word64)
+nameExpires ct tag lh = callAt ct tag (baseRegistrar ct) ("nameExpires(uint256)", labelHashArg lh) decodeWord64
 
 -- | The block time of the commitment, Nothing when the controller holds none.
 commitmentTime :: Contracts -> ByteString -> IO (Either ChainError (Maybe Word64))
@@ -202,10 +207,13 @@ concurrent = Compose . Concurrently
 withinDeadline :: Contracts -> Text -> IO (Either ChainError a) -> IO (Either ChainError a)
 withinDeadline Contracts {ctDeadline} what action = fromMaybe (Left $ ChainUnavailable $ what <> ": timed out") <$> timeout ctDeadline action
 
--- | An answer that does not decode is a node failure, as an RPC error is.
 call :: Contracts -> Address -> (ByteString, ByteString) -> (ByteString -> Either AbiError a) -> IO (Either ChainError a)
-call Contracts {ctChain} to (signature, args) decode =
-  (>>= first malformed . decode) <$> ethCall ctChain to (selector signature <> args)
+call ct = callAt ct Latest
+
+-- | An answer that does not decode is a node failure, as an RPC error is.
+callAt :: Contracts -> BlockTag -> Address -> (ByteString, ByteString) -> (ByteString -> Either AbiError a) -> IO (Either ChainError a)
+callAt Contracts {ctChain} tag to (signature, args) decode =
+  (>>= first malformed . decode) <$> ethCallAt ctChain tag to (selector signature <> args)
   where
     malformed e = ChainUnavailable $ "eth_call: " <> decodeLatin1 signature <> " answered " <> tshow e
 

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

@@ -70,7 +70,7 @@ import Simplex.Messaging.Util (tshow)
 import StoreService.Config (NamesConfig (..))
 import StoreService.Log (logError, logWarn)
 import StoreService.Names.Codes (CodeRefusal (..), codeRefusal, reserveCode, reserveRefusal, spendLandedCode)
-import StoreService.Names.Contracts (Contracts, NameStatus (..), chainPriceCents, codeLengthFor, nameExpires, nameStatus, ownerOfToken, secondsPerYear)
+import StoreService.Names.Contracts (Contracts, NameStatus (..), chainPriceCents, codeLengthFor, confirmedTag, nameExpires, nameStatus, ownerOfToken, secondsPerYear)
 import StoreService.Names.Env (NamesEnv (..))
 import StoreService.Names.Phases (Phases, RegistrationId (..))
 import StoreService.Names.Abi (bytes32FromHex, hex)
@@ -329,8 +329,8 @@ versionWritten = \case
   LiveOrderExists -> Left $ WRRefused OROrderExists
   NotLive -> Left $ WRRefused ORBadRequest
 
--- | /retry's first check, on the order's current name: a register mined with status 1, or the owner holding the name, went through
--- with only its confirmation lost. The order then becomes registered by a compare-and-set on the version read, a code order spending its code.
+-- | /retry's first check, on the order's current name: a register mined with status 1, or the owner holding the name at the confirmation depth,
+-- went through with only its confirmation lost. The order then becomes registered by a compare-and-set on the version read, a code order spending its code.
 -- The caller holds the turn of the order's label hash and passes the order as registrationAt reads it.
 confirmLanded :: OrdersEnv -> NameRegistration -> IO Landing
 confirmLanded OrdersEnv {oeStore, oeContracts, oeTurns, oeNow} r@NameRegistration {nrId, nrOwner, nrLabelHash, nrPayment, nrRegisterTx, nrRegisterBlock} = do
@@ -342,10 +342,11 @@ confirmLanded OrdersEnv {oeStore, oeContracts, oeTurns, oeNow} r@NameRegistratio
     Right (Just (tx, expiry)) -> either (const LChanged) LRegistered <$> markRegistered tx expiry
   where
     landed mined = do
+      confirmed <- ExceptT $ confirmedTag oeContracts
       registerTx <- case mined of
         tx : _ -> pure $ Just $ Just tx
-        [] -> (\holder -> if holder == Just nrOwner then Just Nothing else Nothing) <$> ExceptT (ownerOfToken oeContracts nrLabelHash)
-      forM registerTx $ \tx -> (tx,) <$> ExceptT (nameExpires oeContracts nrLabelHash)
+        [] -> (\holder -> if holder == Just nrOwner then Just Nothing else Nothing) <$> ExceptT (ownerOfToken oeContracts confirmed nrLabelHash)
+      forM registerTx $ \tx -> (tx,) <$> ExceptT (nameExpires oeContracts confirmed nrLabelHash)
     markRegistered tx expiry = do
       now <- oeNow
       let registered =

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

@@ -237,11 +237,11 @@ recordsRound rs@Records {rsChain} = void $ safely "names records: the round" $ d
 
 -- | The newest block at the configured confirmation depth, as the sender counts it.
 deepBlock :: ChainClient -> Block -> IO (Either ChainError Block)
-deepBlock c@ChainClient {ccConfig = ChainConfig {cConfirmations}} tip@Block {blockNumber}
-  | depth == 0 = pure $ Right tip
-  | otherwise = blockAt c $ if blockNumber >= depth then blockNumber - depth else 0
+deepBlock c tip@Block {blockNumber}
+  | deep == blockNumber = pure $ Right tip
+  | otherwise = blockAt c deep
   where
-    depth = fromIntegral (max 1 cConfirmations) - 1
+    deep = confirmedNumber c blockNumber
 
 -- | One step for a pending edit, from its transactions' statuses as the sender settled them.
 follow :: Records -> Block -> Block -> RecordEdit -> IO ()

simplex-chat.cabal

@@ -782,6 +782,7 @@ test-suite simplex-chat-test
       Bots.StoreService.NamesSignatureTests
       Bots.StoreService.NamesStoreTests
       Bots.StoreService.NamesWiringTests
+      Bots.StoreService.NamesWorkerTests
       Bots.StoreService.StripeTests
       Bots.StoreService.WaitersTests
       Bots.StoreService.WebTests

tests/Bots/StoreService/FakeEthNode.hs

@@ -11,6 +11,7 @@ module Bots.StoreService.FakeEthNode
     fakeChainConfig,
     answerCall,
     answerCallOnce,
+    answerCallFrom,
     forgetCall,
     setFault,
     clearFault,
@@ -97,6 +98,8 @@ data FakeState = FakeState
   { fsCalls :: Map (ByteString, ByteString) CallAnswer,
     -- | answered once, before 'fsCalls'
     fsCallsOnce :: Map (ByteString, ByteString) CallAnswer,
+    -- | answered from the block on, before 'fsCalls'
+    fsCallsFrom :: Map (ByteString, ByteString) (Word64, CallAnswer),
     fsFaults :: Map Text Fault,
     -- | every raw transaction received, newest first
     fsSent :: [ByteString],
@@ -145,6 +148,7 @@ withFakeEthNode action = do
       FakeState
         { fsCalls = M.empty,
           fsCallsOnce = M.empty,
+          fsCallsFrom = M.empty,
           fsFaults = M.empty,
           fsSent = [],
           fsPool = M.empty,
@@ -182,6 +186,10 @@ answerCall FakeEthNode {fnState} to calldata a = atomically $ modifyTVar' fnStat
 answerCallOnce :: FakeEthNode -> Address -> ByteString -> CallAnswer -> IO ()
 answerCallOnce FakeEthNode {fnState} to calldata a = atomically $ modifyTVar' fnState $ \s -> s {fsCallsOnce = M.insert (unAddress to, calldata) a $ fsCallsOnce s}
 
+-- | At this block and later ones the call answers this way, at earlier blocks as before.
+answerCallFrom :: FakeEthNode -> Word64 -> Address -> ByteString -> CallAnswer -> IO ()
+answerCallFrom FakeEthNode {fnState} block to calldata a = atomically $ modifyTVar' fnState $ \s -> s {fsCallsFrom = M.insert (unAddress to, calldata) (block, a) $ fsCallsFrom s}
+
 -- | The call has no answer any more, as if the node failed it.
 forgetCall :: FakeEthNode -> Address -> ByteString -> IO ()
 forgetCall FakeEthNode {fnState} to calldata = atomically $ modifyTVar' fnState $ \s -> s {fsCalls = M.delete (unAddress to, calldata) $ fsCalls s}
@@ -298,10 +306,11 @@ fakeApp st req respond = do
 
 answer :: TVar FakeState -> Text -> [J.Value] -> STM [JT.Pair]
 answer st method params = do
-  s@FakeState {fsCalls, fsCallsOnce, fsSent, fsPool, fsReceipts, fsDryRuns, fsUsed, fsBlock = (number, time), fsBlockTimes, fsFees = (tip, baseFee)} <- readTVar st
+  s@FakeState {fsCalls, fsCallsOnce, fsCallsFrom, fsSent, fsPool, fsReceipts, fsDryRuns, fsUsed, fsBlock = (number, time), fsBlockTimes, fsFees = (tip, baseFee)} <- readTVar st
   case (method, params) of
-    ("eth_call", [call, _])
-      | Just (to, calldata) <- JT.parseMaybe callTarget call ->
+    ("eth_call", [call, J.String tag])
+      | Just (to, calldata) <- JT.parseMaybe callTarget call,
+        Just at <- if tag == "latest" then Just number else fromQuantity tag ->
           let key = (unAddress to, calldata)
               callAnswer = \case
                 Just (Returns ret) -> result $ hex ret
@@ -309,7 +318,9 @@ answer st method params = do
                 Nothing -> rpcError (-32000) "no fake answer for this call" Nothing
            in case M.lookup key fsCallsOnce of
                 Just a -> callAnswer (Just a) <$ writeTVar st s {fsCallsOnce = M.delete key fsCallsOnce}
-                Nothing -> pure $ callAnswer $ M.lookup key fsCalls
+                Nothing -> pure $ callAnswer $ case M.lookup key fsCallsFrom of
+                  Just (from, a) | at >= from -> Just a
+                  _ -> M.lookup key fsCalls
     ("eth_estimateGas", call : _)
       | Just (_, calldata) <- JT.parseMaybe callTarget call,
         Just revertData <- M.lookup calldata fsDryRuns ->

tests/Bots/StoreService/NamesContractsTests.hs

@@ -197,26 +197,26 @@ testNonces g = withContracts g $ \node ct -> do
 testOwnerOfNobody :: TVar ChaChaDRG -> IO ()
 testOwnerOfNobody g = withContracts g $ \node ct -> do
   answerCall node (registrarOf node) ownerOfCall $ Returns $ addressWord owner
-  ownerOfToken ct alice `shouldReturn` Right (Just owner)
+  ownerOfToken ct Latest alice `shouldReturn` Right (Just owner)
   -- the registrar's require(expiries[tokenId] > block.timestamp), as anvil answers it with "0x" and reth without data
   answerCall node (registrarOf node) ownerOfCall $ Reverts ""
-  ownerOfToken ct alice `shouldReturn` Right Nothing
+  ownerOfToken ct Latest alice `shouldReturn` Right Nothing
   setFault node "eth_call" $ RpcError 3 "execution reverted" Nothing
-  ownerOfToken ct alice `shouldReturn` Right Nothing
+  ownerOfToken ct Latest alice `shouldReturn` Right Nothing
 
 testOwnerOfFailed :: TVar ChaChaDRG -> IO ()
 testOwnerOfFailed g = withContracts g $ \node ct -> do
   -- viem's encodeErrorResult of Error("ERC721: invalid token ID")
   answerCall node (registrarOf node) ownerOfCall $ Reverts $ unhex "08c379a0000000000000000000000000000000000000000000000000000000000000002000000000000000000000000000000000000000000000000000000000000000184552433732313a20696e76616c696420746f6b656e2049440000000000000000"
-  ownerOfToken ct alice `shouldReturn` Left (ChainReverted Nothing)
+  ownerOfToken ct Latest alice `shouldReturn` Left (ChainReverted Nothing)
   -- viem's encodeErrorResult of ReentrantCall()
   answerCall node (registrarOf node) ownerOfCall $ Reverts $ unhex "37ed32e8"
-  ownerOfToken ct alice `shouldReturn` Left (ChainReverted $ Just RNReentrantCall)
+  ownerOfToken ct Latest alice `shouldReturn` Left (ChainReverted $ Just RNReentrantCall)
   -- a node or proxy that keeps the reason in the message but drops the data
   setFault node "eth_call" $ RpcError (-32000) "execution reverted: ERC721: invalid token ID" Nothing
-  ownerOfToken ct alice `shouldReturn` Left (ChainReverted Nothing)
+  ownerOfToken ct Latest alice `shouldReturn` Left (ChainReverted Nothing)
   setFault node "eth_call" HttpFailure
-  ownerOfToken ct alice `shouldReturn` Left (ChainUnavailable "eth_call: HTTP 502")
+  ownerOfToken ct Latest alice `shouldReturn` Left (ChainUnavailable "eth_call: HTTP 502")
 
 testCommitmentTime :: TVar ChaChaDRG -> IO ()
 testCommitmentTime g = withContracts g $ \node ct -> do
@@ -232,7 +232,7 @@ testAvailability g = withContracts g $ \node ct -> do
   answerCall node fakeController availableCall $ Returns $ uint256 (0 :: Int)
   controllerAvailable ct "alicebakery" `shouldReturn` Right False
   answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (now + year)
-  nameExpires ct alice `shouldReturn` Right (now + year)
+  nameExpires ct Latest alice `shouldReturn` Right (now + year)
 
 testCommitmentAges :: TVar ChaChaDRG -> IO ()
 testCommitmentAges g = withContracts g $ \node ct -> do
@@ -259,7 +259,7 @@ testFailedRead g = withContracts g $ \node ct -> do
 testMalformed :: TVar ChaChaDRG -> IO ()
 testMalformed g = withContracts g $ \node ct -> do
   answerCall node (registrarOf node) nameExpiresCall $ Returns $ B.replicate 31 0
-  nameExpires ct alice `shouldReturn` Left (ChainUnavailable "eth_call: nameExpires(uint256) answered AEShort")
+  nameExpires ct Latest alice `shouldReturn` Left (ChainUnavailable "eth_call: nameExpires(uint256) answered AEShort")
   answerCall node fakeSponsor noncesCall $ Returns $ uint256 (toInteger (maxBound :: Word64) + 1)
   sponsorNonce ct owner `shouldReturn` Left (ChainUnavailable "eth_call: nonces(address) answered AERange")
   answerCall node fakeController pricesCall $ Returns $ addressWord oracle

tests/Bots/StoreService/NamesOwnerTests.hs

@@ -3,7 +3,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 
-module Bots.StoreService.NamesOwnerTests (namesOwnerTests, answerFree, moveBody, moveTo, postMove) where
+module Bots.StoreService.NamesOwnerTests
+  ( namesOwnerTests,
+    answerExpiry,
+    answerFree,
+    answerOwner,
+    answerUnowned,
+    codeIn,
+    committedPhase,
+    dynamisOrder,
+    failedPhase,
+    labelBytes,
+    moveBody,
+    moveTo,
+    ownerOfSelector,
+    paidIn,
+    postMove,
+    rewrite,
+    stored,
+  )
+where
 
 import Bots.StoreService.FakeEthNode
 import Bots.StoreService.NamesContractsTests (launchPricesAnswer, oracle, pricesAnswer, pricesCall, registrarOf, rentPriceAnswer, rentPriceCall, unhex)

tests/Bots/StoreService/NamesWorkerTests.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Bots.StoreService.NamesWorkerTests (namesWorkerTests) where
+
+import Bots.StoreService.FakeEthNode
+import Bots.StoreService.NamesContractsTests (registrarOf)
+import Bots.StoreService.NamesOrdersTests
+import Bots.StoreService.NamesOwnerTests (answerExpiry, answerUnowned, failedPhase, labelBytes, ownerOfSelector, paidIn, stored)
+import Control.Monad (replicateM_)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
+import Data.Word (Word64)
+import StoreService.Names.Abi (addressWord)
+import StoreService.Names.Orders (Landing (..), confirmLanded)
+import StoreService.Names.Store (NamePhase (..), NameRegistration (..))
+import Test.Hspec
+
+namesWorkerTests :: Spec
+namesWorkerTests = describe "StoreService names: worker" $ do
+  describe "confirmation depth" $
+    it "judges a register landed by ownerOf only once the owner holds the name at the confirmation depth" testLandedAtDepth
+
+-- fixtures
+
+orderSeconds :: Word64
+orderSeconds = floor $ utcTimeToPOSIXSeconds orderTime
+
+expiry :: Word64
+expiry = orderSeconds + 2 * 31536000
+
+-- tests
+
+testLandedAtDepth :: IO ()
+testLandedAtDepth = withOrders $ \ctx@Ctx {cNode, cOrders} -> do
+  r <- paidIn ctx aliceOrder failedPhase
+  answerUnowned ctx "alicebakery"
+  answerExpiry ctx "alicebakery" expiry
+  -- the owner's own register, mined in the latest block
+  latest <- mine cNode []
+  answerCallFrom cNode latest (registrarOf cNode) (ownerOfSelector <> labelBytes "alicebakery") $ Returns $ addressWord $ nrOwner r
+  confirmLanded cOrders r `shouldReturn` LNotLanded
+  stored ctx r `shouldReturn` r
+  -- confirmations 3: two more blocks put it at the depth
+  replicateM_ 2 $ mine cNode []
+  confirmLanded cOrders r `shouldReturn` LRegistered (nrVersion r + 1)
+  NameRegistration {nrPhase, nrExpiresAt, nrRegisterTx} <- stored ctx r
+  (nrPhase, nrExpiresAt, nrRegisterTx) `shouldBe` (PRegistered, Just expiry, Nothing)

tests/Test.hs

@@ -26,6 +26,7 @@ import Bots.StoreService.NamesSenderTests
 import Bots.StoreService.NamesSignatureTests
 import Bots.StoreService.NamesStoreTests
 import Bots.StoreService.NamesWiringTests
+import Bots.StoreService.NamesWorkerTests
 import Bots.StoreService.StripeTests
 import Bots.StoreService.WaitersTests
 import Bots.StoreService.WebTests
@@ -119,6 +120,7 @@ main = do
       namesSignatureTests
       namesStoreTests
       namesWiringTests
+      namesWorkerTests
       describe "SimpleX chat markdown" markdownTests
       describe "JSON Tests" jsonTests
       describe "Member relations" memberRelationsTests