Skip to content

Commit d1006cc

Browse files
Jimbo4350Jimbo4350
committed
Propagate liftToIntegration and liftIOAnnotated
1 parent 8e04ac0 commit d1006cc

File tree

12 files changed

+63
-26
lines changed

12 files changed

+63
-26
lines changed

‎cardano-node/src/Cardano/Node/Protocol/Byron.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Cardano.Tracing.OrphanInstances.Shelley ()
3636
import Ouroboros.Consensus.Cardano
3737
import qualified Ouroboros.Consensus.Cardano as Consensus
3838

39+
import Control.Exception
3940
import qualified Data.ByteString.Lazy as LB
4041
import Data.Maybe (fromMaybe)
4142
import Data.Text (Text)
@@ -167,6 +168,9 @@ data ByronProtocolInstantiationError =
167168
| SigningKeyFilepathNotSpecified
168169
deriving Show
169170

171+
instance Exception ByronProtocolInstantiationError where
172+
displayException = docToString . prettyError
173+
170174
instance Error ByronProtocolInstantiationError where
171175
prettyError (CanonicalDecodeFailure fp failure) =
172176
"Canonical decode failure in " <> pshow fp

‎cardano-testnet/cardano-testnet.cabal‎

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ library
3838

3939
build-depends: aeson
4040
, aeson-pretty
41+
, annotated-exception
4142
, ansi-terminal
4243
, bytestring
4344
, cardano-api ^>= 10.18
@@ -86,6 +87,8 @@ library
8687
, process
8788
, resourcet
8889
, retry
90+
, rio
91+
, rio-orphans
8992
, safe-exceptions
9093
, scientific
9194
, si-timers
@@ -98,6 +101,7 @@ library
98101
, time
99102
, transformers
100103
, transformers-except
104+
, unliftio
101105
, vector
102106
, yaml
103107

@@ -111,17 +115,20 @@ library
111115
Testnet.EpochStateProcessing
112116
Testnet.Filepath
113117
Testnet.Handlers
118+
Testnet.Orphans
114119
Testnet.Ping
115120
Testnet.Process.Cli.DRep
116121
Testnet.Process.Cli.Keys
117122
Testnet.Process.Cli.SPO
118123
Testnet.Process.Cli.Transaction
124+
Testnet.Process.RunIO
119125
Testnet.Process.Run
120126
Testnet.Property.Assert
121127
Testnet.Property.Run
122128
Testnet.Property.Util
123129
Testnet.Runtime
124130
Testnet.Start.Byron
131+
Testnet.Start.Cardano
125132
Testnet.Start.Types
126133
Testnet.SubmitApi
127134
Testnet.TestQueryCmds
@@ -130,7 +137,6 @@ library
130137
other-modules: Parsers.Cardano
131138
Parsers.Help
132139
Parsers.Version
133-
Testnet.Start.Cardano
134140
Testnet.TestEnumGenerator
135141
Paths_cardano_testnet
136142

@@ -265,6 +271,7 @@ test-suite cardano-testnet-test
265271
, monad-control
266272
, mtl
267273
, process
274+
, resourcet
268275
, regex-compat
269276
, rio
270277
, tasty ^>= 1.5

‎cardano-testnet/src/Testnet/Defaults.hs‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,7 @@ import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValenc
7474

7575
import Prelude
7676

77+
import Control.Exception (Exception (..))
7778
import Control.Monad.Identity (Identity)
7879
import Data.Aeson (ToJSON (..), Value, (.=))
7980
import qualified Data.Aeson as Aeson
@@ -107,6 +108,10 @@ newtype AlonzoGenesisError
107108
= AlonzoGenErrTooMuchPrecision Rational
108109
deriving Show
109110

111+
instance Exception AlonzoGenesisError where
112+
displayException = Api.docToString . Api.prettyError
113+
114+
110115
defaultAlonzoGenesis :: ShelleyBasedEra era -> Either AlonzoGenesisError AlonzoGenesis
111116
defaultAlonzoGenesis sbe = do
112117
let genesis = Api.alonzoGenesisDefaults (toCardanoEra sbe)

‎cardano-testnet/src/Testnet/Orphans.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
2+
3+
module Testnet.Orphans () where
4+
5+
import RIO (RIO(..), liftIO)
6+
7+
instance MonadFail (RIO env) where
8+
fail = liftIO . fail

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,8 @@ import Prelude
2222

2323
import Control.Monad
2424
import qualified Data.Aeson as Aeson
25-
import qualified Data.Aeson as J
2625
import qualified Data.Aeson.Encode.Pretty as Aeson
26+
import qualified Data.Aeson as J
2727
import Data.Default.Class
2828
import Data.Function
2929
import qualified Data.Map.Strict as Map
@@ -39,6 +39,7 @@ import Testnet.Process.Cli.SPO
3939
import Testnet.Process.Run (execCli, execCli', mkExecConfig)
4040
import Testnet.Property.Util (decodeEraUTxO, integrationRetryWorkspace)
4141
import Testnet.Runtime
42+
import Testnet.Start.Cardano (liftToIntegration)
4243
import Testnet.Types
4344

4445
import Hedgehog (Property)
@@ -255,7 +256,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs
255256
, "--out-file", testSpoOperationalCertFp
256257
]
257258

