Skip to content

Commit c1b2b37

Browse files
newhoggynewhoggy
committed
Using onLeft combinator in more places
1 parent 095d372 commit c1b2b37

File tree

1 file changed

+49
-59
lines changed
  • cardano-cli/src/Cardano/CLI/Shelley/Run

1 file changed

+49
-59
lines changed

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

+49-59
Original file line numberDiff line numberDiff line change
@@ -210,8 +210,7 @@ runQueryProtocolParameters
210210
-> Maybe OutputFile
211211
-> ExceptT ShelleyQueryCmdError IO ()
212212
runQueryProtocolParameters (AnyConsensusModeParams cModeParams) network mOutFile = do
213-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
214-
$ newExceptT readEnvSocketPath
213+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
215214
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
216215

217216
result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do
@@ -373,9 +372,8 @@ runQueryUTxO (AnyConsensusModeParams cModeParams)
373372
$ newExceptT readEnvSocketPath
374373
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
375374

376-
anyE@(AnyCardanoEra era) <-
377-
firstExceptT ShelleyQueryCmdAcquireFailure
378-
. newExceptT $ determineEra cModeParams localNodeConnInfo
375+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
376+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
379377

380378
let cMode = consensusModeOnly cModeParams
381379
sbe <- getSbe $ cardanoEraStyle era
@@ -402,16 +400,14 @@ runQueryKesPeriodInfo
402400
runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFile
403401
mOutFile = do
404402

405-
opCert <- firstExceptT ShelleyQueryCmdOpCertCounterReadError
406-
. newExceptT $ readFileTextEnvelope AsOperationalCertificate nodeOpCertFile
403+
opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile)
404+
& onLeft (throwE . ShelleyQueryCmdOpCertCounterReadError)
407405

408-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
409-
$ newExceptT readEnvSocketPath
406+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
410407
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
411408

412-
anyE@(AnyCardanoEra era) <-
413-
firstExceptT ShelleyQueryCmdAcquireFailure
414-
. newExceptT $ determineEra cModeParams localNodeConnInfo
409+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
410+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
415411

416412
let cMode = consensusModeOnly cModeParams
417413
sbe <- getSbe $ cardanoEraStyle era
@@ -433,7 +429,8 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
433429
oCertEndKesPeriod = opCertEndKesPeriod gParams opCert
434430
opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod
435431

436-
eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
432+
eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
433+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
437434

438435
let eInfo = toEpochInfo eraHistory
439436

@@ -613,14 +610,12 @@ runQueryPoolState
613610
-> [Hash StakePoolKey]
614611
-> ExceptT ShelleyQueryCmdError IO ()
615612
runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do
616-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
617-
$ newExceptT readEnvSocketPath
618-
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
613+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
619614

615+
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
620616

621-
anyE@(AnyCardanoEra era) <-
622-
firstExceptT ShelleyQueryCmdAcquireFailure
623-
. newExceptT $ determineEra cModeParams localNodeConnInfo
617+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
618+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
624619

625620
let cMode = consensusModeOnly cModeParams
626621
sbe <- getSbe $ cardanoEraStyle era
@@ -640,14 +635,13 @@ runQueryTxMempool
640635
-> Maybe OutputFile
641636
-> ExceptT ShelleyQueryCmdError IO ()
642637
runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile = do
643-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
644-
$ newExceptT readEnvSocketPath
638+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
645639
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
646640

647641
localQuery <- case query of
648642
TxMempoolQueryTxExists tx -> do
649-
anyE@(AnyCardanoEra era) <- firstExceptT ShelleyQueryCmdAcquireFailure
650-
. newExceptT $ determineEra cModeParams localNodeConnInfo
643+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
644+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
651645
let cMode = consensusModeOnly cModeParams
652646
eInMode <- toEraInMode era cMode
653647
& hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)
@@ -676,9 +670,8 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network allOrOnlyPool
676670
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr $ newExceptT readEnvSocketPath
677671
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
678672

679-
anyE@(AnyCardanoEra era) <-
680-
firstExceptT ShelleyQueryCmdAcquireFailure
681-
. newExceptT $ determineEra cModeParams localNodeConnInfo
673+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
674+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
682675

683676
let cMode = consensusModeOnly cModeParams
684677
sbe <- getSbe $ cardanoEraStyle era
@@ -701,13 +694,11 @@ runQueryLedgerState
701694
-> ExceptT ShelleyQueryCmdError IO ()
702695
runQueryLedgerState (AnyConsensusModeParams cModeParams)
703696
network mOutFile = do
704-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
705-
$ newExceptT readEnvSocketPath
697+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
706698
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
707699

708-
anyE@(AnyCardanoEra era) <-
709-
firstExceptT ShelleyQueryCmdAcquireFailure
710-
. newExceptT $ determineEra cModeParams localNodeConnInfo
700+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
701+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
711702

