Merge pull request #5799 from IntersectMBO/mgalazyn/test/replace-cli-…

…queries-with-foldepochstate

Replace CLI queries in testnet test cases with EpochStateView usage

cardano-testnet/src/Testnet/Components/DReps.hs

@@ -292,7 +292,7 @@ registerDRep execConfig epochStateView ceo work prefix wallet = do
       era = toCardanoEra sbe
       cEra = AnyCardanoEra era
 
-  minDRepDeposit <- getMinDRepDeposit execConfig ceo
+  minDRepDeposit <- getMinDRepDeposit epochStateView ceo
 
   baseDir <- H.createDirectoryIfMissing $ work </> prefix
   drepKeyPair <- generateDRepKeyPair execConfig baseDir "keys"

cardano-testnet/src/Testnet/Components/Query.hs

@@ -11,7 +11,7 @@ module Testnet.Components.Query
   , getEpochState
   , getMinDRepDeposit
   , getGovState
-  , queryTip
+  , getCurrentEpochNo
   , waitUntilEpoch
   , waitForEpochs
   , getEpochStateView
@@ -20,23 +20,23 @@ module Testnet.Components.Query
   , findLargestUtxoWithAddress
   , findLargestUtxoForPaymentKey
   , startLedgerNewEpochStateLogging
-  , getCurrentEpochNo
   ) where
 
 import           Cardano.Api as Api
 import           Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto)
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
-import           Cardano.CLI.Types.Output
+import qualified Cardano.Ledger.Api as L
 import           Cardano.Ledger.BaseTypes (EpochInterval, addEpochInterval)
+import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.Conway.Governance as L
+import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UTxO as L
 
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad.Trans.Resource
 import           Control.Monad.Trans.State.Strict (put)
-import           Data.Aeson as A
-import           Data.Aeson.Lens (_Integral, key)
 import           Data.Bifunctor (bimap)
 import           Data.IORef
 import           Data.List (sortOn)
@@ -50,18 +50,15 @@ import qualified Data.Text as T
 import           Data.Type.Equality
 import           GHC.Exts (IsList (..))
 import           GHC.Stack
-import           Lens.Micro ((^.), (^?))
+import           Lens.Micro (to, (^.))
 
-import qualified Testnet.Process.Cli as H
 import           Testnet.Property.Assert
 import           Testnet.Property.Utils (runInBackground)
 import           Testnet.Runtime
-import           Testnet.Start.Types (eraToString)
 
 import qualified Hedgehog as H
 import           Hedgehog.Extras (MonadAssertion)
 import qualified Hedgehog.Extras as H
-import           Hedgehog.Extras.Test.Process (ExecConfig)
 import           Hedgehog.Internal.Property (MonadTest)
 
 -- | Block and wait for the desired epoch.
@@ -89,27 +86,21 @@ waitUntilEpoch nodeConfigFile socketPath desiredEpoch = withFrozenCallStack $ do
 -- | Wait for the number of epochs
 waitForEpochs
   :: MonadTest m
-  => MonadCatch m
+  => MonadAssertion m
   => MonadIO m
-  => ExecConfig
-  -> NodeConfigFile In
-  -> SocketPath
+  => EpochStateView
   -> EpochInterval  -- ^ Number of epochs to wait
   -> m EpochNo -- ^ The epoch number reached
-waitForEpochs execConfig nodeConfigFile socketPath interval = withFrozenCallStack $ do
-  currentEpoch <- H.nothingFailM $ mEpoch <$> queryTip execConfig
-  waitUntilEpoch nodeConfigFile socketPath $ addEpochInterval currentEpoch interval
-
--- | Query the tip of the blockchain
-queryTip
-  :: (MonadCatch m, MonadIO m, MonadTest m, HasCallStack)
-  => ExecConfig
-  -> m QueryTipLocalStateOutput
-queryTip execConfig = withFrozenCallStack $
-  H.execCliStdoutToJson execConfig [ "query", "tip" ]
+waitForEpochs epochStateView@EpochStateView{nodeConfigPath, socketPath} interval = withFrozenCallStack $ do
+  currentEpoch <- getCurrentEpochNo epochStateView
+  waitUntilEpoch nodeConfigPath socketPath $ addEpochInterval currentEpoch interval
 
 -- | A read-only mutable pointer to an epoch state, updated automatically
