Avoid bare IO in tests

cardano-cli/test/Test/Cli/ITN.hs

@@ -8,7 +8,6 @@ import           Cardano.CLI.Shelley.Run.Key (decodeBech32)
 
 import qualified Codec.Binary.Bech32 as Bech32
 import           Control.Monad (void)
-import           Control.Monad.IO.Class (MonadIO (..))
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as Base16
 import           Data.Text (Text)
@@ -42,8 +41,8 @@ prop_convertITNKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   outputHaskellSignKeyFp <- noteTempFile tempDir "haskell-signing-key.key"
 
   -- Write ITN keys to disk
-  liftIO $ Text.writeFile itnVerKeyFp itnVerKey
-  liftIO $ Text.writeFile itnSignKeyFp itnSignKey
+  H.evalIO $ Text.writeFile itnVerKeyFp itnVerKey
+  H.evalIO $ Text.writeFile itnSignKeyFp itnSignKey
   H.assertFilesExist [itnVerKeyFp, itnSignKeyFp]
 
   -- Generate haskell stake verification key
@@ -77,7 +76,7 @@ prop_convertITNExtendedSigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \te
   outputHaskellSignKeyFp <- noteTempFile tempDir "stake-signing.key"
 
   -- Write ITN keys to disk
-  liftIO $ writeFile itnSignKeyFp itnExtendedSignKey
+  H.evalIO $ writeFile itnSignKeyFp itnExtendedSignKey
   H.assertFilesExist [itnSignKeyFp]
 
   -- Generate haskell signing key
@@ -106,7 +105,7 @@ prop_convertITNBIP32SigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \tempD
   outputHaskellSignKeyFp <- noteTempFile tempDir "stake-signing.key"
 
   -- Write ITN keys to disk
-  liftIO $ writeFile itnSignKeyFp itnExtendedSignKey
+  H.evalIO $ writeFile itnSignKeyFp itnExtendedSignKey
 
   H.assertFilesExist [itnSignKeyFp]
 

cardano-cli/test/Test/Cli/Pipes.hs

@@ -13,7 +13,6 @@ module Test.Cli.Pipes
 import           Prelude
 
 #ifdef UNIX
-import           Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as LBS
 import           System.IO (hClose, hFlush, hPutStr)
@@ -50,22 +49,22 @@ prop_readFromPipe = H.withTests 10 . H.property . H.moduleWorkspace "tmp" $ \ws
 
   -- We first test that we can read a filepath
   testFp <- noteInputFile testFile
-  testFileOrPipe <- liftIO $ fileOrPipe testFp
-  testBs <- liftIO $ readFileOrPipe testFileOrPipe
+  testFileOrPipe <- H.evalIO $ fileOrPipe testFp
+  testBs <- H.evalIO $ readFileOrPipe testFileOrPipe
 
   if LBS.null testBs
   then failWith Nothing
          $ "readFileOrPipe failed to read file: " <> fileOrPipePath testFileOrPipe
   else do
     -- We now test that we can read from a pipe.
     -- We first check that the IORef has Nothing
-    mContents <- liftIO $ fileOrPipeCache testFileOrPipe
+    mContents <- H.evalIO $ fileOrPipeCache testFileOrPipe
     case mContents of
       Just{} -> failWith Nothing "readFileOrPipe has incorrectly populated its IORef with contents read from a filepath."
       Nothing -> do
         -- We can reuse testFileOrPipe because we know the cache (IORef) is empty
         let txBodyStr = BSC.unpack $ LBS.toStrict testBs
-        fromPipeBs <- liftIO $ withPipe txBodyStr
+        fromPipeBs <- H.evalIO $ withPipe txBodyStr
         if LBS.null fromPipeBs
         then failWith Nothing "readFileOrPipe failed to read from a pipe"
         else testBs === fromPipeBs

cardano-cli/test/Test/Golden/Byron/SigningKeys.hs

