Only query protocol params on each coverFee invocation

This also fails now with an era mismatch exception

hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs

@@ -56,8 +56,8 @@ import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
 import Cardano.Ledger.Conway.Scripts qualified as Conway
 import Cardano.Ledger.Conway.TxBody qualified as Ledger
-import Cardano.Ledger.Language qualified as Ledger
 import Cardano.Ledger.Plutus.Data (upgradeData)
+import Cardano.Ledger.Plutus.Language qualified as Ledger
 import Control.Lens ((&), (.~), (^.))
 import Data.Bifunctor (bimap)
 import Data.Functor ((<&>))

hydra-node/src/Hydra/Chain/CardanoClient.hs

@@ -49,7 +49,7 @@ instance Exception QueryException where
     QueryAcquireException failure -> show failure
     QueryEraMismatchException EraMismatch{ledgerEraName, otherEraName} ->
       -- NOTE: The "ledger" here is the the one in the cardano-node and "otherEra" is the one we picked for the query.
-      printf "Connected to cardano-node in unsupported era %s. Please upgrade your hydra-node to era %s." ledgerEraName otherEraName
+      printf "Connected to cardano-node in unsupported era %s, while we requested %s. Please upgrade your hydra-node." ledgerEraName otherEraName
     QueryProtocolParamsConversionException err -> show err
     QueryProtocolParamsEraNotSupported unsupportedEraName ->
       printf "Error while querying protocol params using era %s." (show unsupportedEraName :: Text)

hydra-node/src/Hydra/Chain/Direct.hs

@@ -58,6 +58,7 @@ import Hydra.Chain (
   currentState,
  )
 import Hydra.Chain.CardanoClient (
+  QueryException (..),
   QueryPoint (..),
   queryCurrentEraExpr,
   queryEraHistory,
@@ -94,6 +95,7 @@ import Hydra.Chain.Direct.Wallet (
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (DirectChainConfig (..))
 import Hydra.Party (Party)
+import Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 import Ouroboros.Consensus.HardFork.History qualified as Consensus
 import Ouroboros.Network.Magic (NetworkMagic (..))
 import Ouroboros.Network.Protocol.ChainSync.Client (
@@ -140,28 +142,27 @@ mkTinyWallet ::
   IO (TinyWallet IO)
 mkTinyWallet tracer config = do
   keyPair <- readKeyPair cardanoSigningKey
-  newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo
+  newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
  where
   DirectChainConfig{networkId, nodeSocket, cardanoSigningKey} = config
 
   queryEpochInfo = toEpochInfo <$> queryEraHistory networkId nodeSocket QueryTip
 
-  queryWalletInfo queryPoint address = do
-    point <- case queryPoint of
-      QueryAt point -> pure point
-      QueryTip -> queryTip networkId nodeSocket
-    walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address]
-
-    pparams <- runQueryExpr networkId nodeSocket QueryTip $ do
+  querySomePParams =
+    runQueryExpr networkId nodeSocket QueryTip $ do
       AnyCardanoEra era <- queryCurrentEraExpr
       case era of
         BabbageEra{} -> BabbagePParams <$> queryInShelleyBasedEraExpr shelleyBasedEra QueryProtocolParameters
         ConwayEra{} -> ConwayPParams <$> queryInShelleyBasedEraExpr shelleyBasedEra QueryProtocolParameters
-        _ -> error $ "Unsupported era: " <> show era
+        _ -> liftIO . throwIO $ QueryEraMismatchException EraMismatch{ledgerEraName = show era, otherEraName = "Babbage or Conway"}
 
+  queryWalletInfo queryPoint address = do
+    point <- case queryPoint of
+      QueryAt point -> pure point
+      QueryTip -> queryTip networkId nodeSocket
+    walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address]
     systemStart <- querySystemStart networkId nodeSocket QueryTip
-    epochInfo <- queryEpochInfo
-    pure $ WalletInfoOnChain{walletUTxO, pparams, systemStart, epochInfo, tip = point}
+    pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
 
   toEpochInfo :: EraHistory -> EpochInfo (Either Text)
   toEpochInfo (EraHistory interpreter) =

hydra-node/src/Hydra/Chain/Direct/Wallet.hs

@@ -70,7 +70,7 @@ import Cardano.Ledger.Val (invert)
 import Cardano.Slotting.EpochInfo (EpochInfo)
 import Cardano.Slotting.Time (SystemStart (..))
 import Control.Arrow (left)
-import Control.Concurrent.Class.MonadSTM (check, newTVarIO, writeTVar)
+import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar)
 import Control.Lens (view, (%~), (.~), (^.))
 import Data.List qualified as List
 import Data.Map.Strict ((!))
