Restore en-/decoding compatibility for GetCurrentPParams (#95)

IntersectMBO/ouroboros-network#4349
changed/fixed the encoding of `PParams`, which broke compatibility of
older clients with Node 8.0. This PR restores compatibility, by making
the en-/decoding version-dependent.

See the commit message for some implementation details. Also, note how
the golden files changed due to this PR:

 - Pre-Alonzo serialization did not change.
- Alonzo and Babbage changed, but only for `CardanoNodeToClientVersion
<= 10`; these are enabled by `NodeToClient <= 14`, which are the
currently released node-to-client versions.
- Note that no golden files changed for
`CardanoNodeToClientVersion{11,12}` (which are enabled by
`NodeToClientV_{15,16}`). `NodeToClientV_15` will be released in Node
8.1, and indeed, we want to use the new and fixed encoding when this
version is negotiated.

ouroboros-consensus-cardano/changelog.d/20230522_123103_alexander.esgen_pparams_encoding_compat.md

@@ -0,0 +1,4 @@
+### Breaking
+
+- The `GetCurrentPParams` query now uses the legacy en-/decoding for its result again when the `NodeToClientVersion` is `<15`, restoring compatibility with older clients.
+

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -110,6 +110,9 @@ library
     Ouroboros.Consensus.Shelley.Protocol.TPraos
     Ouroboros.Consensus.Shelley.ShelleyHFC
 
+  other-modules:
+    Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder
+
   build-depends:
     , base                          >=4.14  && <4.17
     , base-deriving-via

ouroboros-consensus-cardano/src/shelley-testlib/Test/Consensus/Shelley/Generators.hs

@@ -153,7 +153,7 @@ instance CanMock proto era => Arbitrary (SomeResult (ShelleyBlock proto era)) wh
     , SomeResult GetStakeDistribution <$> arbitrary
     , SomeResult DebugEpochState <$> arbitrary
     , (\(SomeResult q r) ->
-        SomeResult (GetCBOR q) (mkSerialised (encodeShelleyResult q) r)) <$>
+        SomeResult (GetCBOR q) (mkSerialised (encodeShelleyResult maxBound q) r)) <$>
       arbitrary
     , SomeResult <$> (GetFilteredDelegationsAndRewardAccounts <$> arbitrary) <*> arbitrary
     , SomeResult GetGenesisConfig . compactGenesis <$> arbitrary

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs

@@ -59,6 +59,7 @@ import           Ouroboros.Consensus.Protocol.Praos.Common
                      (PraosChainSelectView)
 import           Ouroboros.Consensus.Protocol.Signed (SignedHeader)
 import           Ouroboros.Consensus.Shelley.Eras
+import           Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder
 import           Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto,
                      ProtocolHeaderSupportsEnvelope (pHeaderPrevHash),
                      ProtocolHeaderSupportsProtocol (CannotForgeError),
@@ -96,6 +97,10 @@ class
     -- Hard-fork related constraints
   , HasPartialConsensusConfig proto
   , DecCBOR (SL.PState era)
+
+    -- Backwards compatibility
+  , Plain.FromCBOR (LegacyPParams era)
+  , Plain.ToCBOR (LegacyPParams era)
   ) => ShelleyCompatible proto era
 
 instance ShelleyCompatible proto era => ConvertRawHash (ShelleyBlock proto era) where

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -74,6 +75,7 @@ import           Ouroboros.Consensus.Shelley.Ledger.Config
 import           Ouroboros.Consensus.Shelley.Ledger.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
                      (ShelleyNodeToClientVersion (..))
+import           Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder
 import           Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
 import           Ouroboros.Consensus.Util (ShowProxy (..))
 import           Ouroboros.Network.Block (Serialised (..), decodePoint,
@@ -268,7 +270,11 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) => QueryLedge
         DebugEpochState ->
           getEpochState st
         GetCBOR query' ->
