More refactoring

Author: Jimbo4350

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

@@ -56,7 +56,7 @@ import           Data.Word (Word64)
 import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
 import qualified Network.HTTP.Simple as HTTP
-import           RIO (Exception(..), RIO, throwM)
+import           RIO (Exception(..), MonadThrow, throwM)
 import qualified System.Directory as System
 import           System.FilePath.Posix (takeDirectory, (</>))
 
@@ -74,9 +74,11 @@ import qualified Hedgehog.Extras.Stock.Time as DTC
 -- | Returns JSON encoded hashes of the era, as well as the hard fork configuration toggle.
 createConfigJson :: ()
   => HasCallStack
+  => MonadIO m
+  => MonadThrow m
   => TmpAbsolutePath
   -> ShelleyBasedEra era -- ^ The era used for generating the hard fork configuration toggle
-  -> RIO env (KeyMap Aeson.Value)
+  -> m (KeyMap Aeson.Value)
 createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ do
   byronGenesisHash <- getByronGenesisHash $ tempAbsPath </> "byron-genesis.json"
   shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash"
@@ -91,7 +93,7 @@ createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ d
     , Defaults.defaultYamlHardforkViaConfig sbe
     ]
    where
-    getHash ::  CardanoEra a -> Text.Text -> RIO env (KeyMap Value)
+    getHash ::  MonadIO m => CardanoEra a -> Text.Text -> m (KeyMap Value)
     getHash e = getShelleyGenesisHash (tempAbsPath </> Defaults.defaultGenesisFilepath e)
 
 createConfigJsonNoHash :: ()
@@ -102,8 +104,10 @@ createConfigJsonNoHash = Defaults.defaultYamlHardforkViaConfig
 -- Generate hashes for genesis.json files
 
 getByronGenesisHash
-  :: FilePath
-  -> RIO env (KeyMap Aeson.Value)
+  :: MonadIO m
+  => MonadThrow m
+  => FilePath
+  -> m (KeyMap Aeson.Value)
 getByronGenesisHash path = do
   e <- runExceptT $ readGenesisData path
   case e of 
@@ -113,9 +117,10 @@ getByronGenesisHash path = do
       pure . singleton "ByronGenesisHash" $ toJSON genesisHash'
 
 getShelleyGenesisHash
-  :: FilePath
+  :: MonadIO m
+  => FilePath
   -> Text
-  -> RIO env (KeyMap Aeson.Value)
+  -> m (KeyMap Aeson.Value)
 getShelleyGenesisHash path key = do
   content <- liftIO $ BS.readFile path
   let genesisHash = Crypto.hashWith id content :: Crypto.Hash Crypto.Blake2b_256 BS.ByteString
@@ -128,10 +133,11 @@ startTimeOffsetSeconds = if OS.isWin32 then 90 else 15
 
 -- | A start time and 'ShelleyGenesis' value that are fit to pass to 'cardanoTestnet'
 getDefaultShelleyGenesis :: ()
+  => MonadIO m
   => AnyShelleyBasedEra
   -> Word64 -- ^ The max supply
   -> GenesisOptions
-  -> RIO env ShelleyGenesis
+  -> m ShelleyGenesis
 getDefaultShelleyGenesis asbe maxSupply opts = do
   currentTime <- liftIO DTC.getCurrentTime
   let startTime = DTC.addUTCTime startTimeOffsetSeconds currentTime
@@ -140,8 +146,9 @@ getDefaultShelleyGenesis asbe maxSupply opts = do
 -- | An 'AlonzoGenesis' value that is fit to pass to 'cardanoTestnet'
 getDefaultAlonzoGenesis :: ()
   => HasCallStack
+  => MonadThrow m
   => ShelleyBasedEra era
-  -> RIO e AlonzoGenesis
+  -> m AlonzoGenesis
 getDefaultAlonzoGenesis sbe =
   case Defaults.defaultAlonzoGenesis sbe of 
     Right genesis -> return genesis
@@ -161,19 +168,22 @@ numSeededUTxOKeys = 3
 -- for logging purposes. No reason for the annotations 
 -- to be littered within the functions 
 createSPOGenesisAndFiles
-  :: CardanoTestnetOptions -- ^ The options to use
+  :: MonadIO m
+  => HasCallStack
+  => MonadThrow m
+  => CardanoTestnetOptions -- ^ The options to use
   -> GenesisOptions
   -> TestnetOnChainParams
   -> TmpAbsolutePath
-  -> RIO env FilePath -- ^ Shelley genesis directory
+  -> m FilePath -- ^ Shelley genesis directory
 createSPOGenesisAndFiles
   testnetOptions genesisOptions@GenesisOptions{genesisTestnetMagic}
   onChainParams
   (TmpAbsolutePath tempAbsPath) = GHC.withFrozenCallStack $ do
   AnyShelleyBasedEra sbe <- pure cardanoNodeEra
 
   let genesisShelleyDirAbs = takeDirectory inputGenesisShelleyFp
