Skip to content

Commit af982a3

Browse files
Jimbo4350Jimbo4350
committed
Convert runLegacyCmds to use CIO e ()
1 parent a2ccedc commit af982a3

File tree

4 files changed

+41
-42
lines changed

4 files changed

+41
-42
lines changed

‎cardano-cli/src/Cardano/CLI/Legacy/Genesis/Run.hs

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -22,14 +22,13 @@ import Cardano.CLI.EraBased.Genesis.CreateTestnetData.Run qualified as CreateTes
2222
import Cardano.CLI.EraBased.Genesis.Run
2323
import Cardano.CLI.Legacy.Genesis.Command
2424
import Cardano.CLI.Type.Common
25-
import Cardano.CLI.Type.Error.GenesisCmdError
2625
import Cardano.Ledger.BaseTypes (NonZero)
2726

2827
import RIO
2928

3029
import Vary (Vary)
3130

32-
runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO ()
31+
runLegacyGenesisCmds :: LegacyGenesisCmds -> CIO e ()
3332
runLegacyGenesisCmds = \case
3433
GenesisKeyGenGenesis vk sk ->
3534
runLegacyGenesisKeyGenGenesisCmd vk sk
@@ -49,27 +48,24 @@ runLegacyGenesisCmds = \case
4948
runLegacyGenesisCreateCmd eSbe fmt gd gn un ms am nw
5049
GenesisCreateCardano eSbe gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg ->
5150
runLegacyGenesisCreateCardanoCmd eSbe gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg
52-
c@(GenesisCreateStaked eSbe fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp) ->
53-
newExceptT $
54-
runRIO () $
55-
(Right <$> runLegacyGenesisCreateStakedCmd eSbe fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp)
56-
`catch` (pure . Left . GenesisCmdBackwardCompatibleError (renderLegacyGenesisCmds c))
51+
GenesisCreateStaked eSbe fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp ->
52+
runLegacyGenesisCreateStakedCmd eSbe fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp
5753
GenesisHashFile gf ->
5854
runLegacyGenesisHashFileCmd gf
5955

6056
runLegacyGenesisKeyGenGenesisCmd
6157
:: ()
6258
=> VerificationKeyFile Out
6359
-> SigningKeyFile Out
64-
-> ExceptT GenesisCmdError IO ()
60+
-> CIO e ()
6561
runLegacyGenesisKeyGenGenesisCmd vk sk = CreateTestnetData.runGenesisKeyGenGenesisCmd $ GenesisKeyGenGenesisCmdArgs vk sk
6662

6763
runLegacyGenesisKeyGenDelegateCmd
6864
:: ()
6965
=> VerificationKeyFile Out
7066
-> SigningKeyFile Out
7167
-> OpCertCounterFile Out
72-
-> ExceptT GenesisCmdError IO ()
68+
-> CIO e ()
7369
runLegacyGenesisKeyGenDelegateCmd vkf skf okf =
7470
CreateTestnetData.runGenesisKeyGenDelegateCmd
7571
Cmd.GenesisKeyGenDelegateCmdArgs
@@ -82,21 +78,21 @@ runLegacyGenesisKeyGenUTxOCmd
8278
:: ()
8379
=> VerificationKeyFile Out
8480
-> SigningKeyFile Out
85-
-> ExceptT GenesisCmdError IO ()
81+
-> CIO e ()
8682
runLegacyGenesisKeyGenUTxOCmd vk sk =
8783
CreateTestnetData.runGenesisKeyGenUTxOCmd
8884
Cmd.GenesisKeyGenUTxOCmdArgs
8985
{ Cmd.verificationKeyPath = vk
9086
, Cmd.signingKeyPath = sk
9187
}
9288

93-
runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO ()
89+
runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> CIO e ()
9490
runLegacyGenesisKeyHashCmd = runGenesisKeyHashCmd
9591