@@ -6,7 +6,6 @@ module Test.Golden.Byron.SigningKeys
 
 import           Codec.CBOR.Read (deserialiseFromBytes)
 import           Control.Monad (void)
-import           Control.Monad.IO.Class (MonadIO (..))
 import           Control.Monad.Trans.Except (runExceptT)
 import qualified Data.ByteString.Lazy as LB
 
@@ -19,20 +18,21 @@ import           Cardano.CLI.Byron.Legacy (decodeLegacyDelegateKey)
 import           Cardano.CLI.Shelley.Commands
 
 import           Hedgehog (Group (..), Property, checkSequential, property, success)
+import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Test.Base as H
 import           Hedgehog.Internal.Property (failWith)
 import           Test.OptParse
 
 prop_deserialise_legacy_signing_Key :: Property
 prop_deserialise_legacy_signing_Key = propertyOnce $ do
-  legSkeyBs <- liftIO $ LB.readFile "test/data/golden/byron/keys/legacy.skey"
+  legSkeyBs <- H.evalIO $ LB.readFile "test/data/golden/byron/keys/legacy.skey"
   case deserialiseFromBytes decodeLegacyDelegateKey legSkeyBs of
     Left deSerFail -> failWith Nothing $ show deSerFail
     Right _ -> success
 
 prop_deserialise_nonLegacy_signing_Key :: Property
 prop_deserialise_nonLegacy_signing_Key = propertyOnce $ do
-  skeyBs <- liftIO $ LB.readFile "test/data/golden/byron/keys/byron.skey"
+  skeyBs <- H.evalIO $ LB.readFile "test/data/golden/byron/keys/byron.skey"
   case deserialiseFromBytes Crypto.fromCBORXPrv skeyBs of
     Left deSerFail -> failWith Nothing $ show deSerFail
     Right _ -> success
@@ -71,7 +71,7 @@ prop_print_nonLegacy_signing_key_address = propertyOnce $ do
 
 prop_generate_and_read_nonlegacy_signingkeys :: Property
 prop_generate_and_read_nonlegacy_signingkeys = property $ do
-  byronSkey <- liftIO $ generateSigningKey AsByronKey
+  byronSkey <- H.evalIO $ generateSigningKey AsByronKey
   case deserialiseFromRawBytes (AsSigningKey AsByronKey) (serialiseToRawBytes byronSkey) of
     Left _ -> failWith Nothing "Failed to deserialise non-legacy Byron signing key. "
     Right _ -> success
@@ -88,7 +88,7 @@ prop_migrate_legacy_to_nonlegacy_signingkeys =
      , "--to", nonLegacyKeyFp
      ]
 
-    eSignKey <- liftIO . runExceptT . readByronSigningKey NonLegacyByronKeyFormat
+    eSignKey <- H.evalIO . runExceptT . readByronSigningKey NonLegacyByronKeyFormat
                   $ File nonLegacyKeyFp
 
     case eSignKey of
@@ -97,14 +97,14 @@ prop_migrate_legacy_to_nonlegacy_signingkeys =
 
 prop_deserialise_NonLegacy_Signing_Key_API :: Property
 prop_deserialise_NonLegacy_Signing_Key_API = propertyOnce $ do
-  eFailOrWit <- liftIO . runExceptT $ readByronSigningKey NonLegacyByronKeyFormat "test/data/golden/byron/keys/byron.skey"
+  eFailOrWit <- H.evalIO . runExceptT $ readByronSigningKey NonLegacyByronKeyFormat "test/data/golden/byron/keys/byron.skey"
   case eFailOrWit of
     Left keyFailure -> failWith Nothing $ show keyFailure
     Right _ -> success
 
 prop_deserialiseLegacy_Signing_Key_API :: Property
 prop_deserialiseLegacy_Signing_Key_API = propertyOnce $ do
