store: cap the names sender's fee per gas

apps/simplex-store-service/src/StoreService/Config.hs

@@ -142,7 +142,9 @@ data ChainConfig = ChainConfig
     cResolver :: Address,
     cServiceKey :: Secp256k1PrivateKey,
     cConfirmations :: Int,
-    cGasLimitCap :: Word64
+    cGasLimitCap :: Word64,
+    -- | wei; no transaction is signed with a higher max fee per gas
+    cMaxFeePerGas :: Word64
   }
   deriving (Eq)
 
@@ -185,6 +187,10 @@ requireHttps u
 minNameYears :: Int
 minNameYears = 2
 
+-- | 100 gwei.
+defaultMaxFeePerGas :: Word64
+defaultMaxFeePerGas = 100000000000
+
 defaultTermStart :: String
 defaultTermStart = "2027-01-01T00:00:00Z"
 
@@ -221,7 +227,7 @@ knownSettings =
     ("group", ["display_name", "description"]),
     ("issuer", ["index", "private_key"]),
     ("names", ["tld", "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"])
+    ("chain", ["rpc_url", "chain_id", "controller", "sponsor", "base_registrar", "resolver", "service_key", "confirmations", "gas_limit_cap", "max_fee_per_gas"])
   ]
 
 unknownKeys :: Ini -> [Text]
@@ -391,7 +397,8 @@ parseConfig ini = do
       cServiceKey <- serviceKey
       cConfirmations <- atLeast 0 "chain" "confirmations" 3
       cGasLimitCap <- positiveWord "gas_limit_cap" (Just 8000000)
-      pure ChainConfig {cRpcUrl, cChainId, cController, cSponsor, cBaseRegistrar, cResolver, cServiceKey, cConfirmations, cGasLimitCap}
+      cMaxFeePerGas <- positiveWord "max_fee_per_gas" (Just defaultMaxFeePerGas)
+      pure ChainConfig {cRpcUrl, cChainId, cController, cSponsor, cBaseRegistrar, cResolver, cServiceKey, cConfirmations, cGasLimitCap, cMaxFeePerGas}
     rpcUrl = do
       v <- required "chain" "rpc_url"
       unless (any (`T.isPrefixOf` v) ["http://", "https://"]) $ Left "chain.rpc_url must be an http or https URL"

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

@@ -84,6 +84,8 @@ data SendError
   | SESigning String
   | -- | this registration's or edit's transaction of this kind is still in flight
     SEInFlight
+  | -- | the wei per gas the latest block needs is above the configured max fee per gas
+    SEFeeAboveCap Integer
   deriving (Eq, Show)
 
 -- | Settled at the configured confirmation depth.
@@ -109,11 +111,11 @@ followInterval :: Int
 followInterval = 4000000
 
 -- | The max fee covers six full blocks in a row, each raising the base fee by 12.5%.
-baseFeeHeadroom :: Word64
+baseFeeHeadroom :: Integer
 baseFeeHeadroom = 2
 
 -- | Nodes accept a replacement only with both fees at least 10% higher.
-bumped :: Word64 -> Word64
+bumped :: Integer -> Integer
 bumped fee = fee + fee `div` 8 + 1
 
 -- | Resumes every saved transaction without a receipt. Owners resuming after a restart find theirs with 'inFlightTransaction'.
