Guard queries with eras

cardano-cli/app/cardano-cli.hs

@@ -33,4 +33,4 @@ main = toplevelExceptionHandler $ do
 #endif
   co <- Opt.customExecParser pref (opts envCli)
 
-  orDie (prettyToText . renderClientCommandError) $ runClientCommand co
+  orDie (docToText . renderClientCommandError) $ runClientCommand co

cardano-cli/src/Cardano/CLI/Byron/Parsers.hs

@@ -266,7 +266,7 @@ parseTxIdAtto = (<?> "Transaction ID (hexadecimal)") $ do
   bstr <- Atto.takeWhile1 Char.isHexDigit
   case deserialiseFromRawBytesHex AsTxId bstr of
     Right addr -> return addr
-    Left e -> fail $ prettyToString $ "Incorrect transaction id format: " <> prettyError e
+    Left e -> fail $ docToString $ "Incorrect transaction id format: " <> prettyError e
 
 parseTxIxAtto :: Atto.Parser TxIx
 parseTxIxAtto = toEnum <$> Atto.decimal

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -178,7 +178,7 @@ parseTxId = do
   str' <- some Parsec.hexDigit <?> "transaction id (hexadecimal)"
   case deserialiseFromRawBytesHex AsTxId (BSC.pack str') of
     Right addr -> return addr
-    Left e -> fail $ prettyToString $ "Incorrect transaction id format: " <> prettyError e
+    Left e -> fail $ docToString $ "Incorrect transaction id format: " <> prettyError e
 
 parseTxIx :: Parsec.Parser TxIx
 parseTxIx = TxIx . fromIntegral <$> decimal
@@ -260,7 +260,7 @@ readVerificationKey asType =
       :: String
       -> Either String (VerificationKey keyrole)
     deserialiseFromBech32OrHex str' =
-      first (prettyToString . renderInputDecodeError) $
+      first (docToString . renderInputDecodeError) $
         deserialiseInput (AsVerificationKey asType) keyFormats (BSC.pack str')
 
 -- | The first argument is the optional prefix.
@@ -498,14 +498,14 @@ pHexHash
   :: SerialiseAsRawBytes (Hash a) => AsType a -> ReadM (Hash a)
 pHexHash a =
   Opt.eitherReader $
-    first (prettyToString . prettyError)
+    first (docToString . prettyError)
       . deserialiseFromRawBytesHex (AsHash a)
       . BSC.pack
 
 pBech32KeyHash :: SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
 pBech32KeyHash a =
   Opt.eitherReader $
-    first (prettyToString . prettyError)
+    first (docToString . prettyError)
     . deserialiseFromBech32 (AsHash a)
     . Text.pack
 
@@ -522,7 +522,7 @@ pGenesisDelegateVerificationKey =
       -> Either String (VerificationKey GenesisDelegateKey)
     deserialiseFromHex =
       first
-        (\e -> prettyToString $ "Invalid genesis delegate verification key: " <> prettyError e)
+        (\e -> docToString $ "Invalid genesis delegate verification key: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisDelegateKey)
         . BSC.pack
 
@@ -619,7 +619,7 @@ pAddCommitteeColdVerificationKeyHash =
   where
     deserialiseFromHex :: String -> Either String (Hash CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey)
         . BSC.pack
 
@@ -640,7 +640,7 @@ pAddCommitteeColdVerificationKey =
   where
     deserialiseFromHex :: String -> Either String (VerificationKey CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeColdKey)
         . BSC.pack
 
@@ -671,7 +671,7 @@ pRemoveCommitteeColdVerificationKeyHash =
   where
     deserialiseFromHex :: String -> Either String (Hash CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey)
         . BSC.pack
 
@@ -692,7 +692,7 @@ pRemoveCommitteeColdVerificationKey =
   where
     deserialiseFromHex :: String -> Either String (VerificationKey CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeColdKey)
         . BSC.pack
 
@@ -731,7 +731,7 @@ pCommitteeColdVerificationKey =
   where
     deserialiseFromHex :: String -> Either String (VerificationKey CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Constitutional Committee cold key: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeColdKey)
         . BSC.pack
 
@@ -745,7 +745,7 @@ pCommitteeColdVerificationKeyHash =
   where
     deserialiseFromHex :: String -> Either String (Hash CommitteeColdKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Consitutional Committee cold key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey)
         . BSC.pack
 
@@ -809,7 +809,7 @@ pCommitteeHotVerificationKey =
 
 deserialiseHotCCKeyFromHex :: String -> Either String (VerificationKey CommitteeHotKey)
 deserialiseHotCCKeyFromHex =
-  first (\e -> prettyToString $ "Invalid Constitutional Committee hot key: " <> prettyError e)
+  first (\e -> docToString $ "Invalid Constitutional Committee hot key: " <> prettyError e)
     . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeHotKey)
     . BSC.pack
 
@@ -842,7 +842,7 @@ pCommitteeHotKeyHash prefix =
   where
     deserialiseFromHex :: String -> Either String (Hash CommitteeHotKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid Consitutional Committee hot key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid Consitutional Committee hot key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsCommitteeHotKey)
         . BSC.pack
 
@@ -1162,7 +1162,7 @@ pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
         Left e -> fail $ "readerScriptData: " <> e
         Right sDataValue ->
           case scriptDataJsonToHashable ScriptDataJsonNoSchema sDataValue of
-            Left err -> fail $ prettyToString $ prettyError err
+            Left err -> fail $ docToString $ prettyError err
             Right sd -> return sd
 
 --------------------------------------------------------------------------------
@@ -1648,7 +1648,7 @@ pGenesisVerificationKeyHash =
   where
     deserialiseFromHex :: String -> Either String (Hash GenesisKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid genesis verification key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid genesis verification key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsGenesisKey)
         . BSC.pack
 
@@ -1662,7 +1662,7 @@ pGenesisVerificationKey =
   where
     deserialiseFromHex :: String -> Either String (VerificationKey GenesisKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid genesis verification key: " <> prettyError e)
+      first (\e -> docToString $ "Invalid genesis verification key: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisKey)
         . BSC.pack
 
@@ -1701,7 +1701,7 @@ pGenesisDelegateVerificationKeyHash =
     deserialiseFromHex =
       first
         (\e ->
-          prettyToString $ "Invalid genesis delegate verification key hash: " <> prettyError e)
+          docToString $ "Invalid genesis delegate verification key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsGenesisDelegateKey)
         . BSC.pack
 
@@ -1745,15 +1745,15 @@ pKesVerificationKey =
         Right res -> Right res
 
         -- The input was valid Bech32, but some other error occurred.
-        Left err@(Bech32UnexpectedPrefix _ _) -> Left (prettyToString $ prettyError err)
-        Left err@(Bech32DataPartToBytesError _) -> Left (prettyToString $ prettyError err)
-        Left err@(Bech32DeserialiseFromBytesError _) -> Left (prettyToString $ prettyError err)
-        Left err@(Bech32WrongPrefix _ _) -> Left (prettyToString $ prettyError err)
+        Left err@(Bech32UnexpectedPrefix _ _) -> Left (docToString $ prettyError err)
+        Left err@(Bech32DataPartToBytesError _) -> Left (docToString $ prettyError err)
+        Left err@(Bech32DeserialiseFromBytesError _) -> Left (docToString $ prettyError err)
+        Left err@(Bech32WrongPrefix _ _) -> Left (docToString $ prettyError err)
 
         -- The input was not valid Bech32. Attempt to deserialise it as hex.
         Left (Bech32DecodingError _) ->
           first
-            (\e -> prettyToString $ "Invalid stake pool verification key: " <> prettyError e) $
+            (\e -> docToString $ "Invalid stake pool verification key: " <> prettyError e) $
           deserialiseFromRawBytesHex asType (BSC.pack str)
 
 pKesVerificationKeyFile :: Parser (VerificationKeyFile In)
@@ -2318,7 +2318,7 @@ pVrfVerificationKeyHash =
   where
     deserialiseFromHex :: String -> Either String (Hash VrfKey)
     deserialiseFromHex =
-      first (\e -> prettyToString $ "Invalid VRF verification key hash: " <> prettyError e)
+      first (\e -> docToString $ "Invalid VRF verification key hash: " <> prettyError e)
         . deserialiseFromRawBytesHex (AsHash AsVrfKey)
         . BSC.pack
 
@@ -2535,7 +2535,7 @@ pStakePoolMetadataHash =
   where
     metadataHash :: String -> Either String (Hash StakePoolMetadata)
     metadataHash =
-      first (prettyToString . prettyError)
+      first (docToString . prettyError)
         . deserialiseFromRawBytesHex (AsHash AsStakePoolMetadata)
         . BSC.pack
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs

@@ -50,6 +50,7 @@ import           Cardano.CLI.EraBased.Run.Genesis (readAndDecodeShelleyGenesis)
 import           Cardano.CLI.Helpers
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
+import           Cardano.CLI.Types.Errors.NodeEraMismatchError
 import           Cardano.CLI.Types.Errors.QueryCmdError
 import           Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError
 import           Cardano.CLI.Types.Key
@@ -264,7 +265,7 @@ runQueryTipCmd
         }
 
   mLocalState <- hushM (first QueryCmdAcquireFailure eLocalState) $ \e ->
-    liftIO . LT.hPutStrLn IO.stderr $ prettyToLazyText $ "Warning: Local state unavailable: " <> renderQueryCmdError e
+    liftIO . LT.hPutStrLn IO.stderr $ docToLazyText $ "Warning: Local state unavailable: " <> renderQueryCmdError e
 
   chainTip <- pure (mLocalState >>= O.mChainTip)
     -- The chain tip is unavailable via local state query because we are connecting with an older
@@ -280,7 +281,7 @@ runQueryTipCmd
   localStateOutput <- forM mLocalState $ \localState -> do
     case slotToEpoch tipSlotNo (O.eraHistory localState) of
       Left e -> do
-        liftIO . LT.hPutStrLn IO.stderr $ prettyToLazyText $
+        liftIO . LT.hPutStrLn IO.stderr $ docToLazyText $
           "Warning: Epoch unavailable: " <> renderQueryCmdError (QueryCmdPastHorizon e)
         return $ O.QueryTipLocalStateOutput
           { O.localStateChainTip = chainTip
@@ -302,7 +303,7 @@ runQueryTipCmd
           return $ flip (percentage tolerance) nowSeconds tipTimeResult
 
         mSyncProgress <- hushM syncProgressResult $ \e -> do
-          liftIO . LT.hPutStrLn IO.stderr $ prettyToLazyText $ "Warning: Sync progress unavailable: " <> renderQueryCmdError e
+          liftIO . LT.hPutStrLn IO.stderr $ docToLazyText $ "Warning: Sync progress unavailable: " <> renderQueryCmdError e
 
         return $ O.QueryTipLocalStateOutput
           { O.localStateChainTip = chainTip
@@ -404,8 +405,8 @@ runQueryKesPeriodInfoCmd
           let counterInformation = opCertNodeAndOnDiskCounters onDiskC stateC
 
           -- Always render diagnostic information
-          liftIO . putStrLn $ prettyToString $ renderOpCertIntervalInformation (unFile nodeOpCertFp) opCertIntervalInformation
-          liftIO . putStrLn $ prettyToString $ renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFp) counterInformation
+          liftIO . putStrLn $ docToString $ renderOpCertIntervalInformation (unFile nodeOpCertFp) opCertIntervalInformation
+          liftIO . putStrLn $ docToString $ renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFp) counterInformation
 
           let qKesInfoOutput = createQueryKesPeriodInfoOutput opCertIntervalInformation counterInformation eInfo gParams
               kesPeriodInfoJSON = encodePretty qKesInfoOutput
@@ -631,7 +632,9 @@ runQueryPoolStateCmd
         sbe <- requireShelleyBasedEra era
           & onNothing (left QueryCmdByronEra)
 
-        result <- lift (queryPoolState sbe $ Just $ Set.fromList poolIds)
+        beo <- requireEon BabbageEra era
+
+        result <- lift (queryPoolState beo $ Just $ Set.fromList poolIds)
           & onLeft (left . QueryCmdUnsupportedNtcVersion)
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
@@ -711,7 +714,9 @@ runQueryStakeSnapshotCmd
               All -> Nothing
               Only poolIds -> Just $ Set.fromList poolIds
 
-        result <- lift (queryStakeSnapshot sbe poolFilter)
+        beo <- requireEon BabbageEra era
+
+        result <- lift (queryStakeSnapshot beo poolFilter)
           & onLeft (left . QueryCmdUnsupportedNtcVersion)
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
@@ -810,14 +815,17 @@ runQueryStakeAddressInfoCmd
           & onLeft (left . QueryCmdUnsupportedNtcVersion)
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
-        stakeDelegDeposits <- lift (queryStakeDelegDeposits sbe stakeAddr)
+        beo <- requireEon BabbageEra era
+
+        stakeDelegDeposits <- lift (queryStakeDelegDeposits beo stakeAddr)
           & onLeft (left . QueryCmdUnsupportedNtcVersion)
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
-        stakeVoteDelegatees <- monoidForEraInEonA era $ \(_ :: ConwayEraOnwards era) ->
-          lift (queryStakeVoteDelegatees sbe stakeAddr)
-            & onLeft (left . QueryCmdUnsupportedNtcVersion)
-            & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
+        ceo <- requireEon ConwayEra era
+
+        stakeVoteDelegatees <- lift (queryStakeVoteDelegatees ceo stakeAddr)
+          & onLeft (left . QueryCmdUnsupportedNtcVersion)
+          & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
         return $ do
           writeStakeAddressInfo
@@ -1221,7 +1229,9 @@ runQueryLeadershipScheduleCmd
 
         case whichSchedule of
           CurrentEpoch -> do
-            serCurrentEpochState <- lift (queryPoolDistribution sbe (Just (Set.singleton poolid)))
+            beo <- requireEon BabbageEra era
+
+            serCurrentEpochState <- lift (queryPoolDistribution beo (Just (Set.singleton poolid)))
               & onLeft (left . QueryCmdUnsupportedNtcVersion)
               & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
@@ -1338,9 +1348,7 @@ runQueryConstitution
       , Cmd.mOutFile
       } = conwayEraOnwardsConstraints eon $ do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-      sbe = conwayEraOnwardsToShelleyBasedEra eon
-
-  constitution <- runQuery localNodeConnInfo $ queryConstitution sbe
+  constitution <- runQuery localNodeConnInfo $ queryConstitution eon
   writeOutput mOutFile constitution
 
 runQueryGovState
@@ -1355,9 +1363,7 @@ runQueryGovState
       , Cmd.mOutFile
       } = conwayEraOnwardsConstraints eon $ do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-      sbe = conwayEraOnwardsToShelleyBasedEra eon
-
-  govState <- runQuery localNodeConnInfo $ queryGovState sbe
+  govState <- runQuery localNodeConnInfo $ queryGovState eon
   writeOutput mOutFile govState
 
 runQueryDRepState
@@ -1373,11 +1379,10 @@ runQueryDRepState
       , Cmd.mOutFile
       } = conwayEraOnwardsConstraints eon $ do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-      sbe = conwayEraOnwardsToShelleyBasedEra eon
 
   drepCreds <- Set.fromList <$> mapM (firstExceptT QueryCmdDRepKeyError . getDRepCredentialFromVerKeyHashOrFile) drepKeys
 