-  eFailOrWit <- liftIO . runExceptT $ readByronSigningKey LegacyByronKeyFormat "test/data/golden/byron/keys/legacy.skey"
+  eFailOrWit <- H.evalIO . runExceptT $ readByronSigningKey LegacyByronKeyFormat "test/data/golden/byron/keys/legacy.skey"
   case eFailOrWit of
     Left keyFailure -> failWith Nothing $ show keyFailure
     Right _ -> success

cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs

@@ -6,7 +6,6 @@ module Test.Golden.Shelley.Genesis.Create
   ) where
 
 import           Control.Monad (void)
-import           Control.Monad.IO.Class (MonadIO (..))
 import           Data.Bifunctor (Bifunctor (..))
 import           Data.Foldable (for_)
 
@@ -27,7 +26,6 @@ import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Gen as G
 import qualified Hedgehog.Range as R
-import qualified System.Directory as IO
 
 {- HLINT ignore "Use <$>" -}
 {- HLINT ignore "Use camelCase" -}
@@ -84,7 +82,7 @@ golden_shelleyGenesisCreate = propertyOnce $ do
 
     let genesisFile = tempDir <> "/genesis.json"
 
-    fmtStartTime <- fmap H.formatIso8601 $ liftIO DT.getCurrentTime
+    fmtStartTime <- fmap H.formatIso8601 $ H.evalIO DT.getCurrentTime
 
     (supply, fmtSupply) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 10000000 4000000000)
     (delegateCount, fmtDelegateCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19)
@@ -103,7 +101,7 @@ golden_shelleyGenesisCreate = propertyOnce $ do
 
     H.assertFilesExist [genesisFile]
 
-    genesisContents <- liftIO $ LBS.readFile genesisFile
+    genesisContents <- H.evalIO $ LBS.readFile genesisFile
 
     actualJson <- H.evalEither $ J.eitherDecode genesisContents
     actualSupply <- H.evalEither $ J.parseEither parseMaxLovelaceSupply actualJson
@@ -156,7 +154,7 @@ golden_shelleyGenesisCreate = propertyOnce $ do
   H.moduleWorkspace "tmp" $ \tempDir -> do
     let genesisFile = tempDir <> "/genesis.json"
 
-    fmtStartTime <- fmap H.formatIso8601 $ liftIO DT.getCurrentTime
+    fmtStartTime <- fmap H.formatIso8601 $ H.evalIO DT.getCurrentTime
 
     (supply, fmtSupply) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 10000000 4000000000)
     (delegateCount, fmtDelegateCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19)
@@ -183,7 +181,7 @@ golden_shelleyGenesisCreate = propertyOnce $ do
 
     H.assertFilesExist [genesisFile]
 
-    genesisContents <- liftIO $ LBS.readFile genesisFile
+    genesisContents <- H.evalIO $ LBS.readFile genesisFile
 
     actualJson <- H.evalEither $ J.eitherDecode genesisContents
     actualSupply <- H.evalEither $ J.parseEither parseMaxLovelaceSupply actualJson

cardano-cli/test/Test/Golden/Shelley/Metadata/StakePoolMetadata.hs

@@ -5,12 +5,12 @@ module Test.Golden.Shelley.Metadata.StakePoolMetadata
   ) where
 
 import           Control.Monad (void)
-import           Control.Monad.IO.Class (MonadIO (..))
 import           Data.Text (Text)
 import qualified Data.Text.IO as Text
 import           Hedgehog (Property)
 import           Test.OptParse as OP
 
+import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
@@ -24,7 +24,7 @@ golden_stakePoolMetadataHash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir
   outputStakePoolMetadataHashFp <- noteTempFile tempDir "stake-pool-metadata-hash.txt"
 
   -- Write the example stake pool metadata to disk
-  liftIO $ Text.writeFile stakePoolMetadataFile exampleStakePoolMetadata
+  H.evalIO $ Text.writeFile stakePoolMetadataFile exampleStakePoolMetadata
 
   -- Hash the stake pool metadata
   void $ execCardanoCLI

