From a7a9ba052fa786c5de27d2dbfec773b8daa337aa Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 20 Jan 2023 10:44:47 +1100 Subject: [PATCH] Using onLeft combinator in more places --- .../src/Cardano/CLI/Shelley/Run/Query.hs | 108 ++++++++---------- 1 file changed, 49 insertions(+), 59 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index cf6262c0a44..63697b927e1 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -211,8 +211,7 @@ runQueryProtocolParameters -> Maybe OutputFile -> ExceptT ShelleyQueryCmdError IO () runQueryProtocolParameters (AnyConsensusModeParams cModeParams) network mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do @@ -376,9 +375,8 @@ runQueryUTxO (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -405,16 +403,14 @@ runQueryKesPeriodInfo runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFile mOutFile = do - opCert <- firstExceptT ShelleyQueryCmdOpCertCounterReadError - . newExceptT $ readFileTextEnvelope AsOperationalCertificate nodeOpCertFile + opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile) + & onLeft (throwE . ShelleyQueryCmdOpCertCounterReadError) - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -436,7 +432,8 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil oCertEndKesPeriod = opCertEndKesPeriod gParams opCert opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod - eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery + eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let eInfo = toEpochInfo eraHistory @@ -616,14 +613,12 @@ runQueryPoolState -> [Hash StakePoolKey] -> ExceptT ShelleyQueryCmdError IO () runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) + let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -643,14 +638,13 @@ runQueryTxMempool -> Maybe OutputFile -> ExceptT ShelleyQueryCmdError IO () runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath localQuery <- case query of TxMempoolQueryTxExists tx -> do - anyE@(AnyCardanoEra era) <- firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) @@ -679,9 +673,8 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network allOrOnlyPool SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -704,13 +697,11 @@ runQueryLedgerState -> ExceptT ShelleyQueryCmdError IO () runQueryLedgerState (AnyConsensusModeParams cModeParams) network mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -736,13 +727,11 @@ runQueryProtocolState -> ExceptT ShelleyQueryCmdError IO () runQueryProtocolState (AnyConsensusModeParams cModeParams) network mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -775,13 +764,11 @@ runQueryStakeAddressInfo -> ExceptT ShelleyQueryCmdError IO () runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -1066,13 +1053,11 @@ runQueryStakeDistribution -> ExceptT ShelleyQueryCmdError IO () runQueryStakeDistribution (AnyConsensusModeParams cModeParams) network mOutFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -1194,24 +1179,24 @@ runQueryLeadershipSchedule runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network (GenesisFile genFile) coldVerKeyFile (SigningKeyFile vrfSkeyFp) whichSchedule mJsonOutputFile = do - SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr - $ newExceptT readEnvSocketPath + SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- - firstExceptT ShelleyQueryCmdAcquireFailure - . newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) sbe <- getSbe $ cardanoEraStyle era let cMode = consensusModeOnly cModeParams - poolid <- firstExceptT ShelleyQueryCmdTextReadError - . newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile + poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile) + & onLeft (throwE . ShelleyQueryCmdTextReadError) + + vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp) + & onLeft (throwE . ShelleyQueryCmdTextEnvelopeReadError) + + shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile) + & onLeft (throwE . ShelleyQueryCmdGenesisReadError) - vrkSkey <- firstExceptT ShelleyQueryCmdTextEnvelopeReadError . newExceptT - $ readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp - shelleyGenesis <- firstExceptT ShelleyQueryCmdGenesisReadError $ - newExceptT $ readAndDecodeShelleyGenesis genFile case cMode of CardanoMode -> do eInMode <- toEraInMode era cMode @@ -1223,15 +1208,20 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network pparams <- executeQuery era cModeParams localNodeConnInfo pparamsQuery ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQuery - eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery - let eInfo = toEpochInfo eraHistory + eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery) + & onLeft (throwE . ShelleyQueryCmdAcquireFailure) + let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch + curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery + let eInfo = toEpochInfo eraHistory + schedule <- case whichSchedule of CurrentEpoch -> do serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo $ QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryPoolDistribution (Just (Set.singleton poolid))) + firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ eligibleLeaderSlotsConstaints sbe $ currentEpochEligibleLeadershipSlots