@@ -153,8 +155,14 @@ submitTransaction s@Sender {snChain = c@ChainClient {ccRegistrar}, snRandom, snS
     gas <- chain $ estimateGas c to calldata
     used <- chain $ transactionCount c ccRegistrar Latest
     nonce <- max used <$> liftIO (readTVarIO snNextNonce)
-    (tip, maxFee) <- chain $ marketFees c
-    let request = TxRequest {trTo = to, trData = calldata, trNonce = nonce, trGasLimit = gas, trMaxFeePerGas = maxFee, trMaxPriorityFeePerGas = tip}
+    market@(tip, baseFee) <- chain $ marketFees c
+    let needed = baseFee + tip
+        cap = feeCap c
+    when (needed > cap) $ do
+      logWarn $ "names sender: the latest block needs " <> tshow needed <> " wei per gas, above max_fee_per_gas " <> tshow cap <> "; the transaction waits"
+      throwError $ SEFeeAboveCap needed
+    -- both fit Word64: the tip is at most the needed fee, and the max fee at most the cap
+    let request = TxRequest {trTo = to, trData = calldata, trNonce = nonce, trGasLimit = gas, trMaxFeePerGas = fromInteger $ min cap $ headroomFee market, trMaxPriorityFeePerGas = fromInteger tip}
     SignedTx {stRaw, stHash} <- withExceptT SESigning $ ExceptT $ signTransaction snRandom c request
     liftIO $ do
       now <- snNow
@@ -229,11 +237,16 @@ replace :: Sender -> Word64 -> InFlight -> UTCTime -> IO Bool
 replace s@Sender {snChain = c, snRandom, snStore} nonce InFlight {ifFor, ifRequest = old@TxRequest {trMaxFeePerGas, trMaxPriorityFeePerGas}} now =
   marketFees c >>= \case
     Left e -> False <$ warnNonce s nonce (tshow e)
-    Right (tip, maxFee)
-      | tip <= trMaxPriorityFeePerGas && maxFee <= trMaxFeePerGas -> False <$ update s nonce (\t -> t {ifReplaceAt = later})
+    Right market@(tip, _)
+      | tip <= oldTip && headroomFee market <= oldMax -> False <$ update s nonce (\t -> t {ifReplaceAt = later})
+      | bumped oldMax > cap -> do
+          update s nonce $ \t -> t {ifReplaceAt = later}
+          False <$ warnNonce s nonce ("not replaced: a replacement would pay over max_fee_per_gas " <> tshow cap)
       | otherwise -> do
-          let maxFee' = max maxFee $ bumped trMaxFeePerGas
-              request = old {trMaxPriorityFeePerGas = max tip $ bumped trMaxPriorityFeePerGas, trMaxFeePerGas = maxFee'}
+          -- the bumped fees are at most the cap, so the replacement still outbids the old signature
+          let maxFee' = min cap $ max (headroomFee market) (bumped oldMax)
+              tip' = min maxFee' $ max tip (bumped oldTip)
+              request = old {trMaxPriorityFeePerGas = fromInteger tip', trMaxFeePerGas = fromInteger maxFee'}
           signTransaction snRandom c request >>= \case
             Left e -> False <$ logError ("names sender: replacement for nonce " <> tshow nonce <> " not signed: " <> T.pack e)
             Right SignedTx {stRaw, stHash} -> do
@@ -243,6 +256,9 @@ replace s@Sender {snChain = c, snRandom, snStore} nonce InFlight {ifFor, ifReque
               True <$ broadcast s nonce stRaw
   where
     later = addUTCTime replaceAfter now
+    oldTip = toInteger trMaxPriorityFeePerGas
+    oldMax = toInteger trMaxFeePerGas
+    cap = feeCap c
 
 -- | The confirmed hash gets its receipt's status; every other hash of the nonce can no longer be mined.
 settle :: Sender -> Word64 -> InFlight -> TxOutcome -> IO ()
@@ -264,12 +280,18 @@ settle Sender {snStore, snInFlight} nonce InFlight {ifHashes, ifOutcome} outcome
 update :: Sender -> Word64 -> (InFlight -> InFlight) -> IO ()
 update Sender {snInFlight} nonce f = atomically $ modifyTVar' snInFlight $ M.adjust f nonce
 
--- | The tip the node suggests, and the max fee from the latest base fee.
-marketFees :: ChainClient -> IO (Either ChainError (Word64, Word64))
+-- | The tip the node suggests and the latest base fee, as Integer so that no fee arithmetic wraps.
+marketFees :: ChainClient -> IO (Either ChainError (Integer, Integer))
 marketFees c = runExceptT $ do
   tip <- ExceptT $ maxPriorityFee c
   Block {blockBaseFee} <- ExceptT $ latestBlock c
-  pure (tip, baseFeeHeadroom * blockBaseFee + tip)
+  pure (toInteger tip, toInteger blockBaseFee)
+
+headroomFee :: (Integer, Integer) -> Integer
+headroomFee (tip, baseFee) = baseFeeHeadroom * baseFee + tip
+
+feeCap :: ChainClient -> Integer
+feeCap ChainClient {ccConfig = ChainConfig {cMaxFeePerGas}} = toInteger cMaxFeePerGas
 
 saveTransaction :: DBStore -> TxFor -> ByteString -> TxHash -> Word64 -> UTCTime -> IO ()
 saveTransaction st for raw hash nonce now =

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

@@ -96,3 +96,5 @@ idle_seconds = 60
 ;confirmations = 3
 ; the most gas any one transaction may use
 ;gas_limit_cap = 8000000
+; the most wei per gas any transaction may pay (100 gwei); a transaction that needs more waits
+;max_fee_per_gas = 100000000000

tests/Bots/StoreService/ConfigTests.hs

@@ -485,7 +485,7 @@ testNamesDefaults = do
   nTermSlackSeconds `shouldBe` 3600
   nRevealMarginSeconds `shouldBe` 900
   nMaxOrderMoves `shouldBe` 3
-  let ChainConfig {cRpcUrl, cChainId, cController, cSponsor, cBaseRegistrar, cResolver, cServiceKey, cConfirmations, cGasLimitCap} = nChain
+  let ChainConfig {cRpcUrl, cChainId, cController, cSponsor, cBaseRegistrar, cResolver, cServiceKey, cConfirmations, cGasLimitCap, cMaxFeePerGas} = nChain
   cRpcUrl `shouldBe` T.unpack rpcUrl
   cChainId `shouldBe` 31337
   (cController, cSponsor, cBaseRegistrar, cResolver) `shouldBe` (address controllerAddr, address sponsorAddr, address registrarAddr, address resolverAddr)
@@ -493,19 +493,22 @@ testNamesDefaults = do
   (cServiceKey == expectedKey) `shouldBe` True
   cConfirmations `shouldBe` 3
   cGasLimitCap `shouldBe` 8000000
+  cMaxFeePerGas `shouldBe` 100000000000
 
 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"]
-      cs = chainSection <> ["confirmations = 0", "gas_limit_cap = 500000"]
-  NamesConfig {nTLD, nYears, nTermStart, nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves, nChain = ChainConfig {cConfirmations, cGasLimitCap}} <- parsedNames ns cs
+      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
   nTLD `shouldBe` TLDSimplex
   nYears `shouldBe` 5
   nTermStart `shouldBe` UTCTime (fromGregorian 2027 3 1) (12 * 3600)
   (nTermSlackSeconds, nRevealMarginSeconds, nMaxOrderMoves) `shouldBe` (60, 0, 0)
-  (cConfirmations, cGasLimitCap) `shouldBe` (0, 500000)
+  (cConfirmations, cGasLimitCap, cMaxFeePerGas) `shouldBe` (0, 500000, 30000000000)
   namesRefusal ns (chainSection <> ["confirmations = -1"]) `shouldReturn` "chain.confirmations must be at least 0"
   namesRefusal ns (chainSection <> ["gas_limit_cap = 0"]) `shouldReturn` "chain.gas_limit_cap must be a positive whole number"
+  namesRefusal ns (chainSection <> ["max_fee_per_gas = 0"]) `shouldReturn` "chain.max_fee_per_gas must be a positive whole number"
+  namesRefusal ns (chainSection <> ["max_fee_per_gas = 18446744073709551616"]) `shouldReturn` "chain.max_fee_per_gas must be a positive whole number"
   namesRefusal ns (filter (not . ("chain_id" `T.isPrefixOf`)) chainSection) `shouldReturn` "chain.chain_id is required"
   namesRefusal (namesSection <> ["max_order_moves = -1"]) chainSection `shouldReturn` "names.max_order_moves must be at least 0"
 

tests/Bots/StoreService/FakeEthNode.hs

@@ -26,6 +26,7 @@ module Bots.StoreService.FakeEthNode
     fakeGas,
     fakeTip,
     fakeBaseFee,
+    fakeMaxFeePerGas,
   )
 where
 
@@ -91,10 +92,11 @@ data FakeState = FakeState
     fsClosed :: Bool
   }
 
-fakeGas, fakeTip, fakeBaseFee :: Num a => a
+fakeGas, fakeTip, fakeBaseFee, fakeMaxFeePerGas :: Num a => a
 fakeGas = 200000
 fakeTip = 1000000000
 fakeBaseFee = 2000000000
+fakeMaxFeePerGas = 100000000000
 
 fakeChainId :: Word64
 fakeChainId = 31337
@@ -143,7 +145,8 @@ fakeChainConfig FakeEthNode {fnUrl} =
       cResolver = fakeResolver,
       cServiceKey = fakeRegistrarKey,
       cConfirmations = 3,
-      cGasLimitCap = 8000000
+      cGasLimitCap = 8000000,
+      cMaxFeePerGas = fakeMaxFeePerGas
     }
 
 answerCall :: FakeEthNode -> Address -> ByteString -> CallAnswer -> IO ()