9692
runLegacyGenesisVerKeyCmd
9793
:: VerificationKeyFile Out
9894
-> SigningKeyFile In
99-
-> ExceptT GenesisCmdError IO ()
95+
-> CIO e ()
10096
runLegacyGenesisVerKeyCmd vk sk =
10197
runGenesisVerKeyCmd
10298
Cmd.GenesisVerKeyCmdArgs
@@ -109,7 +105,7 @@ runLegacyGenesisTxInCmd
109105
=> VerificationKeyFile In
110106
-> NetworkId
111107
-> Maybe (File () Out)
112-
-> ExceptT GenesisCmdError IO ()
108+
-> CIO e ()
113109
runLegacyGenesisTxInCmd vkt nid mOf =
114110
runGenesisTxInCmd
115111
Cmd.GenesisTxInCmdArgs
@@ -123,7 +119,7 @@ runLegacyGenesisAddrCmd
123119
=> VerificationKeyFile In
124120
-> NetworkId
125121
-> Maybe (File () Out)
126-
-> ExceptT GenesisCmdError IO ()
122+
-> CIO e ()
127123
runLegacyGenesisAddrCmd vkf nid mOf =
128124
runGenesisAddrCmd
129125
Cmd.GenesisAddrCmdArgs
@@ -144,7 +140,7 @@ runLegacyGenesisCreateCmd
144140
-> Maybe SystemStart
145141
-> Maybe Coin
146142
-> NetworkId
147-
-> ExceptT GenesisCmdError IO ()
143+
-> CIO e ()
148144
runLegacyGenesisCreateCmd (EraInEon asbe) fmt genDir nGenKeys nUTxOKeys mStart mSupply network =
149145
runGenesisCreateCmd
150146
Cmd.GenesisCreateCmdArgs
@@ -182,7 +178,7 @@ runLegacyGenesisCreateCardanoCmd
182178
-> FilePath
183179
-- ^ Conway Genesis
184180
-> Maybe FilePath
185-
-> ExceptT GenesisCmdError IO ()
181+
-> CIO e ()
186182
runLegacyGenesisCreateCardanoCmd
187183
(EraInEon sbe)
188184
genDir
@@ -286,5 +282,5 @@ runLegacyGenesisCreateStakedCmd
286282
runLegacyGenesisHashFileCmd
287283
:: ()
288284
=> GenesisFile
289-
-> ExceptT GenesisCmdError IO ()
285+
-> CIO e ()
290286
runLegacyGenesisHashFileCmd = runGenesisHashFileCmd

‎cardano-cli/src/Cardano/CLI/Legacy/Governance/Run.hs

