Skip to content

Commit d47a3e3

Browse files
newhoggynewhoggy
committed
Handle toEraInMode errors with onNothing
1 parent 14eb838 commit d47a3e3

File tree

1 file changed

+63
-87
lines changed
  • cardano-cli/src/Cardano/CLI/Shelley/Run

1 file changed

+63
-87
lines changed

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

+63-87
Original file line numberDiff line numberDiff line change
@@ -374,23 +374,20 @@ runQueryUTxO (AnyConsensusModeParams cModeParams)
374374
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
375375

376376
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
377-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
377+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
378378

379379
let cMode = consensusModeOnly cModeParams
380380
sbe <- getSbe $ cardanoEraStyle era
381381

382-
case toEraInMode era cMode of
383-
Just eInMode -> do
384-
let query = QueryInShelleyBasedEra sbe (QueryUTxO qfilter)
385-
qInMode = QueryInEra eInMode query
386-
result <- executeQuery
387-
era
388-
cModeParams
389-
localNodeConnInfo
390-
qInMode
391-
writeFilteredUTxOs sbe mOutFile result
392-
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
382+
eInMode <- pure (toEraInMode era cMode)
383+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE))
393384

385+
let query = QueryInShelleyBasedEra sbe (QueryUTxO qfilter)
386+
qInMode = QueryInEra eInMode query
387+
388+
result <- executeQuery era cModeParams localNodeConnInfo qInMode
389+
390+
writeFilteredUTxOs sbe mOutFile result
394391

395392
runQueryKesPeriodInfo
396393
:: AnyConsensusModeParams
@@ -402,14 +399,14 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
402399
mOutFile = do
403400

404401
opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile)
405-
& onLeft (throwE . ShelleyQueryCmdOpCertCounterReadError)
402+
& onLeft (left . ShelleyQueryCmdOpCertCounterReadError)
406403

407404
SocketPath sockPath <- lift readEnvSocketPath & onLeft (left . ShelleyQueryCmdEnvVarSocketErr)
408405

409406
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
410407

411408
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
412-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
409+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
413410

414411
let cMode = consensusModeOnly cModeParams
415412
sbe <- getSbe $ cardanoEraStyle era
@@ -432,7 +429,7 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
432429
opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod
433430

434431
eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
435-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
432+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
436433

437434
let eInfo = toEpochInfo eraHistory
438435

@@ -568,7 +565,7 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
568565
let onDiskOpCertCount = fromIntegral $ getOpCertCount opCert
569566

570567
chainDepState <- pure (decodeProtocolState ptclState)
571-
& onLeft (throwE . ShelleyQueryCmdProtocolStateDecodeFailure)
568+
& onLeft (left . ShelleyQueryCmdProtocolStateDecodeFailure)
572569

573570
-- We need the stake pool id to determine what the counter of our SPO
574571
-- should be.
@@ -618,7 +615,7 @@ runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do
618615
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
619616

620617
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
621-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
618+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
622619

623620
let cMode = consensusModeOnly cModeParams
624621
sbe <- getSbe $ cardanoEraStyle era
@@ -645,7 +642,7 @@ runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile =
645642
localQuery <- case query of
646643
TxMempoolQueryTxExists tx -> do
647644
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
648-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
645+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
649646
let cMode = consensusModeOnly cModeParams
650647
eInMode <- toEraInMode era cMode
651648
& hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)
@@ -676,7 +673,7 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network allOrOnlyPool
676673
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
677674

678675
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
679-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
676+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
680677

681678
let cMode = consensusModeOnly cModeParams
682679
sbe <- getSbe $ cardanoEraStyle era
@@ -704,24 +701,19 @@ runQueryLedgerState (AnyConsensusModeParams cModeParams)
704701
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
705702

706703
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
707-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
704+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
708705

709706
let cMode = consensusModeOnly cModeParams
710707
sbe <- getSbe $ cardanoEraStyle era
711708