-          mkSerialised (encodeShelleyResult query') $
+          -- We encode using the latest (@maxBound@) ShelleyNodeToClientVersion,
+          -- as the @GetCBOR@ query already is about opportunistically assuming
+          -- both client and server are running the same version; cf. the
+          -- @GetCBOR@ Haddocks.
+          mkSerialised (encodeShelleyResult maxBound query') $
             answerBlockQuery cfg query' ext
         GetFilteredDelegationsAndRewardAccounts creds ->
           getFilteredDelegationsAndRewardAccounts st creds
@@ -688,12 +694,13 @@ decodeShelleyQuery = do
 
 encodeShelleyResult ::
      forall proto era result. ShelleyCompatible proto era
-  => BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
-encodeShelleyResult query = case query of
+  => ShelleyNodeToClientVersion
+  -> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
+encodeShelleyResult v query = case query of
     GetLedgerTip                               -> encodePoint encode
     GetEpochNo                                 -> toCBOR
     GetNonMyopicMemberRewards {}               -> toCBOR
-    GetCurrentPParams                          -> toCBOR
+    GetCurrentPParams                          -> fst $ currentPParamsEnDecoding v
     GetProposedPParamsUpdates                  -> toCBOR
     GetStakeDistribution                       -> LC.toEraCBOR @era
     GetUTxOByAddress {}                        -> toCBOR
@@ -716,13 +723,14 @@ encodeShelleyResult query = case query of
 
 decodeShelleyResult ::
      forall proto era result. ShelleyCompatible proto era
-  => BlockQuery (ShelleyBlock proto era) result
+  => ShelleyNodeToClientVersion
+  -> BlockQuery (ShelleyBlock proto era) result
   -> forall s. Decoder s result
-decodeShelleyResult query = case query of
+decodeShelleyResult v query = case query of
     GetLedgerTip                               -> decodePoint decode
     GetEpochNo                                 -> fromCBOR
     GetNonMyopicMemberRewards {}               -> fromCBOR
-    GetCurrentPParams                          -> fromCBOR
+    GetCurrentPParams                          -> snd $ currentPParamsEnDecoding v
     GetProposedPParamsUpdates                  -> fromCBOR
     GetStakeDistribution                       -> LC.fromEraCBOR @era
     GetUTxOByAddress {}                        -> fromCBOR
@@ -743,6 +751,21 @@ decodeShelleyResult query = case query of
     GetPoolDistr {}                            -> LC.fromEraCBOR @era
     GetStakeDelegDeposits {}                   -> LC.fromEraCBOR @era
 
+currentPParamsEnDecoding ::
+     forall era s.
+     ( FromCBOR (LC.PParams era)
+     , ToCBOR (LC.PParams era)
+     , FromCBOR (LegacyPParams era)
+     , ToCBOR (LegacyPParams era)
+     )
+  => ShelleyNodeToClientVersion
+  -> (LC.PParams era -> Encoding, Decoder s (LC.PParams era))
+currentPParamsEnDecoding v
+  | v >= ShelleyNodeToClientVersion7
+  = (toCBOR, fromCBOR)
+  | otherwise
+  = (encodeLegacyPParams, decodeLegacyPParams)
+
 -- | The stake snapshot returns information about the mark, set, go ledger snapshots for a pool,
 -- plus the total active stake for each snapshot that can be used in a 'sigma' calculation.
 --

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query/PParamsLegacyEncoder.hs

@@ -0,0 +1,211 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
+
+-- | Ledger fixed/changed the serialisation of @PParams@ in a
+-- backwards-incompatible way in
+-- <https://github.com/input-output-hk/ouroboros-network/pull/4349/>.
+--
+-- This module contains the legacy serialisation in order to keep compatibility
+-- with applications (like cardano-cli or Ogmios) that still use the old
+-- serialisation logic. We use the negotiated node-to-client version to detect
+-- when the client does not yet support the fixed serialisation.
+--
+-- This module can be removed once the next HF (Conway) has happened.
+module Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder (
+    LegacyPParams (..)
+  , decodeLegacyPParams
+  , encodeLegacyPParams
+  ) where
+
+import           Cardano.Ledger.Allegra
+import           Cardano.Ledger.Alonzo
+import           Cardano.Ledger.Alonzo.PParams
+import           Cardano.Ledger.Babbage
+import           Cardano.Ledger.Babbage.PParams
+import           Cardano.Ledger.Binary
+import           Cardano.Ledger.Binary.Coders
+import qualified Cardano.Ledger.Binary.Plain as Plain
+import           Cardano.Ledger.Conway
+import           Cardano.Ledger.Core
+import           Cardano.Ledger.Crypto
+import           Cardano.Ledger.Mary
+import           Cardano.Ledger.Shelley
+import           Data.Functor.Identity
+
+newtype LegacyPParams era = LegacyPParams
+  { unLegacyPParams :: PParams era
+  }
+
+encodeLegacyPParams :: ToCBOR (LegacyPParams era) => PParams era -> Plain.Encoding
+encodeLegacyPParams pp = toCBOR (LegacyPParams pp)
+
+decodeLegacyPParams :: FromCBOR (LegacyPParams era) => Plain.Decoder s (PParams era)
+decodeLegacyPParams = unLegacyPParams <$> fromCBOR
+
+instance Crypto c => ToCBOR (LegacyPParams (ShelleyEra c)) where
+  toCBOR (LegacyPParams pp) = toCBOR pp
+
+instance Crypto c => FromCBOR (LegacyPParams (ShelleyEra c)) where
+  fromCBOR = LegacyPParams <$> fromCBOR
+
+instance Crypto c => ToCBOR (LegacyPParams (MaryEra c)) where
+  toCBOR (LegacyPParams pp) = toCBOR pp
+
+instance Crypto c => FromCBOR (LegacyPParams (MaryEra c)) where
+  fromCBOR = LegacyPParams <$> fromCBOR
+
+instance Crypto c => ToCBOR (LegacyPParams (AllegraEra c)) where
+  toCBOR (LegacyPParams pp) = toCBOR pp
+
+instance Crypto c => FromCBOR (LegacyPParams (AllegraEra c)) where
+  fromCBOR = LegacyPParams <$> fromCBOR
+
+instance Crypto c => ToCBOR (LegacyPParams (AlonzoEra c)) where
+  toCBOR (LegacyPParams (PParams AlonzoPParams{..})) =
+    toPlainEncoding (eraProtVerLow @(AlonzoEra c)) $
+      encode
+        ( Rec mkLegacyAlonzoPParams
+            !> To appMinFeeA
+            !> To appMinFeeB
+            !> To appMaxBBSize
+            !> To appMaxTxSize
+            !> To appMaxBHSize
+            !> To appKeyDeposit
+            !> To appPoolDeposit
+            !> To appEMax
+            !> To appNOpt
+            !> To appA0
+            !> To appRho
+            !> To appTau
+            !> To appD
+            !> To appExtraEntropy
+            !> E encCBORGroup appProtocolVersion
+            !> To appMinPoolCost
+            -- new/updated for alonzo
+            !> To appCoinsPerUTxOWord
+            !> To appCostModels
+            !> To appPrices
+            !> To appMaxTxExUnits
+            !> To appMaxBlockExUnits
+            !> To appMaxValSize
+            !> To appCollateralPercentage
+            !> To appMaxCollateralInputs
+        )
+    where
+      mkLegacyAlonzoPParams a b c d e f g h i j k l m n o p q r s t u v w x =
+        LegacyPParams $
+          PParams $
+            AlonzoPParams @Identity @(AlonzoEra c) a b c d e f g h i j k l m n o p q r s t u v w x
+
+instance Crypto c => FromCBOR (LegacyPParams (AlonzoEra c)) where
+  fromCBOR =
+    toPlainDecoder (eraProtVerLow @(AlonzoEra c)) $
+      decode $
+        RecD mkLegacyAlonzoPParams
+          <! From -- appMinFeeA
+          <! From -- appMinFeeB
+          <! From -- appMaxBBSize
+          <! From -- appMaxTxSize
+          <! From -- appMaxBHSize
+          <! From -- appKeyDeposit
+          <! From -- appPoolDeposit
+          <! From -- appEMax
+          <! From -- appNOpt
+          <! From -- appA0
+          <! From -- appRho
+          <! From -- appTau
+          <! From -- appD
+          <! From -- appExtraEntropy
+          <! D decCBORGroup -- appProtocolVersion
+          <! From -- appMinPoolCost
+          -- new/updated for alonzo
+          <! From -- appCoinsPerUTxOWord
+          <! From -- appCostModels
+          <! From -- appPrices
+          <! From -- appMaxTxExUnits
+          <! From -- appMaxBlockExUnits
+          <! From -- appMaxValSize
+          <! From -- appCollateralPercentage
+          <! From -- appMaxCollateralInputs
+    where
+      mkLegacyAlonzoPParams a b c d e f g h i j k l m n o p q r s t u v w x =
+        LegacyPParams $
+          PParams $
+            AlonzoPParams @Identity @(AlonzoEra c) a b c d e f g h i j k l m n o p q r s t u v w x
+
+instance Crypto c => ToCBOR (LegacyPParams (BabbageEra c)) where
+  toCBOR (LegacyPParams (PParams BabbagePParams{..})) =
+    toPlainEncoding (eraProtVerLow @(BabbageEra c)) $
+      encode
+        ( Rec mkLegacyBabbagePParams
+            !> To bppMinFeeA
+            !> To bppMinFeeB
+            !> To bppMaxBBSize
+            !> To bppMaxTxSize
+            !> To bppMaxBHSize
+            !> To bppKeyDeposit
+            !> To bppPoolDeposit
+            !> To bppEMax
+            !> To bppNOpt
+            !> To bppA0
+            !> To bppRho
+            !> To bppTau
+            !> E encCBORGroup bppProtocolVersion
+            !> To bppMinPoolCost
+            !> To bppCoinsPerUTxOByte
+            !> To bppCostModels
+            !> To bppPrices
+            !> To bppMaxTxExUnits
+            !> To bppMaxBlockExUnits
+            !> To bppMaxValSize
+            !> To bppCollateralPercentage
+            !> To bppMaxCollateralInputs
+        )
+    where
+      mkLegacyBabbagePParams a b c d e f g h i j k l m n o p q r s t u v =
+        LegacyPParams $
+          PParams $
+            BabbagePParams @Identity @(BabbageEra c) a b c d e f g h i j k l m n o p q r s t u v
+
+instance Crypto c => FromCBOR (LegacyPParams (BabbageEra c)) where
+  fromCBOR =
+    toPlainDecoder (eraProtVerLow @(BabbageEra c)) $
+      decode $
+        RecD mkLegacyBabbagePParams
+          <! From -- bppMinFeeA
+          <! From -- bppMinFeeB
+          <! From -- bppMaxBBSize
+          <! From -- bppMaxTxSize
+          <! From -- bppMaxBHSize
+          <! From -- bppKeyDeposit
+          <! From -- bppPoolDeposit
+          <! From -- bppEMax
+          <! From -- bppNOpt
+          <! From -- bppA0
+          <! From -- bppRho
+          <! From -- bppTau
+          <! D decCBORGroup -- bppProtocolVersion
+          <! From -- bppMinPoolCost
+          <! From -- bppCoinsPerUTxOByte
+          <! From -- bppCostModels
+          <! From -- bppPrices
+          <! From -- bppMaxTxExUnits
+          <! From -- bppMaxBlockExUnits
+          <! From -- maxValSize
+          <! From -- collateralPercentage
+          <! From -- maxCollateralInputs
+    where
+      mkLegacyBabbagePParams a b c d e f g h i j k l m n o p q r s t u v =
+        LegacyPParams $
+          PParams $
+            BabbagePParams @Identity @(BabbageEra c) a b c d e f g h i j k l m n o p q r s t u v
+
+instance Crypto c => ToCBOR (LegacyPParams (ConwayEra c)) where
+  toCBOR (LegacyPParams pp) = toCBOR pp
+
+instance Crypto c => FromCBOR (LegacyPParams (ConwayEra c)) where
+  fromCBOR = LegacyPParams <$> fromCBOR

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs

@@ -184,8 +184,8 @@ instance ShelleyCompatible proto era
   decodeNodeToClient _ _ = decodeShelleyQuery
 
 instance ShelleyCompatible proto era => SerialiseResult (ShelleyBlock proto era) (BlockQuery (ShelleyBlock proto era)) where
-  encodeResult _ _ = encodeShelleyResult
-  decodeResult _ _ = decodeShelleyResult
+  encodeResult _ = encodeShelleyResult
+  decodeResult _ = decodeShelleyResult
 
 instance ShelleyCompatible proto era  => SerialiseNodeToClient (ShelleyBlock proto era) SlotNo where
   encodeNodeToClient _ _ = toCBOR