-newtype EpochStateView = EpochStateView (IORef (Maybe AnyNewEpochState))
+data EpochStateView = EpochStateView
+  { nodeConfigPath :: !(NodeConfigFile In)
+  , socketPath :: !SocketPath
+  , epochStateView :: !(IORef (Maybe AnyNewEpochState))
+  }
 
 -- | Get epoch state from the view. If the state isn't available, retry waiting up to 15 seconds. Fails when
 -- the state is not available after 15 seconds.
@@ -118,10 +109,10 @@ getEpochState :: MonadTest m
               => MonadIO m
               => EpochStateView
               -> m AnyNewEpochState
-getEpochState (EpochStateView esv) =
+getEpochState EpochStateView{epochStateView} =
   withFrozenCallStack $
     H.byDurationM 0.5 15 "EpochStateView has not been initialized within 15 seconds" $
-      H.evalIO (readIORef esv) >>= maybe H.failure pure
+      H.evalIO (readIORef epochStateView) >>= maybe H.failure pure
 
 
 -- | Create a background thread listening for new epoch states. New epoch states are available to access
@@ -140,7 +131,7 @@ getEpochStateView nodeConfigFile socketPath = withFrozenCallStack $ do
     $ \epochState _slotNb _blockNb -> do
         liftIO $ writeIORef epochStateView (Just epochState)
         pure ConditionNotMet
-  pure . EpochStateView $ epochStateView
+  pure $ EpochStateView nodeConfigFile socketPath epochStateView
 
 -- | Retrieve all UTxOs map from the epoch state view.
 findAllUtxos
@@ -234,18 +225,18 @@ findLargestUtxoForPaymentKey epochStateView sbe address =
 -- this number is not attained before two epochs, the test is failed.
 checkDRepsNumber
   :: HasCallStack
-  => MonadCatch m
+  => MonadAssertion m
   => MonadIO m
   => MonadTest m
-  => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
-  -> NodeConfigFile 'In
-  -> SocketPath
-  -> H.ExecConfig
+  => EpochStateView
+  -> ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
   -> Int
   -> m ()
-checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = withFrozenCallStack $
-  checkDRepState sbe configurationFile socketPath execConfig
-    (\m -> if length m == expectedDRepsNb then Just () else Nothing)
+checkDRepsNumber epochStateView sbe expectedDRepsNumber = withFrozenCallStack $
+  checkDRepState epochStateView sbe $ \dreps ->
+    if length dreps == expectedDRepsNumber
+       then Just ()
+       else Nothing
 
 -- | @checkDRepState sbe configurationFile socketPath execConfig f@
 -- This functions helps check properties about the DRep state.
@@ -254,38 +245,32 @@ checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = w
 -- If @f@ returns 'Just', the contents of the 'Just' are returned.
 checkDRepState
   :: HasCallStack
-  => MonadCatch m
+  => MonadAssertion m
   => MonadIO m
   => MonadTest m