712-
case toEraInMode era cMode of
713-
Just eInMode -> do
714-
let qInMode = QueryInEra eInMode
715-
. QueryInShelleyBasedEra sbe
716-
$ QueryDebugLedgerState
717-
result <- executeQuery
718-
era
719-
cModeParams
720-
localNodeConnInfo
721-
qInMode
722-
obtainLedgerEraClassConstraints sbe (writeLedgerState mOutFile) result
723-
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
709+
eInMode <- pure (toEraInMode era cMode)
710+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE))
711+
712+
let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryDebugLedgerState
724713

714+
result <- executeQuery era cModeParams localNodeConnInfo qInMode
715+
716+
obtainLedgerEraClassConstraints sbe (writeLedgerState mOutFile) result
725717

726718
runQueryProtocolState
727719
:: AnyConsensusModeParams
@@ -735,27 +727,21 @@ runQueryProtocolState (AnyConsensusModeParams cModeParams)
735727
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
736728

737729
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
738-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
730+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
739731

740732
let cMode = consensusModeOnly cModeParams
741733
sbe <- getSbe $ cardanoEraStyle era
742734

743-
case toEraInMode era cMode of
744-
Just eInMode -> do
745-
let qInMode = QueryInEra eInMode
746-
. QueryInShelleyBasedEra sbe
747-
$ QueryProtocolState
748-
result <- executeQuery
749-
era
750-
cModeParams
751-
localNodeConnInfo
752-
qInMode
735+
eInMode <- pure (toEraInMode era cMode)
736+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE))
753737

754-
case cMode of
755-
CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result
756-
mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode
738+
let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryProtocolState
757739

758-
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
740+
result <- executeQuery era cModeParams localNodeConnInfo qInMode
741+
742+
case cMode of
743+
CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result
744+
mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode
759745

760746
-- | Query the current delegations and reward accounts, filtered by a given
761747
-- set of addresses, from a Shelley node via the local state query protocol.
@@ -773,25 +759,20 @@ runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams)
773759
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
774760

775761
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
776-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
762+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
777763

778764
let cMode = consensusModeOnly cModeParams
779765
sbe <- getSbe $ cardanoEraStyle era
780766

781-
case toEraInMode era cMode of
782-
Just eInMode -> do
783-
let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr
784-
query = QueryInEra eInMode
785-
. QueryInShelleyBasedEra sbe
786-
$ QueryStakeAddresses stakeAddr network
787-
788-
result <- executeQuery
789-
era
790-
cModeParams
791-
localNodeConnInfo
792-
query
793-
writeStakeAddressInfo mOutFile $ DelegationsAndRewards result
794-
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
767+
eInMode <- pure (toEraInMode era cMode)
768+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE))
769+
770+
let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr
771+
query = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeAddresses stakeAddr network
772+
773+
result <- executeQuery era cModeParams localNodeConnInfo query
774+
775+
writeStakeAddressInfo mOutFile $ DelegationsAndRewards result
795776

796777
-- -------------------------------------------------------------------------------------------------
797778

@@ -855,7 +836,7 @@ writeStakeSnapshots :: forall era ledgerera. ()
855836
-> ExceptT ShelleyQueryCmdError IO ()
856837
writeStakeSnapshots mOutFile qState = do
857838
StakeSnapshot snapshot <- pure (decodeStakeSnapshot qState)
858-
& onLeft (throwE . ShelleyQueryCmdStakeSnapshotDecodeError)
839+
& onLeft (left . ShelleyQueryCmdStakeSnapshotDecodeError)
859840

860841
-- Calculate the three pool and active stake values for the given pool
861842
liftIO . maybe LBS.putStrLn (LBS.writeFile . unOutputFile) mOutFile $ encodePretty snapshot
@@ -870,7 +851,7 @@ writePoolState :: forall era ledgerera. ()
870851
-> ExceptT ShelleyQueryCmdError IO ()
871852
writePoolState serialisedCurrentEpochState = do
872853
PoolState poolState <- pure (decodePoolState serialisedCurrentEpochState)
873-
& onLeft (throwE . ShelleyQueryCmdPoolStateDecodeError)
854+
& onLeft (left . ShelleyQueryCmdPoolStateDecodeError)
874855

