Merge pull request #5807 from IntersectMBO/aniketd/coders

Stop using Coders in some places

Author: lehins

eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs

@@ -67,6 +67,9 @@ import Cardano.Ledger.Binary (
   DecCBOR (decCBOR),
   EncCBOR (encCBOR),
   ToCBOR (..),
+  decodeRecordNamed,
+  ifDecoderVersionAtLeast,
+  natVersion,
  )
 import Cardano.Ledger.Binary.Coders (
   Decode (..),
@@ -139,7 +142,12 @@ decodeVI :: Decode (Closed Dense) ValidityInterval
 decodeVI = RecD ValidityInterval <! From <! From
 
 instance DecCBOR ValidityInterval where
-  decCBOR = decode decodeVI
+  decCBOR =
+    ifDecoderVersionAtLeast (natVersion @12) decodeValidityInterval (decode decodeVI)
+    where
+      decodeValidityInterval =
+        decodeRecordNamed "ValidityInterval" (const 2) $
+          ValidityInterval <$> decCBOR <*> decCBOR
 
 instance ToJSON ValidityInterval where
   toJSON vi =

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs

@@ -68,6 +68,8 @@ import Cardano.Ledger.Binary (
   ToCBOR,
   TokenType (..),
   decodeStrictSeq,
+  ifDecoderVersionAtLeast,
+  natVersion,
   peekTokenType,
  )
 import Cardano.Ledger.Binary.Coders
@@ -199,7 +201,7 @@ instance
   decCBOR =
     decodeTxAuxDataByTokenType @(Annotator (AlonzoTxAuxDataRaw era))
       decodeShelley
-      decodeAllegra
+      (ifDecoderVersionAtLeast (natVersion @12) decodeDijkstra decodeAllegra)
       decodeAlonzo
     where
       decodeShelley =
@@ -217,6 +219,11 @@ instance
                 (sequence <$> decodeStrictSeq decCBOR)
               <*! Ann (Emit Map.empty)
           )
+      decodeDijkstra =
+        decodeRecordNamed "AlonzoTxAuxDataRaw" (const 2) $ do
+          metadata <- decCBOR
+          annScripts <- sequence <$> decodeStrictSeq decCBOR
+          pure $ AlonzoTxAuxDataRaw <$> pure metadata <*> annScripts <*> pure Map.empty
       decodeAlonzo =
         decode $
           TagD 259 $

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs

@@ -110,8 +110,10 @@ import Cardano.Ledger.Binary (
   encodeListLen,
   encodeNullStrictMaybe,
   encodeWord8,
+  ifDecoderVersionAtLeast,
   internsFromMap,
   invalidKey,
+  natVersion,
  )
 import Cardano.Ledger.Binary.Coders (
   Decode (..),
@@ -179,10 +181,13 @@ data GovActionId = GovActionId
 
 instance DecCBOR GovActionId where
   decCBOR =
-    decode $
-      RecD GovActionId
-        <! From
-        <! From
+    ifDecoderVersionAtLeast (natVersion @12) decodeGovActionId $
+      decode $
+        RecD GovActionId <! From <! From
+    where
+      decodeGovActionId =
+        decodeRecordNamed "GovActionId" (const 2) $
+          GovActionId <$> decCBOR <*> decCBOR
 
 instance EncCBOR GovActionId where
   encCBOR GovActionId {..} =
@@ -450,10 +455,15 @@ instance NFData (VotingProcedure era)
 
 instance Era era => DecCBOR (VotingProcedure era) where
   decCBOR =
-    decode $
-      RecD VotingProcedure
-        <! From
-        <! D (decodeNullStrictMaybe decCBOR)
+    ifDecoderVersionAtLeast (natVersion @12) decodeVotingProcedure $
+      decode $
+        RecD VotingProcedure
+          <! From
+          <! D (decodeNullStrictMaybe decCBOR)
+    where
+      decodeVotingProcedure =
+        decodeRecordNamed "VotingProcedure" (const 2) $
+          VotingProcedure <$> decCBOR <*> decodeNullStrictMaybe decCBOR
   {-# INLINE decCBOR #-}
 
 instance Era era => EncCBOR (VotingProcedure era) where
@@ -511,12 +521,17 @@ instance EraPParams era => NFData (ProposalProcedure era)
 
 instance EraPParams era => DecCBOR (ProposalProcedure era) where
   decCBOR =
-    decode $
-      RecD ProposalProcedure
-        <! From
-        <! From
-        <! From
-        <! From
+    ifDecoderVersionAtLeast (natVersion @12) decodeProposalProcedure $
+      decode $
+        RecD ProposalProcedure
+          <! From
+          <! From
+          <! From
+          <! From
+    where
+      decodeProposalProcedure =
+        decodeRecordNamed "ProposalProcedure" (const 4) $
+          ProposalProcedure <$> decCBOR <*> decCBOR <*> decCBOR <*> decCBOR
   {-# INLINE decCBOR #-}
 
 instance EraPParams era => EncCBOR (ProposalProcedure era) where
@@ -932,10 +947,15 @@ instance Era era => Default (Constitution era) where
 
 instance Era era => DecCBOR (Constitution era) where
   decCBOR =
-    decode $
-      RecD Constitution
-        <! From
-        <! D (decodeNullStrictMaybe decCBOR)
+    ifDecoderVersionAtLeast (natVersion @12) decodeConstitution $
+      decode $
+        RecD Constitution
+          <! From
+          <! D (decodeNullStrictMaybe decCBOR)
+    where
+      decodeConstitution =
+        decodeRecordNamed "Constitution" (const 2) $
+          Constitution <$> decCBOR <*> decodeNullStrictMaybe decCBOR
 
 instance Era era => EncCBOR (Constitution era) where
   encCBOR Constitution {..} =

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs

@@ -49,7 +49,7 @@ import Cardano.Ledger.Binary (
   peekTokenType,
   serialize,
  )
-import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<*!))
+import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>))
 import Cardano.Ledger.Conway.Tx (AlonzoEraTx (..), Tx (..), getConwayMinFeeTx)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
