Review changes

Author: Jimbo4350

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

@@ -47,7 +47,7 @@ import           Cardano.Api as Api hiding (txId)
 import           Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole))
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.UTxO as Utxo
-
+import Testnet.Runtime
 import           Cardano.Ledger.Api (ConwayGovState)
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.Conway.Governance as L
@@ -253,13 +253,12 @@ getEpochStateView
   :: HasCallStack
   => MonadResource m
   => MonadTest m
-  => MonadCatch m
   => NodeConfigFile In -- ^ node Yaml configuration file path
   -> SocketPath -- ^ node socket path
   -> m EpochStateView
 getEpochStateView nodeConfigFile socketPath = withFrozenCallStack $ do
   epochStateView <- H.evalIO $ newIORef Nothing
-  H.asyncRegister_ . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing
+  void . asyncRegister_ . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing
     $ \epochState slotNumber blockNumber -> do
         liftIO . writeIORef epochStateView $ Just (epochState, slotNumber, blockNumber)
         pure ConditionNotMet

cardano-testnet/src/Testnet/Orphans.hs

@@ -2,7 +2,7 @@
 
 module Testnet.Orphans () where
 
-import           RIO (RIO(..), liftIO)
+import           RIO (RIO(..), throwString)
 
 instance MonadFail (RIO env) where 
-  fail = liftIO . fail
+  fail = throwString

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

@@ -44,6 +44,7 @@ defaultExecConfig = ExecConfig
 
 
 mkExecConfig :: ()
+  => HasCallStack
   => MonadIO m
   => FilePath
   -> IO.Sprocket
@@ -65,7 +66,8 @@ mkExecConfig tempBaseAbsPath sprocket networkId = do
 
 
 execCli'
-  :: MonadIO m
+  :: HasCallStack
+  => MonadIO m
   => ExecConfig
   -> [String]
   -> m String
@@ -94,14 +96,16 @@ execCli = GHC.withFrozenCallStack $ execFlex "cardano-cli" "CARDANO_CLI"
 -- When running outside a nix environment, the `pkgBin` describes the name of the binary
 -- to launch via cabal exec.
 execFlex
-  :: String
+  :: HasCallStack
+  => String
   -> String
   -> [String]
   -> RIO env String
 execFlex = execFlex' defaultExecConfig
 
 execFlex'
   :: MonadIO m
+  => HasCallStack
   => ExecConfig
   -> String
   -> String
@@ -278,7 +282,7 @@ procFlex
   -- ^ Captured stdout
 procFlex = procFlex' defaultExecConfig
 
-
+-- This will also catch async exceptions as well.
 liftIOAnnotated :: (HasCallStack, MonadIO m) => IO a -> m a 
 liftIOAnnotated action = GHC.withFrozenCallStack $
   liftIO $ action `catch` (\(e :: SomeException) -> throwM $ exceptionWithCallStack e)

cardano-testnet/src/Testnet/Runtime.hs

@@ -156,7 +156,7 @@ startNode tp node ipv4 port _testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
 
     isClosed <- liftIOAnnotated $ Ping.waitForPortClosed 30 0.1 port
     unless isClosed $ 
-      throwString $ "Port  is still in use after 30 seconds before starting node: " <> show port 
+      throwString $ "Port is still in use after 30 seconds before starting node: " <> show port 
 
     (Just stdIn, _, _, hProcess, _)
       <- firstExceptT ProcessRelatedFailure $ initiateProcess
@@ -278,7 +278,6 @@ createSubdirectoryIfMissingNew parent subdirectory = GHC.withFrozenCallStack $ d
 -- Idempotent.
 startLedgerNewEpochStateLogging
   :: HasCallStack
-  => MonadCatch m
   => MonadResource m
   => TestnetRuntime
   -> FilePath -- ^ tmp workspace directory
@@ -294,23 +293,24 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac
     False -> do
       throwString $ "Log directory does not exist: " <> logDir <> " - cannot start logging epoch states"
 
-  liftIOAnnotated $ IO.doesFileExist logFile >>= \case
+  liftIOAnnotated (IO.doesFileExist logFile) >>= \case
     True -> return () 
