Merge pull request #4805 from input-output-hk/newhoggy/query-stake-sn…

…apshot-integration-test

New query stake-snapshot integration test

cardano-testnet/cardano-testnet.cabal

@@ -108,6 +108,7 @@ test-suite cardano-testnet-tests
 
   other-modules:        Test.Cli.Alonzo.LeadershipSchedule
                         Test.Cli.Babbage.LeadershipSchedule
+                        Test.Cli.Babbage.StakeSnapshot
                         Test.Cli.KesPeriodInfo
                         Test.FoldBlocks
                         Test.Misc
@@ -118,6 +119,7 @@ test-suite cardano-testnet-tests
 
   build-depends:        aeson
                       , async
+                      , bytestring
                       , cardano-api
                       , cardano-cli
                       , cardano-testnet

cardano-testnet/test/Main.hs

@@ -13,6 +13,7 @@ import qualified Test.Tasty.Ingredients as T
 
 --import qualified Test.Cli.Alonzo.LeadershipSchedule
 import qualified Test.Cli.Babbage.LeadershipSchedule
+import qualified Test.Cli.Babbage.StakeSnapshot
 import qualified Test.Cli.KesPeriodInfo
 import qualified Test.FoldBlocks
 import qualified Test.Node.Shutdown
@@ -31,6 +32,7 @@ tests = pure $ T.testGroup "test/Spec.hs"
     --   ]
     , T.testGroup "Babbage"
       [ H.ignoreOnWindows "leadership-schedule" Test.Cli.Babbage.LeadershipSchedule.hprop_leadershipSchedule
+      , H.ignoreOnWindows "stake-snapshot" Test.Cli.Babbage.StakeSnapshot.hprop_stakeSnapshot
       ]
       -- Ignored on Windows due to <stdout>: commitBuffer: invalid argument (invalid character)
       -- as a result of the kes-period-info output to stdout.

cardano-testnet/test/Test/Cli/Babbage/StakeSnapshot.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{- HLINT ignore "Redundant id" -}
+{- HLINT ignore "Redundant return" -}
+{- HLINT ignore "Use head" -}
+{- HLINT ignore "Use let" -}
+
+module Test.Cli.Babbage.StakeSnapshot
+  ( hprop_stakeSnapshot
+  ) where
+
+import           Prelude
+
+import           Control.Monad (void)
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString.Lazy as LBS
+import           Data.Monoid (Last (..))
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import qualified Data.Time.Clock as DTC
+import           GHC.Stack (callStack)
+import qualified System.Directory as IO
+import           System.Environment (getEnvironment)
+import           System.FilePath ((</>))
+import qualified System.Info as SYS
+
+import           Cardano.CLI.Shelley.Output (QueryTipLocalStateOutput (..))
+import           Cardano.Testnet
+
+import           Hedgehog (Property, (===))
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.File as H
+import qualified Hedgehog.Extras.Test.Process as H
+import           Testnet.Util.Process
+import           Testnet.Util.Runtime
+
+hprop_stakeSnapshot :: Property
+hprop_stakeSnapshot = integration . H.runFinallies . H.workspace "alonzo" $ \tempAbsBasePath' -> do
+  H.note_ SYS.os
+  base <- H.note =<< H.noteIO . IO.canonicalizePath =<< H.getProjectBase
+  configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"
+  conf@Conf { tempBaseAbsPath, tempAbsPath } <- H.noteShowM $
+    mkConf (ProjectBase base) (YamlFilePath configurationTemplate) tempAbsBasePath' Nothing
+
+  work <- H.note $ tempAbsPath </> "work"
+  H.createDirectoryIfMissing work
+
+  let
+    testnetOptions = BabbageOnlyTestnetOptions $ babbageDefaultTestnetOptions
+      { babbageNodeLoggingFormat = NodeLoggingFormatAsJson
+      }
+
+  TestnetRuntime
+    { testnetMagic
+    , poolNodes
+    } <- testnet testnetOptions conf
+
+  poolNode1 <- H.headM poolNodes
+
+  env <- H.evalIO getEnvironment
+
+  poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
+
+  execConfig <- H.noteShow H.ExecConfig
+    { H.execConfigEnv = Last $ Just $
+      [ ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName poolSprocket1)
+      ]
+      -- The environment must be passed onto child process on Windows in order to
+      -- successfully start that process.
+      <> env
+    , H.execConfigCwd = Last $ Just tempBaseAbsPath
+    }
+
+  tipDeadline <- H.noteShowM $ DTC.addUTCTime 210 <$> H.noteShowIO DTC.getCurrentTime
+
+  H.byDeadlineM 10 tipDeadline "Wait for two epochs" $ do
+    void $ execCli' execConfig
+      [ "query", "tip"
+      , "--testnet-magic", show @Int testnetMagic
+      , "--out-file", work </> "current-tip.json"
+      ]
+
+    tipJson <- H.leftFailM . H.readJsonFile $ work </> "current-tip.json"
+    tip <- H.noteShowM $ H.jsonErrorFail $ Aeson.fromJSON @QueryTipLocalStateOutput tipJson
+
+    currEpoch <- case mEpoch tip of
+      Nothing -> H.failMessage callStack "cardano-cli query tip returned Nothing for EpochNo"
+      Just currEpoch -> return currEpoch
+
+    H.note_ $ "Current Epoch: " <> show currEpoch
+    H.assert $ currEpoch > 2
+
+  result <- execCli' execConfig
+    [ "query", "stake-snapshot"
+    , "--testnet-magic", show @Int testnetMagic
+    , "--all-stake-pools"
+    ]
+
+  json <- H.leftFail $ Aeson.eitherDecode @Aeson.Value (LBS.fromStrict (Text.encodeUtf8 (Text.pack result)))
+
+  -- There are three stake pools so check that "pools" has three entries
+  case json of
+    Aeson.Object kmJson -> do
+      pools <- H.nothingFail $ KM.lookup "pools" kmJson
+      case pools of
+        Aeson.Object kmPools -> KM.size kmPools === 3
+        _ -> H.failure
+    _ -> H.failure