258-
jsonBS <- Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
259+
jsonBS <- liftToIntegration $ Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
259260
H.lbsWriteFile (unFile configurationFile) jsonBS
260261
newNodePortNumber <- H.randomPort testnetDefaultIpv4Address
261262
eRuntime <- runExceptT . retryOnAddressInUseError $

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ import Testnet.Process.Run (execCli, execCli', mkExecConfig)
4545
import Testnet.Property.Assert
4646
import Testnet.Property.Util (decodeEraUTxO, integrationRetryWorkspace)
4747
import Testnet.Runtime
48+
import Testnet.Start.Cardano
4849
import Testnet.Types
4950

5051
import Hedgehog (Property, (===))
@@ -256,8 +257,8 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \
256257
, "--operational-certificate-issue-counter-file", testSpoOperationalCertFp
257258
, "--out-file", testSpoOperationalCertFp
258259
]
259-
260-
jsonBS <- Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
260+
jsonBS <- liftToIntegration $
261+
Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
261262
H.lbsWriteFile (unFile configurationFile) jsonBS
262263
newNodePort <- H.randomPort testnetDefaultIpv4Address
263264
eRuntime <- runExceptT . retryOnAddressInUseError $

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/DumpConfig.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ import System.FilePath ((</>))
2525

2626
import Testnet.Components.Configuration (startTimeOffsetSeconds)
2727
import Testnet.Property.Util (integrationRetryWorkspace)
28+
import Testnet.Start.Cardano (liftToIntegration)
2829
import Testnet.Start.Types (GenesisHashesPolicy (..), GenesisOptions (..),
2930
UserProvidedEnv (..))
3031

@@ -43,7 +44,8 @@ hprop_dump_config = integrationRetryWorkspace 2 "dump-config-files" $ \tmpDir ->
4344

4445
-- Generate the sandbox
4546
conf <- mkConf tmpDir
46-
createTestnetEnv
47+
48+
liftToIntegration $ createTestnetEnv
4749
testnetOptions genesisOptions def
4850
-- Do not add hashes to the main config file, so that genesis files
4951
-- can be modified without having to recompute hashes every time.
@@ -69,6 +71,6 @@ hprop_dump_config = integrationRetryWorkspace 2 "dump-config-files" $ \tmpDir ->
6971
H.lbsWriteFile shelleyGenesisFile $ encodePretty shelleyGenesis
7072

7173
-- Run testnet with generated config
72-
runtime <- cardanoTestnet testnetOptions conf
74+
runtime <- liftToIntegration $ cardanoTestnet testnetOptions conf
7375

7476
nodesProduceBlocks tmpDir runtime

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ import qualified Testnet.Process.Cli.SPO as SPO
4040
import Testnet.Process.Cli.Transaction
4141
import qualified Testnet.Process.Run as H
4242
import Testnet.Property.Util (integrationWorkspace)
43+
import Testnet.Start.Cardano (liftToIntegration)
4344
import Testnet.Start.Types
4445
import Testnet.Types
4546

@@ -101,18 +102,18 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
101102
let comKeyCred1 = L.KeyHashObj comKeyHash1
102103
committeeThreshold = unsafeBoundedRational 0.5
103104
committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold
104-
105-
createTestnetEnv fastTestnetOptions genesisOptions def conf
105+
106+
liftToIntegration $ createTestnetEnv fastTestnetOptions genesisOptions def conf
106107

107108
H.rewriteJsonFile (tempAbsBasePath' </> "conway-genesis.json") $
108109
\conwayGenesis -> conwayGenesis { L.cgCommittee = committee }
109-
110+
110111
TestnetRuntime
111112
{ testnetMagic
112113
, testnetNodes
113114
, wallets=wallet0:_wallet1:_
114115
, configurationFile
115-
} <- cardanoTestnet fastTestnetOptions conf
116+
} <- liftToIntegration $ cardanoTestnet fastTestnetOptions conf
116117

117118
poolNode1 <- H.headM testnetNodes
118119
poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/MainnetParams.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Lens.Micro ((^?))
1717

1818
import Testnet.Process.Run (execCli', mkExecConfig)
1919
import Testnet.Property.Util (integrationRetryWorkspace)
20+
import Testnet.Start.Cardano (liftToIntegration)
2021
import Testnet.Start.Types (CreateEnvOptions (..), GenesisOptions (..),
2122
UserProvidedEnv (..), TestnetOnChainParams (..))
2223

@@ -38,14 +39,14 @@ hprop_mainnet_params = integrationRetryWorkspace 2 "mainnet-params" $ \tmpDir ->
3839

3940
-- Generate the sandbox
4041
conf <- mkConf tmpDir
41-
createTestnetEnv
42+
liftToIntegration $ createTestnetEnv
4243
testnetOptions genesisOptions createEnvOptions conf
4344

4445
-- Run testnet with mainnet on-chain params
4546
TestnetRuntime
4647
{ testnetNodes
4748
, testnetMagic
48-
} <- cardanoTestnet testnetOptions conf
49+
} <- liftToIntegration $ cardanoTestnet testnetOptions conf
4950

