From e6871b2cfb89e8f59caaf267e76fce0631cfb3f1 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 10:30:54 +1000 Subject: [PATCH 01/19] Query over single connection in runQueryUTxO --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 45 +++++++++++-------- 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 90103111b9..5595cfd1a6 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -402,28 +402,33 @@ runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) qfilter network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + InAnyShelleyBasedEra sbe utxo <- lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + eInMode <- pure (toEraInMode era cMode) + & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryUtxo eInMode sbe qfilter) + utxo <- lift (queryUtxo eInMode sbe qfilter) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + pure $ inAnyShelleyBasedEra sbe utxo + ) & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft left - writeFilteredUTxOs sbe mOutFile result + writeFilteredUTxOs sbe mOutFile utxo runQueryKesPeriodInfo :: SocketPath @@ -1465,15 +1470,19 @@ runQueryLeadershipSchedule -- Helpers -calcEraInMode - :: CardanoEra era +calcEraInMode :: () + => Monad m + => CardanoEra era -> ConsensusMode mode - -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode) + -> ExceptT ShelleyQueryCmdError m (EraInMode era mode) calcEraInMode era mode = pure (toEraInMode era mode) & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))) -requireNotByronEraInByronMode :: EraInMode era mode -> ExceptT ShelleyQueryCmdError IO () +requireNotByronEraInByronMode :: () + => Monad m + => EraInMode era mode + -> ExceptT ShelleyQueryCmdError m () requireNotByronEraInByronMode = \case ByronEraInByronMode -> left ShelleyQueryCmdByronEra _ -> pure () From fc53e48553948a97cd9433ca141418c813e8a124 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:44:11 +1000 Subject: [PATCH 02/19] Query over single connection in runQueryUTxO --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 5595cfd1a6..8d3bbe71a4 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -402,7 +402,7 @@ runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) qfilter network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - InAnyShelleyBasedEra sbe utxo <- lift + join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) @@ -423,13 +423,12 @@ runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - pure $ inAnyShelleyBasedEra sbe utxo + pure $ do + writeFilteredUTxOs sbe mOutFile utxo ) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left - writeFilteredUTxOs sbe mOutFile utxo - runQueryKesPeriodInfo :: SocketPath -> AnyConsensusModeParams From bc5fafdd95dca52eec36f1a503546e60867e5562 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:32:30 +1000 Subject: [PATCH 03/19] Query over single connection in runQueryKesPeriodInfo --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 8d3bbe71a4..d20fb25497 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -442,17 +442,17 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) - case cMode of CardanoMode -> do + anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) + eInMode <- toEraInMode era cMode & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) @@ -502,6 +502,7 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) $ LBS.writeFile oFp kesPeriodInfoJSON) mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + where currentKesPeriod :: ChainTip -> GenesisParameters -> CurrentKesPeriod currentKesPeriod ChainTipAtGenesis _ = CurrentKesPeriod 0 From fcb38588b637a5ad3a21a9d67e785653c7380952 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:35:26 +1000 Subject: [PATCH 04/19] Query over single connection in runQueryKesPeriodInfo --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index d20fb25497..cc481765c0 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -446,6 +446,14 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no case cMode of CardanoMode -> do + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + pure $ do + pure () + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left + anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) From cbdf2bb2bf90a029958b6f3d7ccdfec556a21398 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:36:52 +1000 Subject: [PATCH 05/19] Query over single connection in runQueryKesPeriodInfo --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 89 +++++++++---------- 1 file changed, 44 insertions(+), 45 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index cc481765c0..068f94622f 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -449,66 +449,65 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do pure $ do - pure () - ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft left + anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + -- We check that the KES period specified in the operational certificate is correct + -- based on the KES period defined in the genesis parameters and the current slot number + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - -- We check that the KES period specified in the operational certificate is correct - -- based on the KES period defined in the genesis parameters and the current slot number - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + requireNotByronEraInByronMode eraInMode - requireNotByronEraInByronMode eraInMode + gParams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryGenesisParameters eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - gParams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryGenesisParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + chainTip <- liftIO $ getLocalChainTip localNodeConnInfo - chainTip <- liftIO $ getLocalChainTip localNodeConnInfo + let curKesPeriod = currentKesPeriod chainTip gParams + oCertStartKesPeriod = opCertStartingKesPeriod opCert + oCertEndKesPeriod = opCertEndKesPeriod gParams opCert + opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod - let curKesPeriod = currentKesPeriod chainTip gParams - oCertStartKesPeriod = opCertStartingKesPeriod opCert - oCertEndKesPeriod = opCertEndKesPeriod gParams opCert - opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod + eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + let eInfo = toTentativeEpochInfo eraHistory - let eInfo = toTentativeEpochInfo eraHistory + -- We get the operational certificate counter from the protocol state and check that + -- it is equivalent to what we have on disk. + ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - -- We get the operational certificate counter from the protocol state and check that - -- it is equivalent to what we have on disk. - ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + (onDiskC, stateC) <- shelleyBasedEraConstraints sbe $ opCertOnDiskAndStateCounters ptclState opCert + let counterInformation = opCertNodeAndOnDiskCounters onDiskC stateC - (onDiskC, stateC) <- shelleyBasedEraConstraints sbe $ opCertOnDiskAndStateCounters ptclState opCert - let counterInformation = opCertNodeAndOnDiskCounters onDiskC stateC + -- Always render diagnostic information + liftIO . putStrLn $ renderOpCertIntervalInformation (unFile nodeOpCertFile) opCertIntervalInformation + liftIO . putStrLn $ renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFile) counterInformation - -- Always render diagnostic information - liftIO . putStrLn $ renderOpCertIntervalInformation (unFile nodeOpCertFile) opCertIntervalInformation - liftIO . putStrLn $ renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFile) counterInformation + let qKesInfoOutput = createQueryKesPeriodInfoOutput opCertIntervalInformation counterInformation eInfo gParams + kesPeriodInfoJSON = encodePretty qKesInfoOutput - let qKesInfoOutput = createQueryKesPeriodInfoOutput opCertIntervalInformation counterInformation eInfo gParams - kesPeriodInfoJSON = encodePretty qKesInfoOutput + liftIO $ LBS.putStrLn kesPeriodInfoJSON + forM_ mOutFile (\(File oFp) -> + handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) + $ LBS.writeFile oFp kesPeriodInfoJSON) + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left - liftIO $ LBS.putStrLn kesPeriodInfoJSON - forM_ mOutFile (\(File oFp) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) - $ LBS.writeFile oFp kesPeriodInfoJSON) mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode where From eb6666cbb468585c2fffa499ee640814e40ad481 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:42:18 +1000 Subject: [PATCH 06/19] Query over single connection in runQueryKesPeriodInfo --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 55 +++++++++---------- 1 file changed, 26 insertions(+), 29 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 068f94622f..35374c9631 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -448,28 +448,37 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no CardanoMode -> do join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - pure $ do - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) + + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + -- We check that the KES period specified in the operational certificate is correct + -- based on the KES period defined in the genesis parameters and the current slot number + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + requireNotByronEraInByronMode eraInMode - -- We check that the KES period specified in the operational certificate is correct - -- based on the KES period defined in the genesis parameters and the current slot number - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + gParams <- lift (queryGenesisParameters eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + eraHistory <- lift queryEraHistory + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - requireNotByronEraInByronMode eraInMode + let eInfo = toTentativeEpochInfo eraHistory - gParams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryGenesisParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + -- We get the operational certificate counter from the protocol state and check that + -- it is equivalent to what we have on disk. + ptclState <- lift (queryProtocolState eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + pure $ do chainTip <- liftIO $ getLocalChainTip localNodeConnInfo let curKesPeriod = currentKesPeriod chainTip gParams @@ -477,20 +486,8 @@ runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network no oCertEndKesPeriod = opCertEndKesPeriod gParams opCert opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod - eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - let eInfo = toTentativeEpochInfo eraHistory - - -- We get the operational certificate counter from the protocol state and check that - -- it is equivalent to what we have on disk. - ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - (onDiskC, stateC) <- shelleyBasedEraConstraints sbe $ opCertOnDiskAndStateCounters ptclState opCert + let counterInformation = opCertNodeAndOnDiskCounters onDiskC stateC -- Always render diagnostic information From 04fac28087f5a8b2070599ecc154baea95b89b34 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 11:56:03 +1000 Subject: [PATCH 07/19] Query over single connection in runQueryPoolState --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 34 +++++++++++-------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 35374c9631..cb1750bc09 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -719,28 +719,32 @@ runQueryPoolState runQueryPoolState socketPath (AnyConsensusModeParams cModeParams) network poolIds = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolState eInMode sbe $ Just $ Set.fromList poolIds) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + result <- lift (queryPoolState eInMode sbe $ Just $ Set.fromList poolIds) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - shelleyBasedEraConstraints sbe $ writePoolState result + pure $ do + shelleyBasedEraConstraints sbe writePoolState result + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left -- | Query the local mempool state runQueryTxMempool From db2e8de562606c468a50d8c8534bb2eacc3dc157 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:08:59 +1000 Subject: [PATCH 08/19] Query over single connection in runQueryLedgerState --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 75 ++++++++++--------- 1 file changed, 41 insertions(+), 34 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index cb1750bc09..a82bc83f82 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -799,33 +799,36 @@ runQueryStakeSnapshot runQueryStakeSnapshot socketPath (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - let cMode = consensusModeOnly cModeParams + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + let cMode = consensusModeOnly cModeParams - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - let poolFilter = case allOrOnlyPoolIds of - All -> Nothing - Only poolIds -> Just $ Set.fromList poolIds + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - eraInMode2 <- calcEraInMode era $ consensusModeOnly cModeParams + let poolFilter = case allOrOnlyPoolIds of + All -> Nothing + Only poolIds -> Just $ Set.fromList poolIds - requireNotByronEraInByronMode eraInMode2 + eraInMode2 <- calcEraInMode era $ consensusModeOnly cModeParams - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryStakeSnapshot eInMode sbe poolFilter) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + requireNotByronEraInByronMode eraInMode2 - shelleyBasedEraConstraints sbe $ writeStakeSnapshots mOutFile result + result <- lift (queryStakeSnapshot eInMode sbe poolFilter) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + pure $ do + shelleyBasedEraConstraints sbe (writeStakeSnapshots mOutFile) result + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left runQueryLedgerState :: SocketPath @@ -836,28 +839,32 @@ runQueryLedgerState runQueryLedgerState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + eInMode <- pure (toEraInMode era cMode) + & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryDebugLedgerState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + result <- lift (queryDebugLedgerState eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - shelleyBasedEraConstraints sbe $ writeLedgerState mOutFile result + pure $ do + shelleyBasedEraConstraints sbe (writeLedgerState mOutFile) result + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left runQueryProtocolState :: SocketPath From 4c391ca899cb6a049e3592bfaf6655ca3d7b3ab3 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:12:25 +1000 Subject: [PATCH 09/19] Query over single connection in runQueryProtocolState --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 38 ++++++++++--------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index a82bc83f82..a85e91e338 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -875,30 +875,34 @@ runQueryProtocolState runQueryProtocolState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + eInMode <- pure (toEraInMode era cMode) + & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + result <- lift (queryProtocolState eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - case cMode of - CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + pure $ do + case cMode of + CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result + mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left -- | Query the current delegations and reward accounts, filtered by a given -- set of addresses, from a Shelley node via the local state query protocol. From 4dcde240344e9b30bf822b62344cccde19182bd2 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:15:21 +1000 Subject: [PATCH 10/19] Query over single connection in runQueryStakeAddressInfo --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 36 ++++++++++--------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index a85e91e338..14b3a008fb 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -917,30 +917,34 @@ runQueryStakeAddressInfo runQueryStakeAddressInfo socketPath (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + eInMode <- pure (toEraInMode era cMode) + & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr + let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryStakeAddresses eInMode sbe stakeAddr network) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + result <- lift (queryStakeAddresses eInMode sbe stakeAddr network) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - writeStakeAddressInfo mOutFile $ DelegationsAndRewards result + pure $ do + writeStakeAddressInfo mOutFile $ DelegationsAndRewards result + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left -- ------------------------------------------------------------------------------------------------- From 5e6d8bbcae7a27a900dd1d38aa4b2879408c96c4 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:17:37 +1000 Subject: [PATCH 11/19] Query over single connection in runQueryStakePools --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 14b3a008fb..f2963eb9eb 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1165,8 +1165,8 @@ runQueryStakePools runQueryStakePools socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - poolIds <- - ( lift $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @ShelleyQueryCmdError $ do + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @ShelleyQueryCmdError $ do anyE@(AnyCardanoEra era) <- case consensusModeOnly cModeParams of ByronMode -> return $ AnyCardanoEra ByronEra ShelleyMode -> return $ AnyCardanoEra ShelleyEra @@ -1180,14 +1180,15 @@ runQueryStakePools socketPath (AnyConsensusModeParams cModeParams) network mOutF sbe <- requireShelleyBasedEra era & onNothing (left ShelleyQueryCmdByronEra) - lift (queryStakePools eInMode sbe) + poolIds <- lift (queryStakePools eInMode sbe) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & onLeft (left . ShelleyQueryCmdEraMismatch) + + pure $ do + writeStakePools mOutFile poolIds ) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left - writeStakePools mOutFile poolIds - writeStakePools :: Maybe (File () Out) -> Set PoolId From 5d800cc82d933be23cb27e435da31f59a51b581d Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:21:08 +1000 Subject: [PATCH 12/19] Query over single connection in runQueryStakeDistribution --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 34 +++++++++++-------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index f2963eb9eb..f6006c9020 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1210,28 +1210,32 @@ runQueryStakeDistribution runQueryStakeDistribution socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams + let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + eInMode <- pure (toEraInMode era cMode) + & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - result <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryStakeDistribution eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + result <- lift (queryStakeDistribution eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - writeStakeDistribution mOutFile result + pure $ do + writeStakeDistribution mOutFile result + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left writeStakeDistribution :: Maybe (File () Out) From de7e4459e2e5fa2681faecb0c7a9e279ce4df8bf Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:35:13 +1000 Subject: [PATCH 13/19] Query over single connection in runQueryLeadershipSchedule --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 163 +++++++++--------- 1 file changed, 84 insertions(+), 79 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index f6006c9020..27156e4e74 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1344,15 +1344,6 @@ runQueryLeadershipSchedule whichSchedule mJsonOutputFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) - - let cMode = consensusModeOnly cModeParams - poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile) & onLeft (left . ShelleyQueryCmdTextReadError) @@ -1362,79 +1353,93 @@ runQueryLeadershipSchedule shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile) & onLeft (left . ShelleyQueryCmdGenesisReadError) - case cMode of - CardanoMode -> do - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - - requireNotByronEraInByronMode eraInMode - - pparams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - - ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + join $ lift + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do + anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + sbe <- requireShelleyBasedEra era + & onNothing (left ShelleyQueryCmdByronEra) - let eInfo = toEpochInfo eraHistory + let cMode = consensusModeOnly cModeParams - curentEpoch <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryEpoch eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - - bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ - bundleProtocolParams era pparams - - schedule <- case whichSchedule of - CurrentEpoch -> do - serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither - $ shelleyBasedEraConstraints sbe - $ currentEpochEligibleLeadershipSlots - sbe - shelleyGenesis - eInfo - bpp - ptclState - poolid - vrkSkey - serCurrentEpochState - curentEpoch - - NextEpoch -> do - tip <- liftIO $ getLocalChainTip localNodeConnInfo - - serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryCurrentEpochState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither - $ shelleyBasedEraConstraints sbe - $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis - serCurrentEpochState ptclState poolid vrkSkey bpp - eInfo (tip, curentEpoch) - - case mJsonOutputFile of - Nothing -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - Just (File jsonOutputFile) -> - liftIO $ LBS.writeFile jsonOutputFile $ - printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + pure $ do + case cMode of + CardanoMode -> do + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + + requireNotByronEraInByronMode eraInMode + + pparams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolParameters eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + + let eInfo = toEpochInfo eraHistory + + curentEpoch <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryEpoch eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ + bundleProtocolParams era pparams + + schedule <- case whichSchedule of + CurrentEpoch -> do + serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + $ shelleyBasedEraConstraints sbe + $ currentEpochEligibleLeadershipSlots + sbe + shelleyGenesis + eInfo + bpp + ptclState + poolid + vrkSkey + serCurrentEpochState + curentEpoch + + NextEpoch -> do + tip <- liftIO $ getLocalChainTip localNodeConnInfo + + serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryCurrentEpochState eInMode sbe) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + + firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + $ shelleyBasedEraConstraints sbe + $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis + serCurrentEpochState ptclState poolid vrkSkey bpp + eInfo (tip, curentEpoch) + + case mJsonOutputFile of + Nothing -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) + Just (File jsonOutputFile) -> + liftIO $ LBS.writeFile jsonOutputFile $ + printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) + mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + ) + & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft left where printLeadershipScheduleAsText :: Set SlotNo From 50329ac3ee2472df7810e0c084ac3bf15b0a180a Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:36:43 +1000 Subject: [PATCH 14/19] Query over single connection in runQueryLeadershipSchedule --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 27156e4e74..8e9761c463 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1363,9 +1363,9 @@ runQueryLeadershipSchedule let cMode = consensusModeOnly cModeParams - pure $ do - case cMode of - CardanoMode -> do + case cMode of + CardanoMode -> do + pure $ do eInMode <- toEraInMode era cMode & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) @@ -1436,7 +1436,9 @@ runQueryLeadershipSchedule Just (File jsonOutputFile) -> liftIO $ LBS.writeFile jsonOutputFile $ printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + mode -> + pure $ do + left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode ) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left From f6cb6317135e154bded287bd98afe922920b3a7a Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:44:27 +1000 Subject: [PATCH 15/19] Query over single connection in runQueryLeadershipSchedule --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 160 +++++++++--------- 1 file changed, 78 insertions(+), 82 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 8e9761c463..fc0f0dcc4c 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1365,38 +1365,34 @@ runQueryLeadershipSchedule case cMode of CardanoMode -> do - pure $ do - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eraInMode - pparams <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + pparams <- lift (queryProtocolParameters eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - ptclState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + ptclState <- lift (queryProtocolState eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - eraHistory <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing queryEraHistory) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + eraHistory <- lift queryEraHistory + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - let eInfo = toEpochInfo eraHistory + let eInfo = toEpochInfo eraHistory - curentEpoch <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryEpoch eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + curentEpoch <- lift (queryEpoch eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ - bundleProtocolParams era pparams + bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ + bundleProtocolParams era pparams + pure $ do schedule <- case whichSchedule of CurrentEpoch -> do serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) @@ -1418,13 +1414,13 @@ runQueryLeadershipSchedule curentEpoch NextEpoch -> do - tip <- liftIO $ getLocalChainTip localNodeConnInfo - serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryCurrentEpochState eInMode sbe) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + tip <- liftIO $ getLocalChainTip localNodeConnInfo + firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis @@ -1442,65 +1438,65 @@ runQueryLeadershipSchedule ) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left - where - printLeadershipScheduleAsText - :: Set SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> IO () - printLeadershipScheduleAsText leadershipSlots eInfo sStart = do - Text.putStrLn title - putStrLn $ replicate (Text.length title + 2) '-' - sequence_ - [ putStrLn $ showLeadershipSlot slot eInfo sStart - | slot <- Set.toList leadershipSlots ] - where - title :: Text - title = - " SlotNo UTC Time " - - showLeadershipSlot - :: SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> String - showLeadershipSlot lSlot@(SlotNo sn) eInfo' sStart' = - case epochInfoSlotToUTCTime eInfo' sStart' lSlot of - Right slotTime -> - concat - [ " " - , show sn - , " " - , show slotTime - ] - Left err -> - concat - [ " " - , show sn - , " " - , Text.unpack err - ] - printLeadershipScheduleAsJson - :: Set SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> LBS.ByteString - printLeadershipScheduleAsJson leadershipSlots eInfo sStart = - encodePretty $ showLeadershipSlot <$> List.sort (Set.toList leadershipSlots) - where - showLeadershipSlot :: SlotNo -> Aeson.Value - showLeadershipSlot lSlot@(SlotNo sn) = - case epochInfoSlotToUTCTime eInfo sStart lSlot of - Right slotTime -> - Aeson.object - [ "slotNumber" Aeson..= sn - , "slotTime" Aeson..= slotTime + where + printLeadershipScheduleAsText + :: Set SlotNo + -> EpochInfo (Either Text) + -> SystemStart + -> IO () + printLeadershipScheduleAsText leadershipSlots eInfo sStart = do + Text.putStrLn title + putStrLn $ replicate (Text.length title + 2) '-' + sequence_ + [ putStrLn $ showLeadershipSlot slot eInfo sStart + | slot <- Set.toList leadershipSlots ] + where + title :: Text + title = + " SlotNo UTC Time " + + showLeadershipSlot + :: SlotNo + -> EpochInfo (Either Text) + -> SystemStart + -> String + showLeadershipSlot lSlot@(SlotNo sn) eInfo' sStart' = + case epochInfoSlotToUTCTime eInfo' sStart' lSlot of + Right slotTime -> + concat + [ " " + , show sn + , " " + , show slotTime ] - Left err -> - Aeson.object - [ "slotNumber" Aeson..= sn - , "error" Aeson..= Text.unpack err + Left err -> + concat + [ " " + , show sn + , " " + , Text.unpack err ] + printLeadershipScheduleAsJson + :: Set SlotNo + -> EpochInfo (Either Text) + -> SystemStart + -> LBS.ByteString + printLeadershipScheduleAsJson leadershipSlots eInfo sStart = + encodePretty $ showLeadershipSlot <$> List.sort (Set.toList leadershipSlots) + where + showLeadershipSlot :: SlotNo -> Aeson.Value + showLeadershipSlot lSlot@(SlotNo sn) = + case epochInfoSlotToUTCTime eInfo sStart lSlot of + Right slotTime -> + Aeson.object + [ "slotNumber" Aeson..= sn + , "slotTime" Aeson..= slotTime + ] + Left err -> + Aeson.object + [ "slotNumber" Aeson..= sn + , "error" Aeson..= Text.unpack err + ] -- Helpers From f704350db5a80a3c9853685f80c37e29e04fb4af Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:47:03 +1000 Subject: [PATCH 16/19] Query over single connection in runQueryLeadershipSchedule --- cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index fc0f0dcc4c..91f496d3e5 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1426,12 +1426,7 @@ runQueryLeadershipSchedule $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis serCurrentEpochState ptclState poolid vrkSkey bpp eInfo (tip, curentEpoch) - - case mJsonOutputFile of - Nothing -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - Just (File jsonOutputFile) -> - liftIO $ LBS.writeFile jsonOutputFile $ - printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) + writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule mode -> pure $ do left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode @@ -1439,6 +1434,13 @@ runQueryLeadershipSchedule & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left where + writeSchedule mOutFile eInfo shelleyGenesis schedule = + case mOutFile of + Nothing -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) + Just (File jsonOutputFile) -> + liftIO $ LBS.writeFile jsonOutputFile $ + printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) + printLeadershipScheduleAsText :: Set SlotNo -> EpochInfo (Either Text) From 7c0fa56275fbd096462077d6ad9081f2b5f9af83 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:48:59 +1000 Subject: [PATCH 17/19] Query over single connection in runQueryLeadershipSchedule --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 91f496d3e5..e426af271c 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1392,15 +1392,15 @@ runQueryLeadershipSchedule bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ bundleProtocolParams era pparams - pure $ do - schedule <- case whichSchedule of - CurrentEpoch -> do + case whichSchedule of + CurrentEpoch -> do + pure $ do serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ currentEpochEligibleLeadershipSlots sbe @@ -1413,7 +1413,10 @@ runQueryLeadershipSchedule serCurrentEpochState curentEpoch - NextEpoch -> do + writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule + + NextEpoch -> do + pure $ do serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryCurrentEpochState eInMode sbe) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) @@ -1421,12 +1424,13 @@ runQueryLeadershipSchedule tip <- liftIO $ getLocalChainTip localNodeConnInfo - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis serCurrentEpochState ptclState poolid vrkSkey bpp eInfo (tip, curentEpoch) - writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule + + writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule mode -> pure $ do left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode From f622f471091ba8f566606984ba080191efee6f89 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:50:39 +1000 Subject: [PATCH 18/19] Query over single connection in runQueryLeadershipSchedule --- .../src/Cardano/CLI/Run/Legacy/Query.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index e426af271c..6759518c74 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -1394,12 +1394,11 @@ runQueryLeadershipSchedule case whichSchedule of CurrentEpoch -> do - pure $ do - serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + serCurrentEpochState <- lift (queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + pure $ do schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ currentEpochEligibleLeadershipSlots @@ -1416,12 +1415,11 @@ runQueryLeadershipSchedule writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule NextEpoch -> do - pure $ do - serCurrentEpochState <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryCurrentEpochState eInMode sbe) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + serCurrentEpochState <- lift (queryCurrentEpochState eInMode sbe) + & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + pure $ do tip <- liftIO $ getLocalChainTip localNodeConnInfo schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither From e777849f399674f8d0f645d458309072902294b6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 16 Jun 2023 13:52:37 +1000 Subject: [PATCH 19/19] Query over single connection in runTxBuildCmd --- cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs index f1eb05fb9a..161597676c 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs @@ -351,10 +351,6 @@ runTxBuildCmd , localNodeSocketPath = socketPath } - AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . QceUnsupportedNtcVersion) - inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra txins certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra certs @@ -435,6 +431,10 @@ runTxBuildCmd case consensusMode of CardanoMode -> do + AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) + & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . ShelleyTxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + (nodeEraUTxO, _, eraHistory, systemStart, _, _) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (queryStateForBalancedTx nodeEra allTxInputs [])) & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure)