store: count only sent record edits

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

@@ -176,28 +176,37 @@ insertEdit Records {rsStore, rsTurns, rsNow} EditRequest {erLabelHash, erChange,
   where
     edit = NewRecordEdit {nreLabelHash = erLabelHash, nreOwner = signer, nreNonce = erNonce, nreChange = erChange, nreDeadline = erDeadline, nreSignature = erSignature, nreBodyHash = bodyHash}
 
--- | An edit the chain failed to take is deleted while still claimed, so the lane cannot send it after.
+-- | An edit that was not sent is answered and deleted while still claimed, so the lane cannot send it after.
 sendNew :: Records -> Int64 -> IO EditAnswer
-sendNew rs editId = do
-  sent <- withClaim rs editId True $ withStore rs (`getRecordEdit` editId) >>= maybe (pure True) send
-  if sent then awaitEdit rs editId else EAUnavailable <$ settled rs editId
+sendNew rs editId =
+  withClaim rs editId Nothing (withStore rs (`getRecordEdit` editId) >>= maybe (pure Nothing) send) >>= maybe (awaitEdit rs editId) pure
   where
     send edit =
       sendEdit rs edit >>= \case
-        Right () -> pure True
+        Right () -> pure Nothing
         Left e -> do
-          logWarn $ "names records: edit " <> tshow editId <> " not sent: " <> tshow e
-          False <$ withStore rs (`deleteUnsentEdit` editId)
+          answer <- case e of
+            SEChain (ChainReverted name) -> either (const EAUnavailable) (dryRunAnswer name) <$> judge rs edit
+            _ -> EAUnavailable <$ logWarn ("names records: edit " <> tshow editId <> " not sent: " <> tshow e)
+          Just answer <$ forget rs editId
+    -- anyone can relay a signed edit, so a revert may mean another relayer applied it
+    dryRunAnswer name = \case
+      Applied tx -> EAApplied tx
+      NonceTaken -> EAReverted $ revertText RNInvalidNonce
+      NonceFree -> EAReverted $ revertText =<< name
 
--- | A dry run's revert is judged at once; Left when nothing was sent and the chain did not refuse the edit.
+-- | Left when nothing was sent: the dry run reverted or the chain failed.
 sendEdit :: Records -> RecordEdit -> IO (Either SendError ())
 sendEdit rs@Records {rsSender} edit@RecordEdit {reId} =
   submitTransaction rsSender (TxEdit reId) (resolver rs) (editCalldata rs edit) >>= \case
     Right _ -> Right () <$ unstall rs reId
     Left SEInFlight -> pure $ Right ()
-    Left (SEChain (ChainReverted name)) -> Right () <$ judged rs edit (settle rs reId $ ESReverted $ revertText =<< name)
     Left e -> pure $ Left e
 
+-- | Only sent edits are stored, so one never sent leaves no row and its repeat is checked anew.
+forget :: Records -> Int64 -> IO ()
+forget rs editId = withStore rs (`deleteUnsentEdit` editId) >> settled rs editId
+
 -- | Waits until the edit settles, the chain stops answering for it, or 'rsPendingAfter' passes.
 awaitEdit :: Records -> Int64 -> IO EditAnswer
 awaitEdit rs@Records {rsChanges, rsStalled, rsPendingAfter} editId = registerDelay rsPendingAfter >>= loop
@@ -242,7 +251,7 @@ follow :: Records -> Block -> Block -> RecordEdit -> IO ()
 follow rs@Records {rsChain} Block {blockTimestamp} Block {blockTimestamp = deepTime} edit@RecordEdit {reId, reDeadline} = do
   txs <- withStore rs (`editTransactions` reId)
   case txs of
-    [] -> if ahead then resend else expire
+    [] -> if ahead then sendUnsent else forget rs reId
     _
       | mined : _ <- [ntHash | NameTransaction {ntHash, ntStatus = TSMined} <- txs] -> settle rs reId $ ESMined $ Just mined
       | any ((== TSPending) . ntStatus) txs -> if deepTime > reDeadline then expire else unstall rs reId
@@ -256,7 +265,15 @@ follow rs@Records {rsChain} Block {blockTimestamp} Block {blockTimestamp = deepT
   where
     ahead = reDeadline > blockTimestamp
     expire = judged rs edit $ settle rs reId $ ESReverted signatureExpired
-    resend = sendEdit rs edit >>= either (stall rs reId) pure
+    sendUnsent =
+      sendEdit rs edit >>= \case
+        Left (SEChain (ChainReverted _)) -> forget rs reId
+        r -> either (stall rs reId) pure r
+    -- the edit was sent before, so its dry run's revert is its outcome
+    resend =
+      sendEdit rs edit >>= \case
+        Left (SEChain (ChainReverted name)) -> settle rs reId $ ESReverted $ revertText =<< name
+        r -> either (stall rs reId) pure r
 
 -- | Settles the edit as the chain shows it, or runs the action when its nonce is still free.
 judged :: Records -> RecordEdit -> IO () -> IO ()

tests/Bots/StoreService/FakeEthNode.hs

@@ -9,6 +9,8 @@ module Bots.StoreService.FakeEthNode
     withFakeEthNode,
     fakeChainConfig,
     answerCall,
+    answerCallOnce,
+    forgetCall,
     setFault,
     clearFault,
     setBlock,
@@ -82,6 +84,8 @@ data Fault
 
 data FakeState = FakeState
   { fsCalls :: Map (ByteString, ByteString) CallAnswer,
+    -- | answered once, before 'fsCalls'
+    fsCallsOnce :: Map (ByteString, ByteString) CallAnswer,
     fsFaults :: Map Text Fault,
     -- | every raw transaction received, newest first
     fsSent :: [ByteString],
@@ -129,6 +133,7 @@ withFakeEthNode action = do
     newTVarIO
       FakeState
         { fsCalls = M.empty,
+          fsCallsOnce = M.empty,
           fsFaults = M.empty,
           fsSent = [],
           fsPool = M.empty,
@@ -162,6 +167,14 @@ fakeChainConfig FakeEthNode {fnUrl} =
 answerCall :: FakeEthNode -> Address -> ByteString -> CallAnswer -> IO ()
 answerCall FakeEthNode {fnState} to calldata a = atomically $ modifyTVar' fnState $ \s -> s {fsCalls = M.insert (unAddress to, calldata) a $ fsCalls s}
 
+-- | The next call only is answered this way, then the call answers as before.
+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}
+
+-- | 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}
+
 -- | Every request for the method fails this way until 'clearFault'.
 setFault :: FakeEthNode -> Text -> Fault -> IO ()
 setFault FakeEthNode {fnState} method f = atomically $ modifyTVar' fnState $ \s -> s {fsFaults = M.insert method f $ fsFaults s}
@@ -240,14 +253,18 @@ fakeApp st req respond = do
 
 answer :: TVar FakeState -> Text -> [J.Value] -> STM [JT.Pair]
 answer st method params = do
-  s@FakeState {fsCalls, fsSent, fsPool, fsReceipts, fsDryRuns, fsUsed, fsBlock = (number, time), fsBlockTimes, fsFees = (tip, baseFee)} <- readTVar st
+  s@FakeState {fsCalls, fsCallsOnce, 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 ->
-          pure $ case M.lookup (unAddress to, calldata) fsCalls of
-            Just (Returns ret) -> result $ hex ret
-            Just (Reverts revertData) -> rpcError 3 "execution reverted" (Just revertData)
-            Nothing -> rpcError (-32000) "no fake answer for this call" Nothing
+          let key = (unAddress to, calldata)
+              callAnswer = \case
+                Just (Returns ret) -> result $ hex ret
+                Just (Reverts revertData) -> rpcError 3 "execution reverted" (Just revertData)
+                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
     ("eth_estimateGas", call : _)
       | Just (_, calldata) <- JT.parseMaybe callTarget call,
         Just revertData <- M.lookup calldata fsDryRuns ->

tests/Bots/StoreService/NamesRecordsTests.hs

@@ -72,17 +72,22 @@ namesRecordsTests = describe "StoreService names: records" $ do
     it "checks a refused edit's repeat anew" $ testRefusedRepeat g
     it "refuses the eleventh relayed edit of a name within an hour, with the real wait" $ testCap g
     it "answers provider_unavailable and stores nothing when the chain fails before the send" $ testUnavailableBeforeSend g
+    it "stores no edit whose dry run reverted, so eleven of them leave the cap to sent edits" $ testDryRunNotCounted g
+    it "checks a dry-run-reverted edit's repeat anew" $ testDryRunRepeat g
+    it "answers provider_unavailable and stores nothing when the re-read after a dry run's revert fails" $ testDryRunReReadFails g
     it "lets a concurrent twin lose the unique insert before any signing, and answers both" $ testConcurrentTwin g
     it "answers edit_pending after the wait, and its repeat with the hash once mined" $ testPendingThenMined g
     it "answers edit_pending at once when the chain stops answering after the send" $ testChainStopsAfterSend g
   describe "outcomes" $ do
     it "answers an InvalidNonce revert of an edit another relayer applied as mined with no hash, and its repeat too" $ testAppliedByAnother g
+    it "answers a dry run's InvalidNonce revert of an edit another relayer applied as applied with no hash, storing nothing" $ testDryRunAppliedByAnother g
     it "answers a SignatureExpired revert of an edit another relayer applied as mined with no hash" $ testExpiredAppliedByAnother g
     it "answers record_reverted InvalidNonce when another body used the nonce with another value" $ testNonceTakenByAnother g
     it "frees a reverted edit's nonce for a new body, and answers the reverted edit's repeat while the new one is pending" $ testRevertFreesNonce g
-    it "keeps an edit pending when the re-read after a dry run's revert fails, and settles it in a later round" $ testFailedReRead g
+    it "keeps an edit pending when the re-read after a mined revert fails, and settles it in a later round" $ testFailedReRead g
   describe "restarts" $ do
     it "sends a saved edit that was never sent, and follows a sent one to its receipt" $ testResume g
+    it "forgets a saved edit that was never sent once its dry run reverts or its deadline passes" $ testUnsentForgotten g
     it "answers an identical repeat after a restart from the stored edit, with no chain read" $ testRepeatAfterRestart g
     it "finds an edit that expired across a restart applied, and makes it mined" $ testRestartExpiredApplied g
     it "frees an edit past its deadline while its transaction is still rebroadcast" $ testExpiryFreesNonce g
@@ -137,8 +142,10 @@ answerName s@Setup {node, owner = EphemeralWallet {ewAddress}} = do
   setRecord s channelKey ""
 
 setNonce :: Setup -> Word64 -> IO ()
-setNonce Setup {node, owner = EphemeralWallet {ewAddress}} n =
-  answerCall node fakeResolver (selector "nonces(address)" <> addressWord ewAddress) $ Returns $ uint256 n
+setNonce s@Setup {node} n = answerCall node fakeResolver (noncesCall s) $ Returns $ uint256 n
+
+noncesCall :: Setup -> ByteString
+noncesCall Setup {owner = EphemeralWallet {ewAddress}} = selector "nonces(address)" <> addressWord ewAddress
 
 setRecord :: Setup -> Text -> Text -> IO ()
 setRecord Setup {node} key value =
@@ -323,6 +330,40 @@ testUnavailableBeforeSend g = withSetup g $ \s@Setup {node, records} -> do
   h <- mineSent s 1 True
   answerOf r `shouldReturn` EAApplied (Just h)
 
+testDryRunNotCounted :: TVar ChaChaDRG -> IO ()
+testDryRunNotCounted g = withSetup g $ \s@Setup {node, records, owner} -> do
+  setFault node "eth_estimateGas" $ revertFault $ selector "InvalidSignature()"
+  forM_ [1 .. 11 :: Int] $ \n ->
+    (relayEdit records =<< signEdit s owner (channel $ "https://smp8.simplex.im/c#n" <> T.pack (show n)) 0 deadline)
+      `shouldReturn` EAReverted (Just "InvalidSignature")
+  editRows s `shouldReturn` 0
+  clearFault node "eth_estimateGas"
+  r <- relay s =<< ownerEdit s viemChannelLink
+  h <- mineSent s 1 True
+  answerOf r `shouldReturn` EAApplied (Just h)
+
+testDryRunRepeat :: TVar ChaChaDRG -> IO ()
+testDryRunRepeat g = withSetup g $ \s@Setup {node, records} -> do
+  req <- ownerEdit s viemChannelLink
+  revertDryRun node viemSetCall $ Just $ selector "InvalidSignature()"
+  relayEdit records req `shouldReturn` EAReverted (Just "InvalidSignature")
+  stateOf s req `shouldReturn` Nothing
+  revertDryRun node viemSetCall Nothing
+  r <- relay s req
+  h <- mineSent s 1 True
+  answerOf r `shouldReturn` EAApplied (Just h)
+
+testDryRunReReadFails :: TVar ChaChaDRG -> IO ()
+testDryRunReReadFails g = withSetup g $ \s@Setup {node, records} -> do
+  req <- ownerEdit s viemChannelLink
+  -- the nonce check reads it, the re-read after the revert finds no answer
+  answerCallOnce node fakeResolver (noncesCall s) $ Returns $ uint256 (0 :: Int)
+  forgetCall node fakeResolver (noncesCall s)
+  revertDryRun node viemSetCall $ Just $ selector "InvalidSignature()"
+  relayEdit records req `shouldReturn` EAUnavailable
+  editRows s `shouldReturn` 0
+  sentTransactions node `shouldReturn` []
+
 testConcurrentTwin :: TVar ChaChaDRG -> IO ()
 testConcurrentTwin g = withSetup g $ \s@Setup {node, records} -> do
   req <- ownerEdit s viemChannelLink
@@ -359,18 +400,29 @@ testChainStopsAfterSend g = withSetup g $ \s@Setup {node, records} -> do
 -- outcomes
 
 testAppliedByAnother :: TVar ChaChaDRG -> IO ()
-testAppliedByAnother g = withSetup g $ \s@Setup {node} -> do
+testAppliedByAnother g = withSetup g $ \s@Setup {node, records} -> do
   req <- ownerEdit s viemChannelLink
-  saveUnsent s req
-  -- another relayer applied it while the service was down
+  r <- relay s req
+  _ <- within $ awaitSent node 1
+  -- another relayer's transaction with the same signed edit mined first
+  setNonce s 1
+  setRecord s channelKey viemChannelLink
+  _ <- mineSent s 1 False
+  answerOf r `shouldReturn` EAApplied Nothing
+  stateOf s req `shouldReturn` Just (ESMined Nothing)
+  relayEdit records req `shouldReturn` EAApplied Nothing
+
+testDryRunAppliedByAnother :: TVar ChaChaDRG -> IO ()
+testDryRunAppliedByAnother g = withSetup g $ \s@Setup {node, records} -> do
+  req <- ownerEdit s viemChannelLink
+  -- the nonce check reads 0; another relayer applies the edit before the dry run
+  answerCallOnce node fakeResolver (noncesCall s) $ Returns $ uint256 (0 :: Int)
   setNonce s 1
   setRecord s channelKey viemChannelLink
   revertDryRun node viemSetCall $ Just $ selector "InvalidNonce()"
-  s' <- restart s
-  recordsRound (records s')
-  stateOf s req `shouldReturn` Just (ESMined Nothing)
+  relayEdit records req `shouldReturn` EAApplied Nothing
+  editRows s `shouldReturn` 0
   sentTransactions node `shouldReturn` []
-  relayEdit (records s') req `shouldReturn` EAApplied Nothing
 
 testExpiredAppliedByAnother :: TVar ChaChaDRG -> IO ()
 testExpiredAppliedByAnother g = withSetup g $ \s@Setup {node} -> do
@@ -412,22 +464,19 @@ testRevertFreesNonce g = withSetup g $ \s@Setup {node, records} -> do
   answerOf r' `shouldReturn` EAApplied (Just h)
 
 testFailedReRead :: TVar ChaChaDRG -> IO ()
-testFailedReRead g = withSetup g $ \s@Setup {node} -> do
+testFailedReRead g = withSetup g $ \s@Setup {node, records} -> do
   req <- ownerEdit s viemChannelLink
-  saveUnsent s req
-  revertDryRun node viemSetCall $ Just $ selector "InvalidSignature()"
-  s' <- restart s
+  r <- relay s req
+  _ <- within $ awaitSent node 1
   setFault node "eth_call" HttpFailure
-  recordsRound (records s')
+  _ <- mineSent s 1 False
+  answerOf r `shouldReturn` EAPending
   stateOf s req `shouldReturn` Just ESPending
-  relayEdit (records s') req `shouldReturn` EAPending
+  relayEdit records req `shouldReturn` EAPending
   clearFault node "eth_call"
-  recordsRound (records s')
-  stateOf s req `shouldReturn` Just (ESReverted $ Just "InvalidSignature")
-  relayEdit (records s') req `shouldReturn` EAReverted (Just "InvalidSignature")
-  sentTransactions node `shouldReturn` []
-
--- restarts
+  recordsRound records
+  stateOf s req `shouldReturn` Just (ESReverted Nothing)
+  relayEdit records req `shouldReturn` EAReverted Nothing
 
 testResume :: TVar ChaChaDRG -> IO ()
 testResume g = withSetup g $ \s@Setup {node, owner} -> do
@@ -450,6 +499,22 @@ testResume g = withSetup g $ \s@Setup {node, owner} -> do
   stateOf s sent `shouldReturn` Just (ESMined $ Just h')
   TxHash (C.keccak256 raw) `shouldBe` h'
 
+testUnsentForgotten :: TVar ChaChaDRG -> IO ()
+testUnsentForgotten g = withSetup g $ \s@Setup {node, owner} -> do
+  reverting <- ownerEdit s viemChannelLink
+  saveUnsent s reverting
+  revertDryRun node viemSetCall $ Just $ selector "InvalidSignature()"
+  s' <- restart s
+  recordsRound (records s')
+  stateOf s reverting `shouldReturn` Nothing
+  late <- signEdit s owner (channel viemChannelLink) 0 (deadline + 1)
+  saveUnsent s late
+  setBlock node 2 $ deadline + 1
+  recordsRound (records s')
+  stateOf s late `shouldReturn` Nothing
+  editRows s `shouldReturn` 0
+  sentTransactions node `shouldReturn` []
+
 testRepeatAfterRestart :: TVar ChaChaDRG -> IO ()
 testRepeatAfterRestart g = withSetup g $ \s@Setup {node} -> do
   req <- ownerEdit s viemChannelLink
@@ -465,14 +530,17 @@ testRepeatAfterRestart g = withSetup g $ \s@Setup {node} -> do
 testRestartExpiredApplied :: TVar ChaChaDRG -> IO ()
 testRestartExpiredApplied g = withSetup g $ \s@Setup {node} -> do
   req <- ownerEdit s viemChannelLink
-  saveUnsent s req
+  relayEdit (records s) {rsPendingAfter = shortWait} req `shouldReturn` EAPending
+  _ <- within $ awaitSent node 1
+  -- while the service is down the deadline passes, and another relayer applies the edit
   setBlock node 300 $ deadline + 1
+  setBlock node 301 $ deadline + 2
   setNonce s 1
   setRecord s channelKey viemChannelLink
   s' <- restart s
   recordsRound (records s')
   stateOf s req `shouldReturn` Just (ESMined Nothing)
-  sentTransactions node `shouldReturn` []
+  relayEdit (records s') req `shouldReturn` EAApplied Nothing
 
 testExpiryFreesNonce :: TVar ChaChaDRG -> IO ()
 testExpiryFreesNonce g = withSetup g $ \s@Setup {node, records, sender} -> do