-  => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
-  -> NodeConfigFile In
-  -> SocketPath
-  -> H.ExecConfig
+  => EpochStateView
+  -> ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
   -> (Map (Credential 'DRepRole StandardCrypto)
           (DRepState StandardCrypto)
       -> Maybe a) -- ^ A function that checks whether the DRep state is correct or up to date
                   -- and potentially inspects it.
   -> m a
-checkDRepState sbe configurationFile socketPath execConfig f = withFrozenCallStack $ do
-  QueryTipLocalStateOutput{mEpoch} <- queryTip execConfig
-  currentEpoch <- H.evalMaybe mEpoch
+checkDRepState epochStateView@EpochStateView{nodeConfigPath, socketPath} sbe f = withFrozenCallStack $ do
+  currentEpoch <- getCurrentEpochNo epochStateView
   let terminationEpoch = succ . succ $ currentEpoch
-  result <- H.evalIO . runExceptT $ foldEpochState configurationFile socketPath QuickValidation terminationEpoch Nothing
+  result <- H.evalIO . runExceptT $ foldEpochState nodeConfigPath socketPath QuickValidation terminationEpoch Nothing
       $ \(AnyNewEpochState actualEra newEpochState) _slotNb _blockNb -> do
-        case testEquality sbe actualEra of
-          Just Refl -> do
-            let dreps = shelleyBasedEraConstraints sbe newEpochState
-                          ^. L.nesEsL
-                           . L.esLStateL
-                           . L.lsCertStateL
-                           . L.certVStateL
-                           . L.vsDRepsL
-            case f dreps of
-              Nothing -> pure ConditionNotMet
-              Just a -> do put $ Just a
-                           pure ConditionMet
-          Nothing -> do
-            error $ "Eras mismatch! expected: " <> show sbe <> ", actual: " <> show actualEra
+        Refl <- either error pure $ assertErasEqual sbe actualEra
+        let dreps = shelleyBasedEraConstraints sbe newEpochState
+                      ^. L.nesEsL
+                       . L.esLStateL
+                       . L.lsCertStateL
+                       . L.certVStateL
+                       . L.vsDRepsL
+        case f dreps of
+          Nothing -> pure ConditionNotMet
+          Just a -> do put $ Just a
+                       pure ConditionMet
   case result of
     Left (FoldBlocksApplyBlockError (TerminationEpochReached epochNo)) -> do
       H.note_ $ unlines
@@ -313,39 +298,42 @@ checkDRepState sbe configurationFile socketPath execConfig f = withFrozenCallSta
 -- | Obtain governance state from node (CLI query)
 getGovState
   :: HasCallStack
-  => MonadCatch m
+  => MonadAssertion m
   => MonadIO m
   => MonadTest m
-  => H.ExecConfig
+  => EpochStateView
   -> ConwayEraOnwards era
-  -> m A.Value -- ^ The governance state
-getGovState execConfig ceo = withFrozenCallStack $ do
-  let eraName = eraToString $ toCardanoEra ceo
-  H.execCliStdoutToJson execConfig
-      [ eraName, "query", "gov-state" , "--volatile-tip" ]
-
+  -> m (L.ConwayGovState (ShelleyLedgerEra era)) -- ^ The governance state
+getGovState epochStateView ceo = withFrozenCallStack $ do
+  AnyNewEpochState sbe' newEpochState <- getEpochState epochStateView
+  let sbe = conwayEraOnwardsToShelleyBasedEra ceo
+  Refl <- H.leftFail $ assertErasEqual sbe sbe'
+  pure $ conwayEraOnwardsConstraints ceo $ newEpochState ^. L.newEpochStateGovStateL
 
 -- | Obtain minimum deposit amount for DRep registration from node
 getMinDRepDeposit
   :: HasCallStack
-  => MonadCatch m
+  => MonadAssertion m
   => MonadIO m
   => MonadTest m
-  => H.ExecConfig
+  => EpochStateView
   -> ConwayEraOnwards era
-  -> m Integer
-getMinDRepDeposit execConfig ceo = withFrozenCallStack $ do
-  govState <- getGovState execConfig ceo
-  let mMinDRepDeposit :: Maybe Integer
-      mMinDRepDeposit = govState ^? key "currentPParams"
-                                  . key "dRepDeposit"
-                                  . _Integral
-  H.evalMaybe mMinDRepDeposit
+  -> m Integer -- ^ The governance state
+getMinDRepDeposit epochStateView ceo = withFrozenCallStack $ do
+  govState <- getGovState epochStateView ceo
+  pure $ conwayEraOnwardsConstraints ceo $ govState ^. L.cgsCurPParamsL . L.ppDRepDepositL . to L.unCoin
 
--- | Obtain current epoch number using 'getEpochState'
-getCurrentEpochNo :: (MonadTest m, MonadAssertion m, MonadIO m)
+-- | Return current-ish epoch number.
+-- Because we're using Ledger's 'NewEpochState', the returned epoch number won't be reflecting the current
+-- epoch number during the transiontion between the epochs. In other cases it will be the true number of the
+-- current epoch.
+getCurrentEpochNo
+  :: HasCallStack
+  => MonadAssertion m
+  => MonadIO m
+  => MonadTest m
   => EpochStateView
   -> m EpochNo
-getCurrentEpochNo epochStateView = do
+getCurrentEpochNo epochStateView = withFrozenCallStack $ do
   AnyNewEpochState _ newEpochState <- getEpochState epochStateView
-  return $ newEpochState ^. L.nesELL
+  pure $ newEpochState ^. L.nesELL

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/DRepRetirement.hs

@@ -11,7 +11,6 @@ module Cardano.Testnet.Test.Cli.Conway.DRepRetirement
   ) where
 
 import           Cardano.Api
-import qualified Cardano.Api as Api
 
 import           Cardano.Testnet
 
@@ -89,10 +88,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
                       , P.signingKeyFile = stakeSKeyFp
                       }
   let sizeBefore = 3