tests/Bots/StoreService/NamesSenderTests.hs

@@ -48,6 +48,8 @@ namesSenderTests = describe "StoreService names: sender" $ do
   it "hands a mined transaction whose receipt was pruned to its owner, signing nothing more" $ testPrunedReceipt g
   it "logs a round that fails on the store, and settles the transaction in the next round" $ testFailedRound g
   it "logs a send the node keeps refusing once per error, an underfunded key as an error" $ testRefusedSendLogged g
+  it "refuses a transaction whose block needs more than the fee cap, saving nothing, and signs at most the cap" $ testFeeCapSubmit g
+  it "clamps a replacement at the fee cap, and keeps rebroadcasting once a replacement would pass it" $ testFeeCapReplace g
 
 data Setup = Setup
   { node :: FakeEthNode,
@@ -57,14 +59,17 @@ data Setup = Setup
     random :: TVar ChaChaDRG
   }
 
--- | Two code orders, r1 and r2, and two confirmations.
 withSetup :: TVar ChaChaDRG -> (Setup -> IO a) -> IO a
-withSetup random action = withFakeEthNode $ \node -> withServiceStore $ \store -> do
+withSetup = withCapSetup fakeMaxFeePerGas
+
+-- | Two code orders, r1 and r2, two confirmations, and this max fee per gas.
+withCapSetup :: Word64 -> TVar ChaChaDRG -> (Setup -> IO a) -> IO a
+withCapSetup cap random action = withFakeEthNode $ \node -> withServiceStore $ \store -> do
   forM_ [(1, "r1", "alicebakery"), (2, "r2", "bobbakery")] $ \(n, rid, label) -> do
     code <- issue store n usable
     placeCode store rid ownerA (order label n) code `shouldReturn` Right ()
   clock <- newTVarIO t0