-  -- error "here 1"
+
   genesisShelleyDir <- liftIO $ System.createDirectoryIfMissing True genesisShelleyDirAbs >> pure genesisShelleyDirAbs
   let -- At least there should be a delegator per DRep
       -- otherwise some won't be representing anybody
@@ -310,9 +320,11 @@ instance Exception BlockfrostParamsError where
 -- into a unified, consistent set of Genesis files
 resolveOnChainParams :: ()
  => HasCallStack
+ => MonadIO m
+ => MonadThrow m
  => TestnetOnChainParams
  -> (AlonzoGenesis, ConwayGenesis, ShelleyGenesis)
- -> RIO env (AlonzoGenesis, ConwayGenesis, ShelleyGenesis)
+ -> m (AlonzoGenesis, ConwayGenesis, ShelleyGenesis)
 resolveOnChainParams onChainParams geneses = case onChainParams of
 
   DefaultParams -> pure geneses

cardano-testnet/src/Testnet/Orphans.hs

@@ -2,14 +2,7 @@
 
 module Testnet.Orphans () where
 
--- import           Hedgehog (MonadTest(..))
-import           RIO (RIO)
+import           RIO (RIO(..), liftIO)
 
--- Not possible to have
--- instance MonadTest (RIO env) where 
---   liftTest  = liftRIO . liftTest
--- If you pattern match on the RIO constructor 
--- it rightfully complains!
--- what extension is responsible for this?
 instance MonadFail (RIO env) where 
-  fail = error "TODO: throw exception here then catch it in the liftToIntegration "
+  fail = liftIO . fail

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

@@ -63,9 +63,10 @@ execCli' execConfig = GHC.withFrozenCallStack $ execFlex' execConfig "cardano-cl
 
 execCli_
   :: HasCallStack
+  => MonadIO m
   => [String]
-  -> RIO env ()
-execCli_ = GHC.withFrozenCallStack $ void . execCli
+  -> m ()
+execCli_ = GHC.withFrozenCallStack $ void . liftIO . runRIO () . execCli
 
 execCli
   :: HasCallStack

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -224,7 +224,8 @@ createTestnetEnv
 -- > ├── configuration.json
 -- > ├── current-stake-pools.json
 -- > └── module
-cardanoTestnet :: HasCallStack
+cardanoTestnet 
+  :: HasCallStack
   => CardanoTestnetOptions -- ^ The options to use
   -> Conf -- ^ Path to the test sandbox
   -> RIO ResourceMap TestnetRuntime
@@ -366,7 +367,7 @@ cardanoTestnet
                            , "--byron-signing-key", nodePoolKeysDir </> "byron-delegate.key"
                            ]
             keys@SpoNodeKeys{poolNodeKeysVrf} = mkTestnetNodeKeyPaths i
-    -- error "forCuncurrently" -- works!
+
     eRuntime <- runExceptT . retryOnAddressInUseError $
       startNode (TmpAbsolutePath tmpAbsPath) nodeName testnetDefaultIpv4Address port testnetMagic $
         [ "run"
@@ -376,9 +377,9 @@ cardanoTestnet
         ]
         <> spoNodeCliArgs
         <> extraCliArgs nodeOptions
-    -- error "eRuntime" -- works!
+
     pure $ eRuntime <&> \rt -> rt{poolKeys=mKeys}
-  -- error "mid cardanoTestnet before 3" -- works!! 
+
   let (failedNodes, testnetNodes') = partitionEithers eTestnetNodes
   unless (null failedNodes) $ do
     error $ "Some nodes failed to start:\n" ++ show (vsep (prettyError <$> failedNodes))
@@ -451,13 +452,10 @@ createAndRunTestnet :: ()
   -> H.Integration TestnetRuntime
 createAndRunTestnet testnetOptions genesisOptions conf = do
   liftToIntegration $ do
-     -- works error "here"
      createTestnetEnv
        testnetOptions genesisOptions def
        conf
-     -- works error "here"
      cardanoTestnet testnetOptions conf
-     -- error "here post cardanoTestnet" -- WORKS!
 
 -- | Retry an action when `NodeAddressAlreadyInUseError` gets thrown from an action
 retryOnAddressInUseError

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs

@@ -50,7 +50,7 @@ hprop_ledger_events_sanity_check = integrationRetryWorkspace 2 "ledger-events-sa
 
   TestnetRuntime{configurationFile, testnetNodes}
     <- createAndRunTestnet fastTestnetOptions shelleyOptions conf
-  -- error "Test failure" -- works
+
   nr@TestnetNode{nodeSprocket} <- H.headM testnetNodes
   let socketPath = nodeSocketPath nr