-  drepState <- runQuery localNodeConnInfo $ queryDRepState sbe drepCreds
+  drepState <- runQuery localNodeConnInfo $ queryDRepState eon drepCreds
   writeOutput mOutFile $
     second drepStateToJson <$> Map.assocs drepState
   where
@@ -1400,14 +1405,13 @@ runQueryDRepStakeDistribution
       , Cmd.mOutFile
       } = conwayEraOnwardsConstraints eon $ do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-      sbe = conwayEraOnwardsToShelleyBasedEra eon
 
   let drepFromVrfKey = fmap Ledger.DRepCredential
                      . firstExceptT QueryCmdDRepKeyError
                      . getDRepCredentialFromVerKeyHashOrFile
   dreps <- Set.fromList <$> mapM drepFromVrfKey drepKeys
 
-  drepStakeDistribution <- runQuery localNodeConnInfo $ queryDRepStakeDistribution sbe dreps
+  drepStakeDistribution <- runQuery localNodeConnInfo $ queryDRepStakeDistribution eon dreps
   writeOutput mOutFile $
     Map.assocs drepStakeDistribution
 
@@ -1426,7 +1430,6 @@ runQueryCommitteeMembersState
       , Cmd.memberStatuses = memberStatuses
       } = conwayEraOnwardsConstraints eon $ do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-      sbe = conwayEraOnwardsToShelleyBasedEra eon
 
   let coldKeysFromVerKeyHashOrFile =
         firstExceptT QueryCmdCommitteeColdKeyError . getCommitteeColdCredentialFromVerKeyHashOrFile