-  chain <- newChainClient random (fakeChainConfig node) {cConfirmations = 2}
+  chain <- newChainClient random (fakeChainConfig node) {cConfirmations = 2, cMaxFeePerGas = cap}
   action Setup {node, store, clock, chain, random}
 
 start :: Setup -> IO Sender
@@ -283,6 +288,49 @@ testRefusedSendLogged g = withSetup g $ \s@Setup {node} -> do
   linesWith "[" "names sender: rebroadcasting nonce 9" `shouldBe` 0
   length <$> sentTransactions node `shouldReturn` 1
 
+testFeeCapSubmit :: TVar ChaChaDRG -> IO ()
+testFeeCapSubmit g = withSetup g $ \s@Setup {node, store} -> do
+  sender <- start s
+  setFees node fakeTip (fakeMaxFeePerGas - fakeTip + 1)
+  submitTransaction sender (TxCommit r1) fakeController (commit 1) `refusedWith` SEFeeAboveCap (fakeMaxFeePerGas + 1)
+  -- twice the base fee is past Word64, which would wrap to a near-zero fee
+  let hugeBaseFee = maxBound `div` 2 + 1 :: Word64
+  setFees node fakeTip hugeBaseFee
+  submitTransaction sender (TxCommit r1) fakeController (commit 1) `refusedWith` SEFeeAboveCap (toInteger hugeBaseFee + fakeTip)
+  withTransaction store pendingTransactions `shouldReturn` []
+  sentTransactions node `shouldReturn` []
+  let baseFee = fakeMaxFeePerGas `div` 2
+  setFees node fakeTip baseFee
+  Right p <- submitTransaction sender (TxCommit r1) fakeController (commit 1)
+  ptNonce p `shouldBe` 0
+  [raw] <- sentTransactions node
+  (\TxRequest {trMaxPriorityFeePerGas, trMaxFeePerGas} -> (trMaxPriorityFeePerGas, trMaxFeePerGas)) <$> decodeSignedTx raw `shouldBe` Right (fakeTip, fakeMaxFeePerGas)
+
+testFeeCapReplace :: TVar ChaChaDRG -> IO ()
+testFeeCapReplace g = withCapSetup cap g $ \s@Setup {node} -> do
+  sender <- start s
+  Right p <- submitTransaction sender (TxCommit r1) fakeController (commit 1)
+  [firstRaw] <- sentTransactions node
+  Right first <- pure $ decodeSignedTx firstRaw
+  trMaxFeePerGas first `shouldBe` 2 * fakeBaseFee + fakeTip
+  setFees node fakeTip (2 * fakeBaseFee)
+  passTime s replaceAfter
+  followTransactions sender
+  [_, bumpedRaw] <- sentTransactions node
+  decodeSignedTx bumpedRaw `shouldBe` Right first {trMaxPriorityFeePerGas = fakeTip + fakeTip `div` 8 + 1, trMaxFeePerGas = cap}
+  passTime s replaceAfter
+  followTransactions sender
+  length <$> sentTransactions node `shouldReturn` 2
+  let bumpedHash = C.keccak256 bumpedRaw
+  dropTransaction node bumpedHash
+  followTransactions sender
+  sentTransactions node `shouldReturn` [firstRaw, bumpedRaw, bumpedRaw]
+  (fmap ptHash <$> inFlightTransaction sender (TxCommit r1)) `shouldReturn` Just (TxHash bumpedHash)
+  ptNonce p `shouldBe` 0
+  where
+    -- above the first max fee and its bump, below the market's headroom fee and a second bump
+    cap = 2 * fakeBaseFee + fakeTip + 1000000000
+
 -- fixtures
 
 r1, r2 :: RegistrationId