cardano-cli/test/Test/OptParse.hs

@@ -17,9 +17,9 @@ import           Cardano.Api
 
 import           Cardano.CLI.Shelley.Run.Read
 
+import           Control.Monad.IO.Class (MonadIO (..))
 import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.Except (runExceptT)
-import           Control.Monad.IO.Class (MonadIO (..))
 import           Data.Function ((&))
 import           GHC.Stack (CallStack, HasCallStack)
 import qualified Hedgehog as H
@@ -63,10 +63,10 @@ checkTextEnvelopeFormat
   -> FilePath
   -> m ()
 checkTextEnvelopeFormat tve reference created = GHC.withFrozenCallStack $ do
-  eRefTextEnvelope <- liftIO $ readTextEnvelopeOfTypeFromFile tve reference
+  eRefTextEnvelope <- H.evalIO $ readTextEnvelopeOfTypeFromFile tve reference
   refTextEnvelope <- handleTextEnvelope eRefTextEnvelope
 
-  eCreatedTextEnvelope <- liftIO $ readTextEnvelopeOfTypeFromFile tve created
+  eCreatedTextEnvelope <- H.evalIO $ readTextEnvelopeOfTypeFromFile tve created
   createdTextEnvelope <- handleTextEnvelope eCreatedTextEnvelope
 
   typeTitleEquivalence refTextEnvelope createdTextEnvelope
@@ -89,10 +89,10 @@ checkTxCddlFormat
   -> FilePath -- ^ Newly created file
   -> m ()
 checkTxCddlFormat referencePath createdPath = do
-  reference <- liftIO $ fileOrPipe referencePath
-  created <- liftIO $ fileOrPipe createdPath
-  r <- liftIO $ readCddlTx reference
-  c <- liftIO $ readCddlTx created
+  reference <- H.evalIO $ fileOrPipe referencePath
+  created <- H.evalIO $ fileOrPipe createdPath
+  r <- H.evalIO $ readCddlTx reference
+  c <- H.evalIO $ readCddlTx created
   r H.=== c
 
 

cardano-cli/test/Test/Utilities.hs

@@ -5,7 +5,7 @@ module Test.Utilities
 
 import           Cardano.Prelude (ConvertText (..), HasCallStack)
 
-import           Control.Monad.IO.Class (MonadIO (liftIO))
+import           Control.Monad.IO.Class (MonadIO)
 import           Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff)
 import           Data.Algorithm.DiffOutput (ppDiff)
 import           GHC.Stack (callStack)
@@ -39,12 +39,13 @@ createFiles = IO.unsafePerformIO $ do
 -- each input.
 diffVsGoldenFile
   :: HasCallStack
-  => (MonadIO m, MonadTest m)
+  => MonadTest m
+  => MonadIO m
   => String   -- ^ Actual content
   -> FilePath -- ^ Reference file
   -> m ()
 diffVsGoldenFile actualContent referenceFile = GHC.withFrozenCallStack $ do
-  fileExists <- liftIO $ IO.doesFileExist referenceFile
+  fileExists <- H.evalIO $ IO.doesFileExist referenceFile
 
   if fileExists
     then do
@@ -80,7 +81,8 @@ diffVsGoldenFile actualContent referenceFile = GHC.withFrozenCallStack $ do
 -- files are never overwritten.
 diffFileVsGoldenFile
   :: HasCallStack
-  => (MonadIO m, MonadTest m)
+  => MonadIO m
+  => MonadTest m
   => FilePath -- ^ Actual file
   -> FilePath -- ^ Reference file
   -> m ()

cardano-node-chairman/test/Spec/Network.hs

@@ -12,7 +12,6 @@ module Spec.Network
 
 import           Control.Exception (IOException)
 import           Control.Monad
-import           Control.Monad.IO.Class (liftIO)
 import           Data.Bool
 import           Data.Either
 import           Data.Function
