Query epochInfo on coverFee and expect IntersectionNotFound in tests

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -8,7 +8,6 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import CardanoClient (
-  QueryException (QueryAcquireException),
   QueryPoint (QueryTip),
   buildAddress,
   queryTip,
@@ -64,9 +63,6 @@ import Hydra.Options (
   toArgNetworkId,
  )
 import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..))
-import Ouroboros.Network.Protocol.LocalStateQuery.Type (
-  AcquireFailure (AcquireFailurePointNotOnChain),
- )
 import System.Process (proc, readCreateProcess)
 import Test.QuickCheck (generate)
 
@@ -312,7 +308,7 @@ spec = around showLogsOnFailure $ do
               threadDelay 5 >> fail "should not execute main action but did?"
 
         action `shouldThrow` \case
-          IntersectionNotFoundException{} -> True
+          IntersectionNotFound{} -> True
           _ -> False
 
   it "can publish and query reference scripts in a timely manner" $ \tracer -> do

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

@@ -188,7 +188,7 @@ withDirectChain tracer config ctx persistedPoint callback action = do
     (min <$> startChainFrom <*> persistedPoint)
       <|> persistedPoint
       <|> startChainFrom
-  wallet <- newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo
+  wallet <- newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo
   let chainHandle =
         mkChain
           tracer
@@ -217,14 +217,16 @@ withDirectChain tracer config ctx persistedPoint callback action = do
  where
   DirectChainConfig{networkId, nodeSocket, cardanoSigningKey, startChainFrom} = 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 (QueryAt point) [address]
     pparams <- toLedgerPParams (shelleyBasedEra @Api.Era) <$> queryProtocolParameters networkId nodeSocket (QueryAt point)
     systemStart <- querySystemStart networkId nodeSocket (QueryAt point)
-    epochInfo <- toEpochInfo <$> queryEraHistory networkId nodeSocket (QueryAt point)
+    epochInfo <- queryEpochInfo
     pure $ WalletInfoOnChain{walletUTxO, pparams, systemStart, epochInfo, tip = point}
 
   toEpochInfo :: EraHistory CardanoMode -> EpochInfo (Either Text)

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

@@ -115,19 +115,19 @@ mkChain tracer queryTimeHandle wallet ctx submitTx =
               -- to bootstrap the init transaction. For now, we bear with it and
               -- keep the static keys in context.
               fromPostChainTx timeHandle wallet ctx chainState tx
-                >>= finalizeTx wallet ctx chainState . toLedgerTx
             )
+            >>= finalizeTx wallet ctx chainState . toLedgerTx
         submitTx vtx
     }
 
 -- | Balance and sign the given partial transaction.
 finalizeTx ::
-  (MonadSTM m, MonadThrow (STM m)) =>
+  (MonadThrow m) =>
   TinyWallet m ->
   ChainContext ->
   ChainStateType Tx ->
   ValidatedTx LedgerEra ->
-  STM m (ValidatedTx LedgerEra)
+  m (ValidatedTx LedgerEra)
 finalizeTx TinyWallet{sign, coverFee} ctx ChainStateAt{chainState} partialTx = do
   let headUTxO = getKnownUTxO ctx <> getKnownUTxO chainState
   coverFee (Ledger.unUTxO $ toLedgerUTxO headUTxO) partialTx >>= \case

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

@@ -35,6 +35,7 @@ import Control.Arrow (left)
 import Control.Monad.Class.MonadSTM (
   check,
   newTVarIO,
+  readTVarIO,
   writeTVar,
  )
 import Data.Array (array)
@@ -86,7 +87,10 @@ data TinyWallet m = TinyWallet
   { -- | Return all known UTxO addressed to this wallet.
     getUTxO :: STM m (Map TxIn TxOut)
   , sign :: ValidatedTx LedgerEra -> ValidatedTx LedgerEra
-  , coverFee :: Map TxIn TxOut -> ValidatedTx LedgerEra -> STM m (Either ErrCoverFee (ValidatedTx LedgerEra))
+  , coverFee ::
+      Map TxIn TxOut ->
+      ValidatedTx LedgerEra ->
+      m (Either ErrCoverFee (ValidatedTx LedgerEra))
   , -- | Re-initializ wallet against the latest tip of the node and start to
     -- ignore 'update' calls until reaching that tip.
     reset :: m ()
@@ -127,16 +131,19 @@ newTinyWallet ::
   -- | A function to query UTxO, pparams, system start and epoch info from the
   -- node. Initially and on demand later.
   ChainQuery IO ->
+  IO (EpochInfo (Either Text)) ->
   IO (TinyWallet IO)
-newTinyWallet tracer networkId (vk, sk) queryWalletInfo = do
+newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo = do
   walletInfoVar <- newTVarIO =<< initialize
   pure
     TinyWallet
       { getUTxO = readTVar walletInfoVar <&> walletUTxO
       , sign = Util.signWith sk
       , coverFee = \lookupUTxO partialTx -> do
-          -- TODO: We should query pparams and epochInfo here
-          WalletInfoOnChain{walletUTxO, pparams, systemStart, epochInfo} <- readTVar walletInfoVar
+          -- XXX: We should query pparams here. If not, we likely will have
+          -- wrong fee estimation should they change in between.
+          epochInfo <- queryEpochInfo
+          WalletInfoOnChain{walletUTxO, pparams, systemStart} <- readTVarIO walletInfoVar
           pure $ coverFee_ pparams systemStart epochInfo lookupUTxO walletUTxO partialTx
       , reset = initialize >>= atomically . writeTVar walletInfoVar
       , update = \block -> do

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

@@ -80,15 +80,15 @@ 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)
+        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) (mockChainQuery vk) (pure Fixture.epochInfo)
         utxo <- atomically (getUTxO wallet)
         utxo `shouldSatisfy` \m -> Map.size m > 0
 
     -- TODO: This test has become a bit pointless
     prop "re-queries UTxO from the tip after reset" $
       forAll genKeyPair $ \(vk, sk) -> do
         (queryFn, assertQueryPoint) <- setupQuery vk
-        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) queryFn
+        wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) queryFn (pure Fixture.epochInfo)
         assertQueryPoint QueryTip
         reset wallet
         assertQueryPoint QueryTip