-      configFile' = Api.File configurationFile
-      socketPath' = Api.File socketPath
-
-  checkDRepsNumber sbe configFile' socketPath' execConfig sizeBefore
+  checkDRepsNumber epochStateView sbe sizeBefore
 
   -- Deregister first DRep
   let dreprRetirementCertFile = gov </> "drep-keys" <> "drep1.retirementcert"
@@ -140,5 +136,5 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
 
   -- The important bit is that we pass (sizeBefore - 1) as the last argument,
   -- to witness that the number of dreps indeed decreased.
-  checkDRepsNumber sbe configFile' socketPath' execConfig (sizeBefore - 1)
+  checkDRepsNumber epochStateView sbe (sizeBefore - 1)
   H.success

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Queries.hs

@@ -11,7 +11,6 @@ module Cardano.Testnet.Test.Cli.Queries
   ) where
 
 import           Cardano.Api
-import qualified Cardano.Api as Api
 
 import           Cardano.CLI.Types.Output (QueryTipLocalStateOutput)
 import           Cardano.Testnet
@@ -24,7 +23,7 @@ import qualified Data.Vector as Vector
 import           GHC.Stack (HasCallStack)
 import           System.FilePath ((</>))
 
-import           Testnet.Components.Query (checkDRepsNumber)
+import           Testnet.Components.Query
 import           Testnet.Components.TestWatchdog
 import qualified Testnet.Process.Cli as H
 import qualified Testnet.Process.Run as H
@@ -72,13 +71,15 @@ hprop_cli_queries = H.integrationWorkspace "cli-queries" $ \tempAbsBasePath' ->
       socketBase = IO.sprocketBase poolSprocket1 -- /tmp
       socketPath = socketBase </> socketName'
 
+  epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
+
   H.note_ $ "Sprocket: " <> show poolSprocket1
   H.note_ $ "Abs path: " <> tempAbsBasePath'
   H.note_ $ "Socketpath: " <> socketPath
   H.note_ $ "Foldblocks config file: " <> configurationFile
 
   -- TODO: we could wait less: waiting 1 block should suffice.
-  checkDRepsNumber sbe (Api.File configurationFile) (Api.File socketPath) execConfig 3
+  checkDRepsNumber epochStateView sbe 3
 
   -- protocol-parameters to stdout
   protocolParametersOut <- H.execCli' execConfig

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepActivity.hs

@@ -113,8 +113,10 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas
   delegateToDRep execConfig epochStateView configurationFile socketPath sbe work "drep3-delegation"
                  wallet1 (defaultDelegatorStakeKeyPair 3) drep3
 
-  expirationDates <- checkDRepState sbe (File configurationFile) (File socketPath) execConfig
-                                    (\m -> if length m == 3 then Just $ Map.map drepExpiry m else Nothing)
+  expirationDates <- checkDRepState epochStateView sbe $ \m ->
+    if length m == 3
+       then Just $ Map.map drepExpiry m
+       else Nothing
   H.note_ $ "Expiration dates for the registered DReps: " ++ show expirationDates
 
   -- This proposal should fail because there is 2 DReps that don't vote (out of 3)
@@ -268,7 +270,7 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat
     , "hash", "anchor-data", "--file-text", proposalAnchorFile
     ]
 
-  minDRepDeposit <- getMinDRepDeposit execConfig ceo
+  minDRepDeposit <- getMinDRepDeposit epochStateView ceo
 
   proposalFile <- H.note $ baseDir </> "sample-proposal-anchor"
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs

@@ -80,7 +80,7 @@ hprop_ledger_events_drep_deposits = H.integrationWorkspace "drep-deposits" $ \te
 
   gov <- H.createDirectoryIfMissing $ work </> "governance"
 
-  minDRepDeposit <- getMinDRepDeposit execConfig ceo
+  minDRepDeposit <- getMinDRepDeposit epochStateView ceo
 
   -- DRep 1 (not enough deposit)
 
@@ -100,7 +100,9 @@ hprop_ledger_events_drep_deposits = H.integrationWorkspace "drep-deposits" $ \te
 
   void $ registerDRep execConfig epochStateView ceo work "drep2" wallet1
 
-  checkDRepState sbe (File configurationFile) (File socketPath) execConfig
-    (\m -> if map L.drepDeposit (Map.elems m) == [L.Coin minDRepDeposit] then Just () else Nothing)
+  checkDRepState epochStateView sbe $ \m ->
+    if map L.drepDeposit (Map.elems m) == [L.Coin minDRepDeposit]
+       then Just ()
+       else Nothing