712703
let cMode = consensusModeOnly cModeParams
713704
sbe <- getSbe $ cardanoEraStyle era
@@ -733,13 +724,11 @@ runQueryProtocolState
733724
-> ExceptT ShelleyQueryCmdError IO ()
734725
runQueryProtocolState (AnyConsensusModeParams cModeParams)
735726
network mOutFile = do
736-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
737-
$ newExceptT readEnvSocketPath
727+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
738728
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
739729

740-
anyE@(AnyCardanoEra era) <-
741-
firstExceptT ShelleyQueryCmdAcquireFailure
742-
. newExceptT $ determineEra cModeParams localNodeConnInfo
730+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
731+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
743732

744733
let cMode = consensusModeOnly cModeParams
745734
sbe <- getSbe $ cardanoEraStyle era
@@ -772,13 +761,11 @@ runQueryStakeAddressInfo
772761
-> ExceptT ShelleyQueryCmdError IO ()
773762
runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams)
774763
(StakeAddress _ addr) network mOutFile = do
775-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
776-
$ newExceptT readEnvSocketPath
764+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
777765
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
778766

779-
anyE@(AnyCardanoEra era) <-
780-
firstExceptT ShelleyQueryCmdAcquireFailure
781-
. newExceptT $ determineEra cModeParams localNodeConnInfo
767+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
768+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
782769

783770
let cMode = consensusModeOnly cModeParams
784771
sbe <- getSbe $ cardanoEraStyle era
@@ -1063,13 +1050,11 @@ runQueryStakeDistribution
10631050
-> ExceptT ShelleyQueryCmdError IO ()
10641051
runQueryStakeDistribution (AnyConsensusModeParams cModeParams)
10651052
network mOutFile = do
1066-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
1067-
$ newExceptT readEnvSocketPath
1053+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
10681054
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
10691055

1070-
anyE@(AnyCardanoEra era) <-
1071-
firstExceptT ShelleyQueryCmdAcquireFailure
1072-
. newExceptT $ determineEra cModeParams localNodeConnInfo
1056+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
1057+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
10731058

10741059
let cMode = consensusModeOnly cModeParams
10751060
sbe <- getSbe $ cardanoEraStyle era
@@ -1191,24 +1176,24 @@ runQueryLeadershipSchedule
11911176
runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
11921177
(GenesisFile genFile) coldVerKeyFile (SigningKeyFile vrfSkeyFp)
11931178
whichSchedule mJsonOutputFile = do
1194-
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
1195-
$ newExceptT readEnvSocketPath
1179+
SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
11961180
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
11971181

1198-
anyE@(AnyCardanoEra era) <-
1199-
firstExceptT ShelleyQueryCmdAcquireFailure
1200-
. newExceptT $ determineEra cModeParams localNodeConnInfo
1182+
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
1183+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
12011184

12021185
sbe <- getSbe $ cardanoEraStyle era
12031186
let cMode = consensusModeOnly cModeParams
12041187

1205-
poolid <- firstExceptT ShelleyQueryCmdTextReadError
1206-
. newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile
1188+
poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile)
1189+
& onLeft (throwE . ShelleyQueryCmdTextReadError)
1190+
1191+
vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp)
1192+
& onLeft (throwE . ShelleyQueryCmdTextEnvelopeReadError)
1193+
1194+
shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile)
1195+
& onLeft (throwE . ShelleyQueryCmdGenesisReadError)
12071196

1208-
vrkSkey <- firstExceptT ShelleyQueryCmdTextEnvelopeReadError . newExceptT
1209-
$ readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp
1210-
shelleyGenesis <- firstExceptT ShelleyQueryCmdGenesisReadError $
1211-
newExceptT $ readAndDecodeShelleyGenesis genFile
12121197
case cMode of
12131198
CardanoMode -> do
12141199
eInMode <- toEraInMode era cMode
@@ -1220,15 +1205,20 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
12201205

12211206
pparams <- executeQuery era cModeParams localNodeConnInfo pparamsQuery
12221207
ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQuery
1223-
eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
1224-
let eInfo = toEpochInfo eraHistory
1208+
eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
1209+
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
1210+
12251211
let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch
1212+
12261213
curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery
12271214

1215+
let eInfo = toEpochInfo eraHistory
1216+
12281217
schedule <- case whichSchedule of
12291218
CurrentEpoch -> do
12301219
serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo $
12311220
QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryPoolDistribution (Just (Set.singleton poolid)))
1221+
12321222
firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither
12331223
$ eligibleLeaderSlotsConstaints sbe
12341224
$ currentEpochEligibleLeadershipSlots

0 commit comments

Comments
 (0)