@@ -1437,7 +1440,7 @@ runQueryCommitteeMembersState
   hotKeys <- Set.fromList <$> mapM hotKeysFromVerKeyHashOrFile hotCredKeys
 
   committeeState <- runQuery localNodeConnInfo $
-    queryCommitteeMembersState sbe coldKeys hotKeys (Set.fromList memberStatuses)
+    queryCommitteeMembersState eon coldKeys hotKeys (Set.fromList memberStatuses)
   writeOutput mOutFile $ A.toJSON committeeState
 
 runQuery :: LocalNodeConnectInfo
@@ -1517,3 +1520,14 @@ utcTimeToSlotNo nodeSocketPath consensusModeParams networkId utcTime = do
     )
     & onLeft (left . QueryCmdAcquireFailure)
     & onLeft left
+
+
+requireEon :: forall eon era minEra m. (Eon eon, Monad m)
+           => CardanoEra minEra -- ^ minimal required era i.e. for 'ConwayEraOnwards' eon it's 'Conway'
+           -> CardanoEra era -- ^ node era
+           -> ExceptT QueryCmdError m (eon era)
+-- TODO: implement 'Bounded' for `Some eon` and remove 'minEra'
+requireEon minEra era =
+  hoistMaybe
+    (QueryCmdLocalStateQueryError $ mkEraMismatchError NodeEraMismatchError { nodeEra = era, era = minEra })
+    (forEraMaybeEon era)