Move common testnet functions to test/Helpers.hs for reuse

marconi/marconi.cabal

@@ -135,7 +135,9 @@ test-suite marconi-test
   type:           exitcode-stdio-1.0
   main-is:        Spec.hs
   hs-source-dirs: test
-  other-modules:  Integration
+  other-modules:
+    Helpers
+    Integration
 
   --------------------
   -- Local components

marconi/test/Helpers.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE LambdaCase     #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Helpers where
+
+import Control.Monad (when)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Hedgehog (MonadTest, assert)
+import System.FilePath ((</>))
+
+import Cardano.Api qualified as C
+import Data.Set qualified as Set
+import GHC.Stack qualified as GHC
+import Hedgehog qualified as H
+import Hedgehog.Extras.Stock.IO.Network.Sprocket qualified as IO
+import Hedgehog.Extras.Test qualified as HE
+import Hedgehog.Extras.Test.Base qualified as H
+import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (SubmitFail, SubmitSuccess))
+import System.Directory qualified as IO
+import System.Environment qualified as IO
+import System.IO.Temp qualified as IO
+import System.Info qualified as IO
+import Testnet.Cardano qualified as TN
+import Testnet.Conf qualified as TC (Conf (..), ProjectBase (ProjectBase), YamlFilePath (YamlFilePath), mkConf)
+
+-- * Helpers
+
+startTestnet :: FilePath -> FilePath -> H.Integration (String, C.NetworkId, FilePath)
+startTestnet base tempAbsBasePath' = do
+  configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"
+  conf@TC.Conf { TC.tempBaseAbsPath, TC.tempAbsPath } <- HE.noteShowM $
+    TC.mkConf (TC.ProjectBase base) (TC.YamlFilePath configurationTemplate)
+      (tempAbsBasePath' <> "/")
+      Nothing
+  assert $ tempAbsPath == (tempAbsBasePath' <> "/")
+        && tempAbsPath == (tempBaseAbsPath <> "/")
+  tn <- TN.testnet TN.defaultTestnetOptions conf
+  let networkId = C.Testnet $ C.NetworkMagic $ fromIntegral (TN.testnetMagic tn)
+  socketPath <- IO.sprocketArgumentName <$> headM (TN.nodeSprocket <$> TN.bftNodes tn)
+  socketPathAbs <- H.note =<< (liftIO $ IO.canonicalizePath $ tempAbsPath </> socketPath)
+  pure (socketPathAbs, networkId, tempAbsPath)
+
+readAs :: (C.HasTextEnvelope a, MonadIO m, MonadTest m) => C.AsType a -> FilePath -> m a
+readAs as path = H.leftFailM . liftIO $ C.readFileTextEnvelope as path
+
+findUTxOByAddress
+  :: (MonadIO m, MonadTest m)
+  => C.LocalNodeConnectInfo C.CardanoMode -> C.AddressAny -> m (C.UTxO C.AlonzoEra)
+findUTxOByAddress localNodeConnectInfo address = let
+  query = C.QueryInShelleyBasedEra C.ShelleyBasedEraAlonzo $ C.QueryUTxO $
+    C.QueryUTxOByAddress $ Set.singleton address
+  in
+  H.leftFailM . H.leftFailM . liftIO $ C.queryNodeLocalState localNodeConnectInfo Nothing $
+    C.QueryInEra C.AlonzoEraInCardanoMode query
+
+submitTx :: (MonadIO m, MonadTest m) => C.LocalNodeConnectInfo C.CardanoMode -> C.Tx C.AlonzoEra -> m ()
+submitTx localNodeConnectInfo tx = do
+  submitResult :: SubmitResult (C.TxValidationErrorInMode C.CardanoMode) <-
+    liftIO $ C.submitTxToNodeLocal localNodeConnectInfo $ C.TxInMode tx C.AlonzoEraInCardanoMode
+  failOnTxSubmitFail submitResult
+  where
+    failOnTxSubmitFail :: (Show a, MonadTest m) => SubmitResult a -> m ()
+    failOnTxSubmitFail = \case
+      SubmitFail reason -> H.failMessage GHC.callStack $ "Transaction failed: " <> show reason
+      SubmitSuccess     -> pure ()
+
+-- TODO: remove when this is exported from hedgehog-extras/src/Hedgehog/Extras/Test/Base.hs
+headM :: (MonadTest m, GHC.HasCallStack) => [a] -> m a
+headM (a:_) = return a
+headM []    = GHC.withFrozenCallStack $ H.failMessage GHC.callStack "Cannot take head of empty list"
+
+workspace :: (MonadTest m, MonadIO m, GHC.HasCallStack) => FilePath -> (FilePath -> m ()) -> m ()
+workspace prefixPath f = GHC.withFrozenCallStack $ do
+  systemTemp <- case IO.os of
+    "darwin" -> pure "/tmp"
+    _        -> H.evalIO IO.getCanonicalTemporaryDirectory
+  maybeKeepWorkspace <- H.evalIO $ IO.lookupEnv "KEEP_WORKSPACE"
+  let systemPrefixPath = systemTemp <> "/" <> prefixPath
+  H.evalIO $ IO.createDirectoryIfMissing True systemPrefixPath
+  ws <- H.evalIO $ IO.createTempDirectory systemPrefixPath "test"
+  H.annotate $ "Workspace: " <> ws
+  -- liftIO $ IO.writeFile (ws <> "/module") callerModuleName
+  f ws
+  when (IO.os /= "mingw32" && maybeKeepWorkspace /= Just "1") $ do
+    H.evalIO $ IO.removeDirectoryRecursive ws

marconi/test/Integration.hs

@@ -13,26 +13,20 @@ import Codec.Serialise (serialise)
 import Control.Concurrent qualified as IO
 import Control.Concurrent.STM qualified as IO
 import Control.Exception (catch)
-import Control.Monad (void, when)
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as Map
-import Data.Set qualified as Set
-import GHC.Stack qualified as GHC
 import Streaming.Prelude qualified as S
 import System.Directory qualified as IO
-import System.Environment qualified as IO
 import System.FilePath ((</>))
-import System.IO.Temp qualified as IO
-import System.Info qualified as IO
 
-import Hedgehog (MonadTest, Property, assert, (===))
+import Hedgehog (Property, assert, (===))
 import Hedgehog qualified as H
-import Hedgehog.Extras.Stock.IO.Network.Sprocket qualified as IO
 import Hedgehog.Extras.Test qualified as HE
 import Hedgehog.Extras.Test.Base qualified as H
 import Test.Tasty (TestTree, testGroup)
@@ -45,16 +39,14 @@ import Cardano.BM.Trace (logError)
 import Cardano.BM.Tracing (defaultConfigStdout)
 import Cardano.Streaming (ChainSyncEventException (NoIntersectionFound), withChainSyncEventStream)
 import Gen.Cardano.Api.Typed qualified as CGen
-import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (SubmitFail, SubmitSuccess))
 import Plutus.V1.Ledger.Scripts qualified as Plutus
 import PlutusTx qualified
 import Prettyprinter (defaultLayoutOptions, layoutPretty, pretty, (<+>))
 import Prettyprinter.Render.Text (renderStrict)
 import Test.Base qualified as H
-import Testnet.Cardano qualified as TN
-import Testnet.Conf qualified as TC (Conf (..), ProjectBase (ProjectBase), YamlFilePath (YamlFilePath), mkConf)
 
 import Hedgehog.Extras qualified as H
+import Helpers (findUTxOByAddress, headM, readAs, startTestnet, submitTx, workspace)
 import Marconi.Index.ScriptTx qualified as ScriptTx
 import Marconi.Indexers qualified as M
 import Marconi.Logging ()
@@ -324,64 +316,3 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas
     H.leftFail $ C.deserialiseFromCBOR (C.AsTx C.AsAlonzoEra) txCbor
 
   tx2 === queriedTx2
-
--- * Helpers
-
-startTestnet :: FilePath -> FilePath -> H.Integration (String, C.NetworkId, FilePath)
-startTestnet base tempAbsBasePath' = do
-  configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"
-  conf@TC.Conf { TC.tempBaseAbsPath, TC.tempAbsPath } <- HE.noteShowM $
-    TC.mkConf (TC.ProjectBase base) (TC.YamlFilePath configurationTemplate)
-      (tempAbsBasePath' <> "/")
-      Nothing
-  assert $ tempAbsPath == (tempAbsBasePath' <> "/")
-        && tempAbsPath == (tempBaseAbsPath <> "/")
-  tn <- TN.testnet TN.defaultTestnetOptions conf
-  let networkId = C.Testnet $ C.NetworkMagic $ fromIntegral (TN.testnetMagic tn)
-  socketPath <- IO.sprocketArgumentName <$> headM (TN.nodeSprocket <$> TN.bftNodes tn)
-  socketPathAbs <- H.note =<< (liftIO $ IO.canonicalizePath $ tempAbsPath </> socketPath)
-  pure (socketPathAbs, networkId, tempAbsPath)
-
-readAs :: (C.HasTextEnvelope a, MonadIO m, MonadTest m) => C.AsType a -> FilePath -> m a
-readAs as path = H.leftFailM . liftIO $ C.readFileTextEnvelope as path
-
-findUTxOByAddress
-  :: (MonadIO m, MonadTest m)
-  => C.LocalNodeConnectInfo C.CardanoMode -> C.AddressAny -> m (C.UTxO C.AlonzoEra)
-findUTxOByAddress localNodeConnectInfo address = let
-  query = C.QueryInShelleyBasedEra C.ShelleyBasedEraAlonzo $ C.QueryUTxO $
-    C.QueryUTxOByAddress $ Set.singleton address
-  in
-  H.leftFailM . H.leftFailM . liftIO $ C.queryNodeLocalState localNodeConnectInfo Nothing $
-    C.QueryInEra C.AlonzoEraInCardanoMode query
-
-submitTx :: (MonadIO m, MonadTest m) => C.LocalNodeConnectInfo C.CardanoMode -> C.Tx C.AlonzoEra -> m ()
-submitTx localNodeConnectInfo tx = do
-  submitResult :: SubmitResult (C.TxValidationErrorInMode C.CardanoMode) <-
-    liftIO $ C.submitTxToNodeLocal localNodeConnectInfo $ C.TxInMode tx C.AlonzoEraInCardanoMode
-  failOnTxSubmitFail submitResult
-  where
-    failOnTxSubmitFail :: (Show a, MonadTest m) => SubmitResult a -> m ()
-    failOnTxSubmitFail = \case
-      SubmitFail reason -> H.failMessage GHC.callStack $ "Transaction failed: " <> show reason
-      SubmitSuccess     -> pure ()
-
--- TODO: remove when this is exported from hedgehog-extras/src/Hedgehog/Extras/Test/Base.hs
-headM :: (MonadTest m, GHC.HasCallStack) => [a] -> m a
-headM (a:_) = return a
-headM []    = GHC.withFrozenCallStack $ H.failMessage GHC.callStack "Cannot take head of empty list"
-
-workspace :: (MonadTest m, MonadIO m, GHC.HasCallStack) => FilePath -> (FilePath -> m ()) -> m ()
-workspace prefixPath f = GHC.withFrozenCallStack $ do
-  systemTemp <- case IO.os of
-    "darwin" -> pure "/tmp"
-    _        -> H.evalIO IO.getCanonicalTemporaryDirectory
-  maybeKeepWorkspace <- H.evalIO $ IO.lookupEnv "KEEP_WORKSPACE"
-  let systemPrefixPath = systemTemp <> "/" <> prefixPath
-  H.evalIO $ IO.createDirectoryIfMissing True systemPrefixPath
-  ws <- H.evalIO $ IO.createTempDirectory systemPrefixPath "test"
-  H.annotate $ "Workspace: " <> ws
-  -- liftIO $ IO.writeFile (ws <> "/module") callerModuleName
-  f ws
-  when (IO.os /= "mingw32" && maybeKeepWorkspace /= Just "1") $ do
-    H.evalIO $ IO.removeDirectoryRecursive ws