@@ -158,11 +158,11 @@ instance (EraTx era, Typeable l) => DecCBOR (Annotator (DijkstraTx l era)) where
   decCBOR = withSTxBothLevels @l $ \case
     STopTx -> decodeDijkstraTopTx True
     SSubTx ->
-      decode $
-        Ann (RecD DijkstraSubTx)
-          <*! From
-          <*! From
-          <*! D (sequence <$> decodeNullStrictMaybe decCBOR)
+      decodeRecordNamed "DijkstraSubTx" (const 3) $ do
+        body <- decCBOR
+        wits <- decCBOR
+        aux <- sequence <$> decodeNullStrictMaybe decCBOR
+        pure $ DijkstraSubTx <$> body <*> wits <*> aux
 
 instance HasEraTxLevel DijkstraTx DijkstraEra where
   toSTxLevel DijkstraTx {} = STopTx

eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs

@@ -46,6 +46,7 @@ import Cardano.Ledger.Binary (
   cborError,
   decodeInteger,
   decodeMap,
+  decodeRecordNamed,
   decodeWord64,
   ifDecoderVersionAtLeast,
   peekTokenType,
@@ -296,10 +297,17 @@ decodeMaryValue = do
 
 decodeValuePair :: (forall t. Decoder t Integer) -> Decoder s MaryValue
 decodeValuePair decodeMultiAssetAmount =
-  decode $
-    RecD MaryValue
-      <! D (Coin . toInteger <$> decodeWord64)
-      <! D (decodeMultiAsset decodeMultiAssetAmount)
+  ifDecoderVersionAtLeast (natVersion @12) decodeMaryValue' $
+    decode $
+      RecD MaryValue
+        <! From
+        <! D (decodeMultiAsset decodeMultiAssetAmount)
+  where
+    decodeMaryValue' =
+      decodeRecordNamed "MaryValue" (const 2) $
+        MaryValue
+          <$> decCBOR
+          <*> decodeMultiAsset decodeMultiAssetAmount
 
 -- | `MultiAsset` can be used in two different circumstances:
 --

libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs

@@ -114,6 +114,7 @@ import Cardano.Ledger.Binary (
   ToCBOR,
   cborError,
   decodeIntegralRational,
+  decodeRecordNamed,
   encodeListLen,
   fromPlainDecoder,
   ifDecoderVersionAtLeast,
@@ -987,10 +988,13 @@ instance NFData Anchor where
 
 instance DecCBOR Anchor where
   decCBOR =
-    decode $
-      RecD Anchor
-        <! From
-        <! From
+    ifDecoderVersionAtLeast (natVersion @12) decodeAnchor $
+      decode $
+        RecD Anchor <! From <! From
+    where
+      decodeAnchor =
+        decodeRecordNamed "Anchor" (const 2) $
+          Anchor <$> decCBOR <*> decCBOR
 
 instance EncCBOR Anchor where
   encCBOR Anchor {..} =

libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs

@@ -35,6 +35,9 @@ import Cardano.Ledger.Binary (
   DecoderError (..),
   EncCBOR (encCBOR),
   cborError,
+  decodeRecordNamed,
+  ifDecoderVersionAtLeast,
+  natVersion,
  )
 import Cardano.Ledger.Binary.Coders (
   Decode (D, From, RecD),
@@ -190,8 +193,14 @@ instance EncCBOR ExUnits where
   encCBOR (ExUnits m s) = encode $ Rec ExUnits !> To m !> To s
 
 instance DecCBOR ExUnits where
-  decCBOR = decode $ RecD ExUnits <! D decNat <! D decNat
+  decCBOR =
+    ifDecoderVersionAtLeast (natVersion @12) decodeExUnits $
+      decode $
+        RecD ExUnits <! D decNat <! D decNat
     where
+      decodeExUnits =
+        decodeRecordNamed "ExUnits" (const 2) $
+          ExUnits <$> decNat <*> decNat
       decNat :: Decoder s Natural
       decNat = do
         x <- decCBOR
@@ -211,5 +220,12 @@ instance EncCBOR Prices where
   encCBOR (Prices m s) = encode $ Rec Prices !> To m !> To s
 
 instance DecCBOR Prices where
-  decCBOR = decode $ RecD Prices <! From <! From
+  decCBOR =
+    ifDecoderVersionAtLeast (natVersion @12) decodePrices $
+      decode $
+        RecD Prices <! From <! From
+    where
+      decodePrices =
+        decodeRecordNamed "Prices" (const 2) $
+          Prices <$> decCBOR <*> decCBOR
   {-# INLINE decCBOR #-}