@@ -47,15 +46,15 @@ hprop_isPortOpen_True = H.propertyOnce . H.workspace "temp-network" $ \_ -> do
   -- Multiple random ports are checked because there is a remote possibility a random
   -- port is actually open by another program
   ports <- H.evalIO $ fmap (L.take 10 . IO.randomRs @Int (5000, 9000)) IO.getStdGen
-  (socket, port) <- liftIO $ openOnePortFrom ports
+  (socket, port) <- H.evalIO $ openOnePortFrom ports
   void $ IO.register $ IO.close socket
   result <- H.isPortOpen port
   result === True
   where openOnePortFrom :: [Int] -> IO (Socket, Int)
         openOnePortFrom ports = case ports of
           [] -> error "Could not open any ports"
           (n:ns) -> do
-            socketResult <- IO.try . liftIO $ IO.listenOn n
+            socketResult <- IO.try $ IO.listenOn n
             case socketResult of
               Right socket -> return (socket, n)
               Left (_ :: IOException) -> openOnePortFrom ns

cardano-testnet/src/Testnet/Cardano.hs

@@ -24,7 +24,7 @@ module Testnet.Cardano
 import           Prelude
 
 import           Control.Monad
-import           Control.Monad.IO.Class (MonadIO, liftIO)
+import           Control.Monad.IO.Class (MonadIO)
 import           Control.Monad.Trans.Except
 import qualified Data.Aeson as J
 import qualified Data.ByteString as BS
@@ -777,6 +777,6 @@ getByronGenesisHash path = do
 
 getShelleyGenesisHash :: (H.MonadTest m, MonadIO m) => FilePath -> m J.Value
 getShelleyGenesisHash path = do
-  content <- liftIO $ BS.readFile path
+  content <- H.evalIO $ BS.readFile path
   let genesisHash = Cardano.Crypto.Hash.Class.hashWith id content :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 BS.ByteString
   pure $ J.toJSON genesisHash

cardano-testnet/src/Testnet/Run.hs

@@ -27,7 +27,7 @@ testnetProperty maybeTestnetMagic tn = H.integrationRetryWorkspace 2 "testnet" $
   conf <- H.mkConf (H.ProjectBase base) (H.YamlFilePath configurationTemplate) tempAbsPath' maybeTestnetMagic
 
   -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
-  void . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
+  void . H.evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
 
   void $ tn conf
 

cardano-testnet/src/Testnet/Shelley.hs

@@ -435,12 +435,12 @@ hprop_testnet = H.integrationRetryWorkspace 2 "shelley-testnet" $ \tempAbsPath'
   configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"
   conf <- H.mkConf (H.ProjectBase base) (H.YamlFilePath configurationTemplate) tempAbsPath' Nothing
 
-  void . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
+  void . H.evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
 
   void $ shelleyTestnet defaultTestnetOptions conf
 
   H.failure -- Intentional failure to force failure report
 
 hprop_testnet_pause :: H.Property
 hprop_testnet_pause = H.integration $ do
-  void . forever . liftIO $ IO.threadDelay 10000000
+  void . forever . H.evalIO $ IO.threadDelay 10000000

cardano-testnet/src/Testnet/Util/Process.hs

@@ -131,12 +131,12 @@ assertByDeadlineIOCustom
   :: (MonadTest m, MonadIO m, HasCallStack)
   => String -> UTCTime -> IO Bool -> m ()
 assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do
-  success <- liftIO f
+  success <- H.evalIO f
   unless success $ do
-    currentTime <- liftIO DTC.getCurrentTime
+    currentTime <- H.evalIO DTC.getCurrentTime
     if currentTime < deadline
       then do
-        liftIO $ IO.threadDelay 1000000
+        H.evalIO $ IO.threadDelay 1000000
         assertByDeadlineIOCustom str deadline f
       else do
         H.annotateShow currentTime