-    False -> liftIO $ appendFile logFile ""
-
-  let socketPath = case uncons (testnetSprockets testnetRuntime) of
-        Just (sprocket, _) -> H.sprocketSystemName sprocket
-        Nothing            -> throwString "No testnet sprocket available"
-
-  let act = runExceptT $
-              foldEpochState
-                (configurationFile testnetRuntime)
-                (Api.File socketPath)
-                Api.QuickValidation
-                (EpochNo maxBound)
-                Nothing
-                (handler logFile diffFile)
-  void $ asyncRegister_ act
+    False -> do 
+      liftIOAnnotated $ appendFile logFile ""
+
+      let socketPath = case uncons (testnetSprockets testnetRuntime) of
+            Just (sprocket, _) -> H.sprocketSystemName sprocket
+            Nothing            -> throwString "No testnet sprocket available"
+    
+      void $ asyncRegister_ . runExceptT $
+                  foldEpochState
+                    (configurationFile testnetRuntime)
+                    (Api.File socketPath)
+                    Api.QuickValidation
+                    (EpochNo maxBound)
+                    Nothing
+                    (handler logFile diffFile)
+                    
   where
     handler :: FilePath -- ^ log file
             -> FilePath -- ^ diff file

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

@@ -57,6 +57,7 @@ import           Data.Time (diffUTCTime)
 import           Data.Time.Clock (NominalDiffTime)
 import qualified Data.Time.Clock as DTC
 import           GHC.Stack
+import           Hedgehog ( evalIO )
 import qualified System.Directory as IO
 import           System.FilePath ((</>))
 
@@ -93,7 +94,7 @@ testMinimumConfigurationRequirements options = withFrozenCallStack $ do
 liftToIntegration :: RIO ResourceMap a -> H.Integration a 
 liftToIntegration  r = do 
    rMap <- lift $ lift getInternalState 
-   liftIOAnnotated $ runRIO rMap r
+   evalIO $ runRIO rMap r
 
 createTestnetEnv :: ()
   => HasCallStack

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

@@ -52,6 +52,7 @@ import           Cardano.Ledger.Conway.Genesis (ConwayGenesis)
 import           Prelude
 
 import           Control.Exception (throw)
+import           Control.Monad (unless)
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Types (parseFail)
 import           Data.Char (toLower)
@@ -288,7 +289,6 @@ data Conf = Conf
   , updateTimestamps :: UpdateTimestamps
   } deriving (Eq, Show)
 
--- Logs the argument in the test.
 mkConf :: (HasCallStack, MonadTest m) => FilePath -> m Conf
 mkConf tempAbsPath' = withFrozenCallStack $ do
   H.note_ tempAbsPath'
@@ -309,12 +309,9 @@ mkConfigAbs userOutputDir = do
   absUserOutputDir <-  makeAbsolute userOutputDir
   dirExists <- doesDirectoryExist absUserOutputDir
   let conf = mkConfig absUserOutputDir 
-  if dirExists then
-    -- Happens when the environment has previously been created by the user
-    return conf
-  else do
+  unless dirExists $
     createDirectory absUserOutputDir
-    return conf
+  pure conf
 
 -- | @anyEraToString (AnyCardanoEra ByronEra)@ returns @"byron"@
 anyEraToString :: AnyCardanoEra -> String

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

@@ -105,6 +105,7 @@ hprop_asyncRegister_sanity_check =
      (internalState,tId) <- runResourceT $ do 
         s <- getInternalState
         (_,asyncA) <- asyncRegister_ (threadDelay 10_000_000)
+        threadDelay 10_000_000 
         let tId = asyncThreadId asyncA
         return (s,tId)
      afterForkedThread <- getCurrentTime

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -12,6 +12,7 @@ import qualified Cardano.Testnet.Test.Cli.Plutus.Scripts
 import qualified Cardano.Testnet.Test.Cli.Query
 import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
 import qualified Cardano.Testnet.Test.Cli.StakeSnapshot
+import qualified Cardano.Testnet.Test.SanityCheck
 import qualified Cardano.Testnet.Test.Cli.Transaction
 import qualified Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress
 import qualified Cardano.Testnet.Test.DumpConfig
@@ -56,6 +57,7 @@ tests = do
     [ T.testGroup "Spec"
         [ T.testGroup "Ledger Events"
            [ ignoreOnWindows "Sanity Check" LedgerEvents.hprop_ledger_events_sanity_check
+           , ignoreOnWindows "Async Register" Cardano.Testnet.Test.SanityCheck.hprop_asyncRegister_sanity_check
            -- FIXME this tests gets stuck - investigate why
            -- , ignoreOnWindows "Treasury Growth" Gov.prop_check_if_treasury_is_growing
             -- TODO: Replace foldBlocks with checkConditionResult