5051
-- Get a running node
5152
TestnetNode{nodeSprocket} <- H.headM testnetNodes

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,6 @@ module Cardano.Testnet.Test.Node.Shutdown
1313
import Cardano.Api
1414

1515
import Cardano.Testnet
16-
import qualified Cardano.Testnet as Testnet
1716

1817
import Prelude
1918

@@ -36,11 +35,12 @@ import qualified System.IO as IO
3635
import qualified System.Process as IO
3736
import System.Process (interruptProcessGroupOf)
3837

39-
import Testnet.Components.Configuration
38+
import qualified Testnet.Components.Configuration as Testnet
4039
import Testnet.Defaults
4140
import Testnet.Process.Run (execCli_, initiateProcess, procNode)
4241
import Testnet.Property.Util (integrationRetryWorkspace)
4342
import Testnet.Start.Byron
43+
import Testnet.Start.Cardano
4444
import Testnet.Start.Types
4545

4646
import Hedgehog (Property, (===))
@@ -53,6 +53,7 @@ import qualified Hedgehog.Extras.Test.Concurrent as H
5353
import qualified Hedgehog.Extras.Test.File as H
5454
import qualified Hedgehog.Extras.Test.Process as H
5555
import qualified Hedgehog.Extras.Test.TestWatchdog as H
56+
import Testnet.Process.RunIO (liftIOAnnotated)
5657

5758
{- HLINT ignore "Redundant <&>" -}
5859

@@ -106,8 +107,8 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H
106107

107108
-- 2. Create Alonzo genesis
108109
alonzoBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' </> shelleyDir </> "genesis.alonzo.spec.json"
109-
gen <- Testnet.getDefaultAlonzoGenesis sbe
110-
H.evalIO $ LBS.writeFile alonzoBabbageTestGenesisJsonTargetFile $ encode gen
110+
gen <- liftToIntegration $ Testnet.getDefaultAlonzoGenesis sbe
111+
liftIOAnnotated $ LBS.writeFile alonzoBabbageTestGenesisJsonTargetFile $ encode gen
111112

112113
-- 2. Create Conway genesis
113114
conwayBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' </> shelleyDir </> "genesis.conway.spec.json"
@@ -121,16 +122,20 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H
121122
, "--start-time", formatIso8601 startTime
122123
]
123124

124-
byronGenesisHash <- getByronGenesisHash $ byronGenesisOutputDir </> "genesis.json"
125+
byronGenesisHash <- liftToIntegration $ Testnet.getByronGenesisHash $ byronGenesisOutputDir </> "genesis.json"
126+
125127
-- Move the files to the paths expected by 'defaultYamlHardforkViaConfig' below
126128
H.renameFile (byronGenesisOutputDir </> "genesis.json") (tempAbsPath' </> defaultGenesisFilepath ByronEra)
127129
H.renameFile (tempAbsPath' </> "shelley/genesis.json") (tempAbsPath' </> defaultGenesisFilepath ShelleyEra)
128130
H.renameFile (tempAbsPath' </> "shelley/genesis.alonzo.json") (tempAbsPath' </> defaultGenesisFilepath AlonzoEra)
129131
H.renameFile (tempAbsPath' </> "shelley/genesis.conway.json") (tempAbsPath' </> defaultGenesisFilepath ConwayEra)
130132

131-
shelleyGenesisHash <- getShelleyGenesisHash (tempAbsPath' </> defaultGenesisFilepath ShelleyEra) "ShelleyGenesisHash"
132-
alonzoGenesisHash <- getShelleyGenesisHash (tempAbsPath' </> defaultGenesisFilepath AlonzoEra) "AlonzoGenesisHash"
133-
133+
(shelleyGenesisHash,alonzoGenesisHash) <-
134+
liftToIntegration $ do
135+
shelleyGenesisHash <- Testnet.getShelleyGenesisHash (tempAbsPath' </> defaultGenesisFilepath ShelleyEra) "ShelleyGenesisHash"
136+
alonzoGenesisHash <- Testnet.getShelleyGenesisHash (tempAbsPath' </> defaultGenesisFilepath AlonzoEra) "AlonzoGenesisHash"
137+
return (shelleyGenesisHash, alonzoGenesisHash)
138+
134139
let finalYamlConfig :: LBS.ByteString
135140
finalYamlConfig = encode . Object
136141
$ mconcat [ byronGenesisHash
@@ -164,7 +169,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H
164169
eProcess <- runExceptT $ initiateProcess process
165170
case eProcess of
166171
Left e -> H.failMessage GHC.callStack $ mconcat ["Failed to initiate node process: ", show e]
167-
Right (mStdin, _mStdout, _mStderr, pHandle, _releaseKey) -> do
172+
Right (mStdin, _mStdout, _mStderr, pHandle, _) -> do
168173
H.threadDelay $ 10 * 1000000
169174

170175
mExitCodeRunning <- H.evalIO $ IO.getProcessExitCode pHandle

0 commit comments

Comments
 (0)