Lines changed: 18 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,9 @@
33
{-# LANGUAGE GADTs #-}
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE NamedFieldPuns #-}
6+
{-# LANGUAGE RankNTypes #-}
67
{-# LANGUAGE ScopedTypeVariables #-}
8+
{-# LANGUAGE TypeApplications #-}
79

810
module Cardano.CLI.Legacy.Governance.Run
911
( runLegacyGovernanceCmds
@@ -14,24 +16,24 @@ import Cardano.Api
1416
import Cardano.Api.Ledger qualified as L
1517
import Cardano.Api.Shelley
1618

19+
import Cardano.CLI.Compatible.Exception
1720
import Cardano.CLI.EraBased.Governance.GenesisKeyDelegationCertificate.Run
1821
( runGovernanceGenesisKeyDelegationCertificate
1922
)
2023
import Cardano.CLI.EraBased.Governance.Poll.Command qualified as Cmd
2124
import Cardano.CLI.EraBased.Governance.Poll.Run
2225
import Cardano.CLI.EraBased.Governance.Run
2326
import Cardano.CLI.Legacy.Governance.Command
27+
import Cardano.CLI.Orphan ()
2428
import Cardano.CLI.Type.Common
2529
import Cardano.CLI.Type.Error.GovernanceCmdError
2630

2731
import Control.Monad
2832
import Data.Aeson (eitherDecode)
2933
import Data.ByteString.Lazy qualified as LB
30-
import Data.Function ((&))
3134
import Data.Text (Text)
32-
import Data.Text qualified as Text
3335

34-
runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
36+
runLegacyGovernanceCmds :: LegacyGovernanceCmds -> CIO e ()
3537
runLegacyGovernanceCmds = \case
3638
GovernanceCreateMirCertificateStakeAddressesCmd anyEra mirpot vKeys rewards out ->
3739
runLegacyGovernanceMIRCertificatePayStakeAddrs anyEra mirpot vKeys rewards out
@@ -56,7 +58,7 @@ runLegacyGovernanceCreatePoll
5658
-> [Text]
5759
-> Maybe Word
5860
-> File GovernancePoll Out
59-
-> ExceptT GovernanceCmdError IO ()
61+
-> CIO e ()
6062
runLegacyGovernanceCreatePoll prompt choices nonce outFile =
6163
runGovernanceCreatePollCmd
6264
Cmd.GovernanceCreatePollCmdArgs
@@ -72,7 +74,7 @@ runLegacyGovernanceAnswerPoll
7274
=> File GovernancePoll In
7375
-> Maybe Word
7476
-> Maybe (File () Out)
75-
-> ExceptT GovernanceCmdError IO ()
77+
-> CIO e ()
7678
runLegacyGovernanceAnswerPoll pollFile answerIndex mOutFile =
7779
runGovernanceAnswerPollCmd
7880
Cmd.GovernanceAnswerPollCmdArgs
@@ -87,7 +89,7 @@ runLegacyGovernanceVerifyPoll
8789
=> File GovernancePoll In
8890
-> File (Tx ()) In
8991
-> Maybe (File () Out)
90-
-> ExceptT GovernanceCmdError IO ()
92+
-> CIO e ()
9193
runLegacyGovernanceVerifyPoll pollFile txFile mOutFile =
9294
runGovernanceVerifyPollCmd
9395
Cmd.GovernanceVerifyPollCmdArgs
@@ -105,23 +107,23 @@ runLegacyGovernanceMIRCertificatePayStakeAddrs
105107
-> [Lovelace]
106108
-- ^ Corresponding reward amounts (same length)
107109
-> File () Out
108-
-> ExceptT GovernanceCmdError IO ()
110+
-> CIO e ()
109111
runLegacyGovernanceMIRCertificatePayStakeAddrs (EraInEon w) =
110112
runGovernanceMIRCertificatePayStakeAddrs w
111113

112114
runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd
113115
:: EraInEon ShelleyToBabbageEra
114116
-> Lovelace
115117
-> File () Out
116-
-> ExceptT GovernanceCmdError IO ()
118+
-> CIO e ()
117119
runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd (EraInEon w) =
118120
runGovernanceCreateMirCertificateTransferToTreasuryCmd w
119121

120122
runLegacyGovernanceCreateMirCertificateTransferToReservesCmd
121123
:: EraInEon ShelleyToBabbageEra
122124
-> Lovelace
123125
-> File () Out
124-
-> ExceptT GovernanceCmdError IO ()
126+
-> CIO e ()
125127
runLegacyGovernanceCreateMirCertificateTransferToReservesCmd (EraInEon w) =
126128
runGovernanceCreateMirCertificateTransferToReservesCmd w
127129

@@ -133,34 +135,33 @@ runLegacyGovernanceUpdateProposal
133135
-> ProtocolParametersUpdate
134136
-> Maybe FilePath
135137
-- ^ Cost models file path
136-
-> ExceptT GovernanceCmdError IO ()
138+
-> CIO e ()
137139
runLegacyGovernanceUpdateProposal upFile eNo genVerKeyFiles upPprams mCostModelFp = do
138140
finalUpPprams <- case mCostModelFp of
139141
Nothing -> return upPprams
140142
Just fp -> do
141-
costModelsBs <- handleIOExceptT (GovernanceCmdCostModelReadError . FileIOError fp) $ LB.readFile fp
143+
costModelsBs <- readFileCli fp
142144

143145
cModels <-
144-
pure (eitherDecode costModelsBs)
145-
& onLeft (left . GovernanceCmdCostModelsJsonDecodeErr fp . Text.pack)
146+
fromEitherCli (eitherDecode $ LB.fromStrict costModelsBs)
146147

147148
let costModels = fromAlonzoCostModels cModels
148149

149-
when (null costModels) $ left (GovernanceCmdEmptyCostModel fp)
150+
when (null costModels) $ throwCliError (GovernanceCmdEmptyCostModel fp)
150151

151152
return $ upPprams{protocolUpdateCostModels = costModels}
152153

153-
when (finalUpPprams == mempty) $ left GovernanceCmdEmptyUpdateProposalError
154+
when (finalUpPprams == mempty) $ throwCliError GovernanceCmdEmptyUpdateProposalError
154155

155156
genVKeys <-
156157
sequence
157-
[ firstExceptT GovernanceCmdTextEnvReadError . newExceptT $
158+
[ fromEitherIOCli $
158159
readFileTextEnvelope (AsVerificationKey AsGenesisKey) vkeyFile
159160
| vkeyFile <- genVerKeyFiles
160161
]
161162
let genKeyHashes = fmap verificationKeyHash genVKeys
162163
upProp = makeShelleyUpdateProposal finalUpPprams genKeyHashes eNo
163164

164-
firstExceptT GovernanceCmdTextEnvWriteError . newExceptT $
165+
fromEitherIOCli @(FileError ()) $
165166
writeLazyByteStringFile upFile $
166167
textEnvelopeToJSON Nothing upProp

‎cardano-cli/src/Cardano/CLI/Legacy/Run.hs

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,17 @@
11
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE RankNTypes #-}
23

34
module Cardano.CLI.Legacy.Run
45
( runLegacyCmds
56
)
67
where
78

9+
import Cardano.CLI.Compatible.Exception
810
import Cardano.CLI.Legacy.Genesis.Run
911
import Cardano.CLI.Legacy.Governance.Run
1012
import Cardano.CLI.Legacy.Option
11-
import Cardano.CLI.Type.Error.CmdError
1213

13-
import Control.Monad.Trans.Except (ExceptT)
14-
import Control.Monad.Trans.Except.Extra (firstExceptT)
15-
16-
runLegacyCmds :: LegacyCmds -> ExceptT CmdError IO ()
14+
runLegacyCmds :: LegacyCmds -> CIO e ()
1715
runLegacyCmds = \case
18-
LegacyGenesisCmds cmd -> firstExceptT CmdGenesisError $ runLegacyGenesisCmds cmd
19-
LegacyGovernanceCmds cmd -> firstExceptT CmdGovernanceCmdError $ runLegacyGovernanceCmds cmd
16+
LegacyGenesisCmds cmd -> runLegacyGenesisCmds cmd
17+
LegacyGovernanceCmds cmd -> runLegacyGovernanceCmds cmd

‎cardano-cli/src/Cardano/CLI/Run.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,11 @@ runClientCommand = \case
106106
KeyCommands cmds ->
107107
firstExceptT KeyCmdError $ runKeyCmds cmds
108108
LegacyCmds cmds ->
109-
firstExceptT (CmdError (renderLegacyCommand cmds)) $ runLegacyCmds cmds
109+
newExceptT $
110+
runRIO () $
111+
catch
112+
(Right <$> runLegacyCmds cmds)
113+
(pure . Left . BackwardCompatibleError (renderLegacyCommand cmds))
110114
QueryCommands cmds ->
111115
firstExceptT QueryCmdError $ runQueryCmds cmds
112116
CliPingCommand cmds ->

0 commit comments

Comments
 (0)