@@ -145,10 +145,7 @@ data SomePParams
 
 data WalletInfoOnChain = WalletInfoOnChain
   { walletUTxO :: Map TxIn TxOut
-  , pparams :: SomePParams
-  -- ^ The wallet can support Babbage or Conway; you have to pick.
   , systemStart :: SystemStart
-  , epochInfo :: EpochInfo (Either Text)
   , tip :: ChainPoint
   -- ^ Latest point on chain the wallet knows of.
   }
@@ -172,8 +169,10 @@ newTinyWallet ::
   -- node. Initially and on demand later.
   ChainQuery IO ->
   IO (EpochInfo (Either Text)) ->
+  -- | A means to query some pparams.
+  IO SomePParams ->
   IO (TinyWallet IO)
-newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo = do
+newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo querySomePParams = do
   walletInfoVar <- newTVarIO =<< initialize
   let getUTxO = readTVar walletInfoVar <&> walletUTxO
   pure
@@ -183,12 +182,11 @@ newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo = do
       , sign = Api.signTx sk
       , coverFee = \lookupUTxO partialTx -> do
           let ledgerLookupUTxO = unUTxO $ toLedgerUTxO lookupUTxO
-          -- We query pparams here again as it's possible that a hardfork occurred
-          -- and the pparams changed.
-          -- FIXME: Only query the pparams again, not the entire wallet info
-          currentWalletInfo@WalletInfoOnChain{walletUTxO, pparams, systemStart} <- queryWalletInfo QueryTip address
+          WalletInfoOnChain{walletUTxO, systemStart} <- readTVarIO walletInfoVar
           epochInfo <- queryEpochInfo
-          atomically $ writeTVar walletInfoVar currentWalletInfo
+          -- We query pparams here again as it's possible that a hardfork
+          -- occurred and the pparams changed.
+          pparams <- querySomePParams
           pure $
             case pparams of
               BabbagePParams pp ->
@@ -262,7 +260,7 @@ data ErrCoverFee
   = ErrNotEnoughFunds ChangeError
   | ErrNoFuelUTxOFound
   | ErrUnknownInput {input :: TxIn}
-  | ErrScriptExecutionFailed {redeemerPointer :: Text, scriptFailure :: Text} -- FIXME: try to avoid Text
+  | ErrScriptExecutionFailed {redeemerPointer :: Text, scriptFailure :: Text}
   | ErrTranslationError (ContextError LedgerEra)
   | ErrConwayUpgradeError (TxUpgradeError Conway)
   deriving stock (Show)

hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs

@@ -13,6 +13,7 @@ import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core (Tx, Value)
 import Cardano.Ledger.SafeHash qualified as SafeHash
 import Cardano.Ledger.Shelley.API qualified as Ledger
+import Cardano.Ledger.Slot (EpochInfo)
 import Cardano.Ledger.Val (Val (..), invert)
 import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
 import Control.Lens (view, (.~), (<>~), (^.))
@@ -95,14 +96,14 @@ spec = parallel $ do
   describe "newTinyWallet" $ do
     prop "initialises wallet by querying UTxO" $
       forAll genKeyPair $ \(vk, sk) -> do
-        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) (mockChainQuery vk) (pure Fixture.epochInfo)
+        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) (mockChainQuery vk) mockQueryEpochInfo mockQueryPParams
         utxo <- atomically (getUTxO wallet)
         utxo `shouldSatisfy` \m -> Map.size m > 0
 
     prop "re-queries UTxO from the tip, even on reset" $
       forAll genKeyPair $ \(vk, sk) -> do
         (queryFn, assertQueryPoint) <- setupQuery vk
-        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) queryFn (pure Fixture.epochInfo)
+        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) queryFn mockQueryEpochInfo mockQueryPParams
         assertQueryPoint QueryTip
         reset wallet
         assertQueryPoint QueryTip
@@ -121,9 +122,7 @@ setupQuery vk = do
     pure $
       WalletInfoOnChain
         { walletUTxO
-        , pparams = BabbagePParams Fixture.pparams
         , systemStart = Fixture.systemStart
-        , epochInfo = Fixture.epochInfo
         , tip
         }
 
@@ -139,12 +138,16 @@ mockChainQuery vk _point addr = do
   pure $
     WalletInfoOnChain
       { walletUTxO
-      , pparams = BabbagePParams Fixture.pparams
       , systemStart = Fixture.systemStart
-      , epochInfo = Fixture.epochInfo
       , tip
       }
 
+mockQueryEpochInfo :: IO (EpochInfo (Either Text))
+mockQueryEpochInfo = pure Fixture.epochInfo
+
+mockQueryPParams :: IO SomePParams
+mockQueryPParams = pure $ BabbagePParams Fixture.pparams
+
 --
 -- Generators
 --