875856
let hks = Set.toList $ Set.fromList $ Map.keys (_pParams poolState) <> Map.keys (_fPParams poolState) <> Map.keys (_retiring poolState)
876857

@@ -1061,24 +1042,19 @@ runQueryStakeDistribution (AnyConsensusModeParams cModeParams)
10611042
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
10621043

10631044
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
1064-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
1045+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
10651046

10661047
let cMode = consensusModeOnly cModeParams
10671048
sbe <- getSbe $ cardanoEraStyle era
10681049

1069-
case toEraInMode era cMode of
1070-
Just eInMode -> do
1071-
let query = QueryInEra eInMode
1072-
. QueryInShelleyBasedEra sbe
1073-
$ QueryStakeDistribution
1074-
result <- executeQuery
1075-
era
1076-
cModeParams
1077-
localNodeConnInfo
1078-
query
1079-
writeStakeDistribution mOutFile result
1080-
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
1050+
eInMode <- pure (toEraInMode era cMode)
1051+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE))
1052+
1053+
let query = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeDistribution
1054+
1055+
result <- executeQuery era cModeParams localNodeConnInfo query
10811056

1057+
writeStakeDistribution mOutFile result
10821058

10831059
writeStakeDistribution
10841060
:: Maybe OutputFile
@@ -1188,19 +1164,19 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
11881164
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
11891165

11901166
anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
1191-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
1167+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
11921168

11931169
sbe <- getSbe $ cardanoEraStyle era
11941170
let cMode = consensusModeOnly cModeParams
11951171

11961172
poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile)
1197-
& onLeft (throwE . ShelleyQueryCmdTextReadError)
1173+
& onLeft (left . ShelleyQueryCmdTextReadError)
11981174

11991175
vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp)
1200-
& onLeft (throwE . ShelleyQueryCmdTextEnvelopeReadError)
1176+
& onLeft (left . ShelleyQueryCmdTextEnvelopeReadError)
12011177

12021178
shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile)
1203-
& onLeft (throwE . ShelleyQueryCmdGenesisReadError)
1179+
& onLeft (left . ShelleyQueryCmdGenesisReadError)
12041180

12051181
case cMode of
12061182
CardanoMode -> do
@@ -1214,7 +1190,7 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
12141190
pparams <- executeQuery era cModeParams localNodeConnInfo pparamsQuery
12151191
ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQuery
12161192
eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
1217-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
1193+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
12181194

12191195
let eInfo = toEpochInfo eraHistory
12201196
let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch
@@ -1322,9 +1298,9 @@ calcEraInMode
13221298
:: CardanoEra era
13231299
-> ConsensusMode mode
13241300
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
1325-
calcEraInMode era mode=
1326-
hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))
1327-
$ toEraInMode era mode
1301+
calcEraInMode era mode =
1302+
pure (toEraInMode era mode)
1303+
& onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era)))
13281304

13291305
executeQuery
13301306
:: forall result era mode. CardanoEra era
@@ -1349,8 +1325,8 @@ queryResult
13491325
:: Either AcquiringFailure (Either EraMismatch a)
13501326
-> ExceptT ShelleyQueryCmdError IO a
13511327
queryResult eAcq = pure eAcq
1352-
& onLeft (throwE . ShelleyQueryCmdAcquireFailure)
1353-
& onLeft (throwE . ShelleyQueryCmdLocalStateQueryError . EraMismatchError)
1328+
& onLeft (left . ShelleyQueryCmdAcquireFailure)
1329+
& onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError)
13541330

13551331
toEpochInfo :: EraHistory CardanoMode -> EpochInfo (Either Text)
13561332
toEpochInfo (EraHistory _ interpreter) =

0 commit comments

Comments
 (0)