From 4fff545b7cb3c3fe64766e7e35883074de61e724 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Wed, 17 Jan 2024 16:06:36 +0100 Subject: [PATCH] Revert #569: Back to cardano-api JSON for protocol parameters --- .../src/Cardano/CLI/EraBased/Run/Query.hs | 38 ++++++++++++++----- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index e5edf4699a..14675dc3a0 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -56,6 +56,7 @@ import Cardano.CLI.Types.Key import qualified Cardano.CLI.Types.Output as O import Cardano.Crypto.Hash (hashToBytesAsHex) import qualified Cardano.Crypto.Hash.Blake2b as Blake2b +import Cardano.Ledger.Alonzo.Core (EraPParams (ppProtocolVersionL)) import qualified Cardano.Ledger.BaseTypes as L import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Credential as L @@ -84,6 +85,7 @@ import Control.Monad.Trans.Except.Extra import Data.Aeson as Aeson import qualified Data.Aeson as A import Data.Aeson.Encode.Pretty (encodePretty) +import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Coerce (coerce) @@ -184,23 +186,39 @@ runQueryProtocolParametersCmd AnyCardanoEra era <- firstExceptT QueryCmdAcquireFailure $ newExceptT $ determineEra localNodeConnInfo sbe <- forEraInEon @ShelleyBasedEra era (left QueryCmdByronEra) pure let qInMode = QueryInEra $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters - pp <- firstExceptT QueryCmdConvenienceError - . newExceptT $ executeQueryAnyMode localNodeConnInfo qInMode - writeProtocolParameters sbe mOutFile pp + pParams <- firstExceptT QueryCmdConvenienceError + . newExceptT $ executeQueryAnyMode localNodeConnInfo qInMode + writeProtocolParameters sbe mOutFile pParams where - -- TODO: Conway era - use ledger PParams JSON writeProtocolParameters :: ShelleyBasedEra era -> Maybe (File () Out) -> Ledger.PParams (ShelleyLedgerEra era) -> ExceptT QueryCmdError IO () writeProtocolParameters sbe mOutFile' pparams = - let apiPParamsJSON = (encodePretty $ fromLedgerPParams sbe pparams) - in case mOutFile' of - Nothing -> liftIO $ LBS.putStrLn apiPParamsJSON - Just (File fpath) -> - handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ - LBS.writeFile fpath apiPParamsJSON + firstExceptT QueryCmdWriteFileError . newExceptT $ + writeLazyByteStringOutput mOutFile' (encodePretty $ toJSONWithPParams sbe pparams) + where + -- TODO: (written 2024-01-16) Currently, the ToJSON implementation for + -- Conway protocol parameters from cardano-ledger misses the + -- 'protocolVersion' field. The commit that fixes this is already on + -- main, but not part of a released version of cardano-ledger that we + -- can depend on. It's this one: + -- + -- https://github.com/IntersectMBO/cardano-ledger/pull/3953/commits/df9ee19944099a75d75019b8b36e99b03db5b558 + -- + -- Until we have that in our dependencies, this workaround will ensure + -- we're printing the protocol version. It'll also do no harm after + -- that point, apart from heating the room a little. + toJSONWithPParams :: ShelleyBasedEra era -> Ledger.PParams (ShelleyLedgerEra era) -> Aeson.Value + toJSONWithPParams w pps = shelleyBasedEraConstraints w $ + case toJSON pps of + Aeson.Object almostAllPairs -> + caseShelleyToBabbageOrConwayEraOnwards + (const . Aeson.Object $ almostAllPairs) + (const . Aeson.Object . Aeson.insert "protocolVersion" (toJSON $ pps ^. ppProtocolVersionL) $ almostAllPairs) + sbe + _ -> error "Expected the protocol parameters to be a 'KeyMap'. This is part of a temporary hack. Alert the cardano-cli team of this." -- | Calculate the percentage sync rendered as text. percentage