Remove default implementation for the DecCBOR class

Author: f-f

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -90,16 +91,18 @@ newtype AlonzoExtraConfig = AlonzoExtraConfig
   deriving (Eq)
   deriving newtype (NFData, NoThunks, Show)
 
-instance DecCBOR AlonzoExtraConfig
+alonzoExtraConfigDecoder :: Decode (Closed Dense) AlonzoExtraConfig
+alonzoExtraConfigDecoder = RecD AlonzoExtraConfig <! D (decodeNullMaybe decodeCostModelsLenient)
+
+instance DecCBOR AlonzoExtraConfig where
+  decCBOR = decode alonzoExtraConfigDecoder
+  {-# INLINE decCBOR #-}
 
 instance EncCBOR AlonzoExtraConfig
 
 instance FromCBOR AlonzoExtraConfig where
-  fromCBOR =
-    eraDecoder @AlonzoEra $
-      decode $
-        RecD AlonzoExtraConfig
-          <! D (decodeNullMaybe decodeCostModelsLenient)
+  fromCBOR = eraDecoder @AlonzoEra $ decode alonzoExtraConfigDecoder
+  {-# INLINE fromCBOR #-}
 
 instance ToCBOR AlonzoExtraConfig where
   toCBOR x@(AlonzoExtraConfig _) =
@@ -183,25 +186,29 @@ pattern AlonzoGenesis
 instance EraGenesis AlonzoEra where
   type Genesis AlonzoEra = AlonzoGenesis
 
+alonzoGenesisDecoder :: Decode (Closed Dense) AlonzoGenesis
+alonzoGenesisDecoder =
+  RecD AlonzoGenesis
+    <! From
+    <! D (decodeCostModel PlutusV1)
+    <! From
+    <! From
+    <! From
+    <! From
+    <! From
+    <! From
+    <! From
+
 -- | Genesis types are always encoded with the version of era they are defined in.
-instance DecCBOR AlonzoGenesis
+instance DecCBOR AlonzoGenesis where
+  decCBOR = decode alonzoGenesisDecoder
+  {-# INLINE decCBOR #-}
 
 instance EncCBOR AlonzoGenesis
 
 instance FromCBOR AlonzoGenesis where
-  fromCBOR =
-    eraDecoder @AlonzoEra $
-      decode $
-        RecD AlonzoGenesis
-          <! From
-          <! D (decodeCostModel PlutusV1)
-          <! From
-          <! From
-          <! From
-          <! From
-          <! From
-          <! From
-          <! From
+  fromCBOR = eraDecoder @AlonzoEra $ decode alonzoGenesisDecoder
+  {-# INLINE fromCBOR #-}
 
 instance ToCBOR AlonzoGenesis where
   toCBOR x@(AlonzoGenesis _ _ _ _ _ _ _ _ _) =

eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/SigningKey.hs

@@ -14,7 +14,7 @@ import Cardano.Crypto.Signing.Redeem.VerificationKey (
   redeemVKB64F,
  )
 import Cardano.Ledger.Binary (
-  DecCBOR,
+  DecCBOR (..),
   EncCBOR,
   FromCBOR (..),
   ToCBOR (..),
@@ -34,7 +34,9 @@ newtype RedeemSigningKey
 
 instance EncCBOR RedeemSigningKey
 
-instance DecCBOR RedeemSigningKey
+instance DecCBOR RedeemSigningKey where
+  decCBOR = RedeemSigningKey <$> decCBOR
+  {-# INLINE decCBOR #-}
 
 -- Note that there is deliberately no Ord instance. The crypto libraries
 -- encourage using key /hashes/ not keys for things like sets, map etc.

eras/conway/impl/src/Cardano/Ledger/Conway/Genesis.hs

@@ -68,12 +68,13 @@ instance NoThunks ConwayGenesis
 
 instance NFData ConwayGenesis
 
+conwayGenesisDecoder :: Decode (Closed Dense) ConwayGenesis
+conwayGenesisDecoder = RecD ConwayGenesis <! From <! From <! From <! From <! From
+
 -- | Genesis are always encoded with the version of era they are defined in.
 instance FromCBOR ConwayGenesis where
-  fromCBOR =
-    eraDecoder @ConwayEra $
-      decode $
-        RecD ConwayGenesis <! From <! From <! From <! From <! From
+  fromCBOR = eraDecoder @ConwayEra $ decode conwayGenesisDecoder
+  {-# INLINE fromCBOR #-}
 
 instance ToCBOR ConwayGenesis where
   toCBOR x@(ConwayGenesis _ _ _ _ _) =
@@ -86,7 +87,9 @@ instance ToCBOR ConwayGenesis where
             !> To cgDelegs
             !> To cgInitialDReps
 
-instance DecCBOR ConwayGenesis
+instance DecCBOR ConwayGenesis where
+  decCBOR = decode conwayGenesisDecoder
+  {-# INLINE decCBOR #-}
 
 instance EncCBOR ConwayGenesis
 

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

@@ -195,16 +195,15 @@ import Cardano.Ledger.Binary (
   ToCBOR (..),
   decNoShareCBOR,
   decodeRecordNamedT,
+  decodeWord8,
  )
 import Cardano.Ledger.Binary.Coders (
   Encode (..),
   encode,
   (!>),
  )
-import Cardano.Ledger.Binary.Plain (
-  decodeWord8,
-  encodeWord8,
- )
+import Cardano.Ledger.Binary.Plain (encodeWord8)
+import qualified Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Compactible (CompactForm)
 import Cardano.Ledger.Conway.Era (ConwayEra)
@@ -539,7 +538,7 @@ data DefaultVote
 
 instance FromCBOR DefaultVote where
   fromCBOR = do
-    tag <- decodeWord8
+    tag <- Plain.decodeWord8
     case tag of
       0 -> pure DefaultNo
       1 -> pure DefaultAbstain
@@ -553,7 +552,15 @@ instance ToCBOR DefaultVote where
 
 instance EncCBOR DefaultVote
 
-instance DecCBOR DefaultVote
+instance DecCBOR DefaultVote where
+  decCBOR = do
+    tag <- decodeWord8
+    case tag of
+      0 -> pure DefaultNo
+      1 -> pure DefaultAbstain
+      2 -> pure DefaultNoConfidence
+      _ -> fail $ "Invalid DefaultVote tag " ++ show tag
+  {-# INLINE decCBOR #-}
 
 defaultStakePoolVote ::
   ConwayEraAccounts era =>

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -36,12 +37,12 @@ newtype DijkstraGenesis = DijkstraGenesis
 instance EraGenesis DijkstraEra where
   type Genesis DijkstraEra = DijkstraGenesis
 
+dijkstraGenesisDecoder :: Decode (Closed Dense) DijkstraGenesis
+dijkstraGenesisDecoder = RecD DijkstraGenesis <! From
+
 instance FromCBOR DijkstraGenesis where
-  fromCBOR =
-    eraDecoder @DijkstraEra $
-      decode $
-        RecD DijkstraGenesis
-          <! From
+  fromCBOR = eraDecoder @DijkstraEra $ decode dijkstraGenesisDecoder
+  {-# INLINE fromCBOR #-}
 
 instance ToCBOR DijkstraGenesis where
   toCBOR dg@(DijkstraGenesis _) =
@@ -50,6 +51,8 @@ instance ToCBOR DijkstraGenesis where
           Rec DijkstraGenesis
             !> To dgUpgradePParams
 
-instance DecCBOR DijkstraGenesis
+instance DecCBOR DijkstraGenesis where
+  decCBOR = decode dijkstraGenesisDecoder
+  {-# INLINE decCBOR #-}
 
 instance EncCBOR DijkstraGenesis

eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs

@@ -426,8 +426,46 @@ instance FromJSON ShelleyGenesisStaking where
         <$> (forceElemsToWHNF <$> obj .: "pools")
         <*> (forceElemsToWHNF <$> obj .: "stake")
 
+shelleyGenesisDecoder :: Decoder s ShelleyGenesis
+shelleyGenesisDecoder =
+  decodeRecordNamed "ShelleyGenesis" (const 15) $ do
+    sgSystemStart <- decCBOR
+    sgNetworkMagic <- decCBOR
+    sgNetworkId <- decCBOR
+    sgActiveSlotsCoeff <- activeSlotsCoeffDecCBOR
+    sgSecurityParam <- decCBOR
+    sgEpochLength <- decCBOR
+    sgSlotsPerKESPeriod <- decCBOR
+    sgMaxKESEvolutions <- decCBOR
+    sgSlotLength <- decCBOR
+    sgUpdateQuorum <- decCBOR
+    sgMaxLovelaceSupply <- decCBOR
+    sgProtocolParams <- decCBOR
+    sgGenDelegs <- decCBOR
+    sgInitialFunds <- decCBOR
+    sgStaking <- decCBOR
+    pure $
+      ShelleyGenesis
+        sgSystemStart
+        sgNetworkMagic
+        sgNetworkId
+        sgActiveSlotsCoeff
+        sgSecurityParam
+        (EpochSize sgEpochLength)
+        sgSlotsPerKESPeriod
+        sgMaxKESEvolutions
+        sgSlotLength
+        sgUpdateQuorum
+        sgMaxLovelaceSupply
+        sgProtocolParams
+        sgGenDelegs
+        sgInitialFunds
+        sgStaking
+
 -- | Genesis are always encoded with the version of era they are defined in.
-instance DecCBOR ShelleyGenesis
+instance DecCBOR ShelleyGenesis where
+  decCBOR = shelleyGenesisDecoder
+  {-# INLINE decCBOR #-}
 
 instance EncCBOR ShelleyGenesis
 
@@ -469,40 +507,8 @@ instance ToCBOR ShelleyGenesis where
           <> encCBOR sgStaking
 
 instance FromCBOR ShelleyGenesis where
-  fromCBOR = toPlainDecoder Nothing shelleyProtVer $ do
-    decodeRecordNamed "ShelleyGenesis" (const 15) $ do
-      sgSystemStart <- decCBOR
-      sgNetworkMagic <- decCBOR
-      sgNetworkId <- decCBOR
-      sgActiveSlotsCoeff <- activeSlotsCoeffDecCBOR
-      sgSecurityParam <- decCBOR
-      sgEpochLength <- decCBOR
-      sgSlotsPerKESPeriod <- decCBOR
-      sgMaxKESEvolutions <- decCBOR
-      sgSlotLength <- decCBOR
-      sgUpdateQuorum <- decCBOR
-      sgMaxLovelaceSupply <- decCBOR
-      sgProtocolParams <- decCBOR
-      sgGenDelegs <- decCBOR
-      sgInitialFunds <- decCBOR
-      sgStaking <- decCBOR
-      pure $
-        ShelleyGenesis
-          sgSystemStart
-          sgNetworkMagic
-          sgNetworkId
-          sgActiveSlotsCoeff
-          sgSecurityParam
-          (EpochSize sgEpochLength)
-          sgSlotsPerKESPeriod
-          sgMaxKESEvolutions
-          sgSlotLength
-          sgUpdateQuorum
-          sgMaxLovelaceSupply
-          sgProtocolParams
-          sgGenDelegs
-          sgInitialFunds
-          sgStaking
+  fromCBOR = toPlainDecoder Nothing shelleyProtVer shelleyGenesisDecoder
+  {-# INLINE fromCBOR #-}
 
 -- | Serialize `PositiveUnitInterval` type in the same way `Rational` is serialized,
 -- however ensure there is no usage of tag 30 by enforcing Shelley protocol version.

eras/shelley/impl/src/Cardano/Ledger/Shelley/Translation.hs

@@ -23,7 +23,16 @@ import Cardano.Ledger.Binary (
   toPlainDecoder,
   toPlainEncoding,
  )
-import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
+import Cardano.Ledger.Binary.Coders (
+  Decode (..),
+  Density (..),
+  Encode (..),
+  Wrapped (..),
+  decode,
+  encode,
+  (!>),
+  (<!),
+ )
 import Cardano.Ledger.Core (PParams, TranslationContext, emptyPParams)
 import Cardano.Ledger.Keys
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
@@ -54,18 +63,22 @@ instance ToCBOR FromByronTranslationContext where
               !> To fbtcProtocolParams
               !> To fbtcMaxLovelaceSupply
 
+fromByronTranslationContextDecoder :: Decode (Closed Dense) FromByronTranslationContext
+fromByronTranslationContextDecoder =
+  RecD FromByronTranslationContext
+    <! From
+    <! From
+    <! From
+
 instance FromCBOR FromByronTranslationContext where
-  fromCBOR =
-    toPlainDecoder Nothing shelleyProtVer $
-      decode $
-        RecD FromByronTranslationContext
-          <! From
-          <! From
-          <! From
+  fromCBOR = toPlainDecoder Nothing shelleyProtVer $ decode fromByronTranslationContextDecoder
+  {-# INLINE fromCBOR #-}
 
 instance EncCBOR FromByronTranslationContext
 
-instance DecCBOR FromByronTranslationContext
+instance DecCBOR FromByronTranslationContext where
+  decCBOR = decode fromByronTranslationContextDecoder
+  {-# INLINE decCBOR #-}
 
 instance FromJSON FromByronTranslationContext where
   parseJSON = withObject "FromByronTranslationContext" $ \o -> do

libs/cardano-ledger-binary/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.8.0.0
 
+* Remove default implementation for `DecCBOR` class
 * Change `Version` from `Word64` to `Word32`
   - Add `mkVersion32` and `getVersion32`
 * Remove `listLenBound` from `EncCBORGroup`