diff --git a/apps/simplex-store-service/src/StoreService/Names/Chain.hs b/apps/simplex-store-service/src/StoreService/Names/Chain.hs index a30421c2f8..e0d765db8f 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Chain.hs +++ b/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) diff --git a/apps/simplex-store-service/src/StoreService/Names/Contracts.hs b/apps/simplex-store-service/src/StoreService/Names/Contracts.hs index c45ba22ba2..b41641eb59 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Contracts.hs +++ b/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 diff --git a/apps/simplex-store-service/src/StoreService/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Names/Orders.hs index 5db32c645c..4265817482 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Orders.hs +++ b/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 = diff --git a/apps/simplex-store-service/src/StoreService/Names/Records.hs b/apps/simplex-store-service/src/StoreService/Names/Records.hs index 2a1bc17eb7..24b4a27f61 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Records.hs +++ b/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 () diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 3221e42fcd..c5d1dd21af 100644 --- a/simplex-chat.cabal +++ b/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 diff --git a/tests/Bots/StoreService/FakeEthNode.hs b/tests/Bots/StoreService/FakeEthNode.hs index 91d6adff6d..6e9961a74b 100644 --- a/tests/Bots/StoreService/FakeEthNode.hs +++ b/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 -> diff --git a/tests/Bots/StoreService/NamesContractsTests.hs b/tests/Bots/StoreService/NamesContractsTests.hs index 10b8ed379a..b0381fd28e 100644 --- a/tests/Bots/StoreService/NamesContractsTests.hs +++ b/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 diff --git a/tests/Bots/StoreService/NamesOwnerTests.hs b/tests/Bots/StoreService/NamesOwnerTests.hs index 4b6470da03..832c850640 100644 --- a/tests/Bots/StoreService/NamesOwnerTests.hs +++ b/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) diff --git a/tests/Bots/StoreService/NamesWorkerTests.hs b/tests/Bots/StoreService/NamesWorkerTests.hs new file mode 100644 index 0000000000..8ad3aa178a --- /dev/null +++ b/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) diff --git a/tests/Test.hs b/tests/Test.hs index 20f1f3f0e8..7b8746bae6 100644 --- a/tests/Test.hs +++ b/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