Starting to case on era when querying pparams

cardano-scaling · Aug 7, 2024 · 24fde3c · 24fde3c
1 parent b5d5e3c
commit 24fde3c
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 8 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -23,6 +23,7 @@ import Control.Concurrent.Class.MonadSTM (
 import Control.Exception (IOException)
 import Control.Monad.Trans.Except (runExcept)
 import Hydra.Cardano.Api (
+  AnyCardanoEra (..),
   BlockInMode (..),
   CardanoEra (..),
   ChainPoint,
@@ -35,6 +36,7 @@ import Hydra.Cardano.Api (
   LocalNodeClientProtocols (..),
   LocalNodeConnectInfo (..),
   NetworkId,
+  QueryInShelleyBasedEra (..),
   SocketPath,
   Tx,
   TxInMode (..),
@@ -55,11 +57,13 @@ import Hydra.Chain (
  )
 import Hydra.Chain.CardanoClient (
   QueryPoint (..),
+  queryCurrentEraExpr,
   queryEraHistory,
-  queryProtocolParameters,
+  queryInShelleyBasedEraExpr,
   querySystemStart,
   queryTip,
   queryUTxO,
+  runQueryExpr,
  )
 import Hydra.Chain.Direct.Handlers (
   ChainSyncHandler,
@@ -80,6 +84,7 @@ import Hydra.Chain.Direct.Util (
   readKeyPair,
  )
 import Hydra.Chain.Direct.Wallet (
+  SomePParams (..),
   TinyWallet (..),
   WalletInfoOnChain (..),
   newTinyWallet,
@@ -144,7 +149,14 @@ mkTinyWallet tracer config = do
       QueryAt point -> pure point
       QueryTip -> queryTip networkId nodeSocket
     walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address]
-    pparams <- queryProtocolParameters networkId nodeSocket QueryTip
+
+    pparams <- 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
+
     systemStart <- querySystemStart networkId nodeSocket QueryTip
     epochInfo <- queryEpochInfo
     pure $ WalletInfoOnChain{walletUTxO, pparams, systemStart, epochInfo, tip = point}

diff --git a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs
@@ -133,9 +133,14 @@ data TinyWallet m = TinyWallet
   -- wallet is still initializing.
   }
 
+data SomePParams
+  = BabbagePParams (PParams Babbage)
+  | ConwayPParams (PParams Conway)
+
 data WalletInfoOnChain = WalletInfoOnChain
   { walletUTxO :: Map TxIn TxOut
-  , pparams :: Core.PParams LedgerEra
+  , pparams :: SomePParams
+  -- ^ The wallet can support Babbage or Conway; you have to pick.
   , systemStart :: SystemStart
   , epochInfo :: EpochInfo (Either Text)
   , tip :: ChainPoint
@@ -177,7 +182,8 @@ newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo = do
           WalletInfoOnChain{walletUTxO, pparams, systemStart} <- readTVarIO walletInfoVar
           pure $
             fromLedgerTx
-              <$> coverFee_ pparams systemStart epochInfo (unUTxO $ toLedgerUTxO lookupUTxO) walletUTxO (toLedgerTx partialTx)
+              <$> case pparams of
+                (BabbagePParams pp) -> coverFee_ pp systemStart epochInfo (unUTxO $ toLedgerUTxO lookupUTxO) walletUTxO (toLedgerTx partialTx)
       , reset = initialize >>= atomically . writeTVar walletInfoVar
       , update = \header txs -> do
           let point = getChainPoint header
@@ -248,10 +254,6 @@ data ErrCoverFee
 data ChangeError = ChangeError {inputBalance :: Coin, outputBalance :: Coin}
   deriving stock (Show)
 
-data SomePParams
-  = BabbagePParams (PParams Babbage)
-  | ConwayPParams (PParams Conway)
-
 -- | Cover fee for a transaction body using the given UTXO set. This calculate
 -- necessary fees and augments inputs / outputs / collateral accordingly to
 -- cover for the transaction cost and get the change back.