Remove Coders from testlibs and tests

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Annotator.hs

@@ -20,7 +20,6 @@ import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Allegra.TxAuxData
 import Cardano.Ledger.Allegra.TxBody
 import Cardano.Ledger.Binary
-import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.MemoBytes (decodeMemoized)
 import qualified Data.Sequence.Strict as StrictSeq
@@ -46,31 +45,38 @@ instance
       TypeListLenIndef -> decodeFromList
       _ -> fail "Failed to decode AuxiliaryDataRaw"
     where
-      decodeFromMap =
-        decode
-          ( Emit AllegraTxAuxDataRaw
-              <! From
-              <! Emit StrictSeq.empty
-          )
+      decodeFromMap = do
+        metadata <- decCBOR
+        pure $ AllegraTxAuxDataRaw metadata StrictSeq.empty
       decodeFromList =
-        decode
-          ( RecD AllegraTxAuxDataRaw
-              <! From
-              <! From
-          )
+        decodeRecordNamed "AllegraTxAuxDataRaw" (const 2) $
+          AllegraTxAuxDataRaw <$> decCBOR <*> decCBOR
 
 deriving newtype instance
   (AllegraEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AllegraTxAuxData era)
 
 instance Era era => DecCBOR (TimelockRaw era) where
-  decCBOR = decode $ Summands "TimelockRaw" $ \case
-    0 -> SumD TimelockSignature <! From
-    1 -> SumD TimelockAllOf <! From
-    2 -> SumD TimelockAnyOf <! From
-    3 -> SumD TimelockMOf <! From <! From
-    4 -> SumD TimelockTimeStart <! From
-    5 -> SumD TimelockTimeExpire <! From
-    n -> Invalid n
+  decCBOR = decodeRecordSum "TimelockRaw" $ \case
+    0 -> do
+      keyHash <- decCBOR
+      pure (2, TimelockSignature keyHash)
+    1 -> do
+      timelocks <- decCBOR
+      pure (2, TimelockAllOf timelocks)
+    2 -> do
+      timelocks <- decCBOR
+      pure (2, TimelockAnyOf timelocks)
+    3 -> do
+      requiredCount <- decCBOR
+      timelocks <- decCBOR
+      pure (3, TimelockMOf requiredCount timelocks)
+    4 -> do
+      slot <- decCBOR
+      pure (2, TimelockTimeStart slot)
+    5 -> do
+      slot <- decCBOR
+      pure (2, TimelockTimeExpire slot)
+    k -> invalidKey k
 
 instance Era era => DecCBOR (Timelock era) where
   decCBOR = MkTimelock <$> decodeMemoized decCBOR

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs

@@ -27,7 +27,6 @@ import Cardano.Ledger.Alonzo.TxAuxData
 import Cardano.Ledger.Alonzo.TxBody
 import Cardano.Ledger.Alonzo.TxWits
 import Cardano.Ledger.Binary
-import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.Plutus
 import Cardano.Ledger.Shelley.BlockBody (auxDataSeqDecoder)
@@ -107,22 +106,12 @@ instance
   ) =>
   DecCBOR (AlonzoTx TopTx era)
   where
-  decCBOR =
-    ifDecoderVersionAtLeast (natVersion @12) decodeAlonzoTxPv12 $
-      decode $
-        RecD AlonzoTx
-          <! From
-          <! From
-          <! From
-          <! D (decodeNullStrictMaybe decCBOR)
-    where
-      decodeAlonzoTxPv12 = decodeRecordNamed "AlonzoTx" (const 4) $ do
-        body <- decCBOR
-        wits <- decCBOR
-        isValid <- decCBOR
-        auxData <- decodeNullStrictMaybe decCBOR
-        pure $ AlonzoTx body wits isValid auxData
-      {-# INLINE decodeAlonzoTxPv12 #-}
+  decCBOR = decodeRecordNamed "AlonzoTx" (const 4) $ do
+    body <- decCBOR
+    wits <- decCBOR
+    isValid <- decCBOR
+    auxData <- decodeNullStrictMaybe decCBOR
+    pure $ AlonzoTx body wits isValid auxData
   {-# INLINE decCBOR #-}
 
 instance
@@ -131,32 +120,22 @@ instance
   where
   decCBOR =
     decodeTxAuxDataByTokenType @(AlonzoTxAuxDataRaw era)
-      (ifDecoderVersionAtLeast (natVersion @12) decodeShelleyPv12 decodeShelley)
-      (ifDecoderVersionAtLeast (natVersion @12) decodeAllegraPv12 decodeAllegra)
-      (ifDecoderVersionAtLeast (natVersion @12) decodeAlonzoPv12 decodeAlonzo)
+      decodeShelley
+      decodeAllegra
+      decodeAlonzo
     where
-      decodeShelleyPv12 = do
+      decodeShelley = do
         metadata <- decCBOR
         pure $ AlonzoTxAuxDataRaw metadata StrictSeq.empty Map.empty
-      {-# INLINE decodeShelleyPv12 #-}
-      decodeShelley =
-        decode
-          (Emit AlonzoTxAuxDataRaw <! From <! Emit StrictSeq.empty <! Emit Map.empty)
-      decodeAllegraPv12 =
+      {-# INLINE decodeShelley #-}
+      decodeAllegra =
         decodeRecordNamed "AlonzoTxAuxDataRaw" (const 2) $
           AlonzoTxAuxDataRaw <$> decCBOR <*> decCBOR <*> pure Map.empty
-      {-# INLINE decodeAllegraPv12 #-}
-      decodeAllegra =
-        decode
-          (RecD AlonzoTxAuxDataRaw <! From <! From <! Emit Map.empty)
-      decodeAlonzoPv12 = do
+      {-# INLINE decodeAllegra #-}
+      decodeAlonzo = do
         assertTag 259
         decodeSparseKeyed TypeName [] emptyAlonzoTxAuxDataRaw decoderByKey
-      {-# INLINE decodeAlonzoPv12 #-}
-      decodeAlonzo =
-        decode $
-          TagD 259 $
-            SparseKeyed "AlonzoTxAuxData" emptyAlonzoTxAuxDataRaw auxDataField []
+      {-# INLINE decodeAlonzo #-}
 
       decoderByKey :: AlonzoTxAuxDataRaw era -> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
       decoderByKey acc = \case
@@ -179,23 +158,10 @@ instance
           {-# INLINE decodeAddPlutus #-}
       {-# INLINE decoderByKey #-}
 
-      auxDataField :: Word -> Field (AlonzoTxAuxDataRaw era)
-      auxDataField 0 = field (\x ad -> ad {atadrMetadata = x}) From
-      auxDataField 1 = field (\x ad -> ad {atadrNativeScripts = atadrNativeScripts ad <> x}) From
-      auxDataField 2 = field (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
-      auxDataField 3 = field (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
-      auxDataField 4 = field (addPlutusScripts PlutusV3) (D (guardPlutus PlutusV3 >> decCBOR))
-      auxDataField 5 = field (addPlutusScripts PlutusV4) (D (guardPlutus PlutusV4 >> decCBOR))
-      auxDataField n = invalidField n
-
 deriving newtype instance (Era era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxAuxData era)
 
 instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxWitsRaw era) where
-  decCBOR =
-    ifDecoderVersionAtLeast
-      (natVersion @12)
-      (decodeSparseKeyed TypeName [] emptyTxWitsRaw decoderByKey)
-      (decode $ SparseKeyed "AlonzoTxWits" emptyTxWitsRaw txWitnessField [])
+  decCBOR = decodeSparseKeyed TypeName [] emptyTxWitsRaw decoderByKey
     where
       setDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a)
       setDecoder =
@@ -227,34 +193,6 @@ instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxW
             (Set.fromList <$> decodeList decCBOR)
       {-# INLINE addrWitsSetDecoder #-}
 
-      txWitnessField :: Word -> Field (AlonzoTxWitsRaw era)
-      txWitnessField 0 =
-        field
-          (\x wits -> wits {atwrAddrTxWits = x})
-          ( D $
-              ifDecoderVersionAtLeast
-                (natVersion @9)
-                addrWitsSetDecoder
-                (Set.fromList <$> decodeList decCBOR)
-          )
-      txWitnessField 1 = field addScriptsTxWitsRaw (D nativeScriptsDecoder)
-      txWitnessField 2 =
-        field
-          (\x wits -> wits {atwrBootAddrTxWits = x})
-          ( D $
-              ifDecoderVersionAtLeast
-                (natVersion @9)
-                setDecoder
-                (Set.fromList <$> decodeList decCBOR)
-          )
-      txWitnessField 3 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV1)
-      txWitnessField 4 = field (\x wits -> wits {atwrDatsTxWits = x}) From
-      txWitnessField 5 = field (\x wits -> wits {atwrRdmrsTxWits = x}) From
-      txWitnessField 6 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV2)
-      txWitnessField 7 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV3)
-      txWitnessField n = invalidField n
-      {-# INLINE txWitnessField #-}
-
       decoderByKey :: AlonzoTxWitsRaw era -> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era))
       decoderByKey acc = \case
         0 -> Just $ do
@@ -361,33 +299,20 @@ instance AlonzoEraScript era => DecCBOR (RedeemersRaw era) where
 deriving newtype instance AlonzoEraScript era => DecCBOR (Redeemers era)
 
 instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoScript era) where
-  decCBOR =
-    ifDecoderVersionAtLeast (natVersion @12) decodeAlonzoScriptPv12 $
-      decode (Summands "AlonzoScript" decodeScript)
+  decCBOR = decodeRecordSum "AlonzoScript" $ \case
+    0 -> do
+      ns <- decCBOR
+      pure (2, NativeScript ns)
+    1 -> decodePlutusVariant SPlutusV1
+    2 -> decodePlutusVariant SPlutusV2
+    3 -> decodePlutusVariant SPlutusV3
+    4 -> decodePlutusVariant SPlutusV4
+    n -> invalidKey n
     where
-      decodeScript = \case
-        0 -> SumD NativeScript <! From
-        1 -> decodePlutus SPlutusV1
-        2 -> decodePlutus SPlutusV2
-        3 -> decodePlutus SPlutusV3
-        4 -> decodePlutus SPlutusV4
-        n -> Invalid n
-      decodePlutus slang =
-        SumD PlutusScript <! D (decodePlutusScript slang)
       decodePlutusVariant slang = do
         ps <- decodePlutusScript slang
         pure (2, PlutusScript ps)
       {-# INLINE decodePlutusVariant #-}
-      decodeAlonzoScriptPv12 = decodeRecordSum "AlonzoScript" $ \case
-        0 -> do
-          ns <- decCBOR
-          pure (2, NativeScript ns)
-        1 -> decodePlutusVariant SPlutusV1
-        2 -> decodePlutusVariant SPlutusV2
-        3 -> decodePlutusVariant SPlutusV3
-        4 -> decodePlutusVariant SPlutusV4
-        n -> invalidKey n
-      {-# INLINE decodeAlonzoScriptPv12 #-}
 
 -- | Decodes a set of `a`'s and maps a function over it to get key-value pairs.
 -- If the key-value pairs create a non-empty Map without duplicates, then that map is returned,

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -25,17 +26,11 @@ import Cardano.Ledger.Binary (
   DecoderError,
   EncCBOR (..),
   decodeFull,
+  decodeRecordNamed,
+  encodeListLen,
   fromPlainDecoder,
   fromPlainEncoding,
  )
-import Cardano.Ledger.Binary.Coders (
-  Decode (..),
-  Encode (..),
-  decode,
-  encode,
-  (!>),
-  (<!),
- )
 import Cardano.Ledger.Core
 import Cardano.Ledger.State (UTxO (..))
 import qualified Codec.Serialise as Cborg (Serialise (..))
@@ -187,14 +182,13 @@ instance
   EncCBOR (TranslationInstance era)
   where
   encCBOR (TranslationInstance pp l u tx p r) =
-    encode $
-      Rec TranslationInstance
-        !> To pp
-        !> To l
-        !> To u
-        !> To tx
-        !> To p
-        !> To r
+    encodeListLen 6
+      <> encCBOR pp
+      <> encCBOR l
+      <> encCBOR u
+      <> encCBOR tx
+      <> encCBOR p
+      <> encCBOR r
 
 instance
   ( DecCBOR (PParams era)
@@ -205,14 +199,14 @@ instance
   DecCBOR (TranslationInstance era)
   where
   decCBOR =
-    decode $
-      RecD TranslationInstance
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
+    decodeRecordNamed "TranslationInstance" (const 6) $
+      TranslationInstance
+        <$> decCBOR
+        <*> decCBOR
+        <*> decCBOR
+        <*> decCBOR
+        <*> decCBOR
+        <*> decCBOR
 
 deserializeTranslationInstances ::
   forall era.

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Annotator.hs

@@ -15,9 +15,9 @@ module Test.Cardano.Ledger.Shelley.Binary.Annotator (
   module Test.Cardano.Ledger.Core.Binary.Annotator,
 ) where
 
+import Cardano.Base.Typeable (TypeName (TypeName))
 import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
 import Cardano.Ledger.Binary
-import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.MemoBytes (decodeMemoized)
 import Cardano.Ledger.Shelley (ShelleyEra)
@@ -83,11 +83,11 @@ instance
   DecCBOR (ShelleyTx TopTx era)
   where
   decCBOR =
-    decode $
-      RecD ShelleyTx
-        <! From
-        <! From
-        <! D (decodeNullStrictMaybe decCBOR)
+    decodeRecordNamed "ShelleyTx" (const 3) $
+      ShelleyTx
+        <$> decCBOR
+        <*> decCBOR
+        <*> decodeNullStrictMaybe decCBOR
 
 deriving newtype instance DecCBOR (TxBody TopTx ShelleyEra)
 
@@ -96,22 +96,21 @@ deriving newtype instance DecCBOR (Tx TopTx ShelleyEra)
 deriving newtype instance Era era => DecCBOR (ShelleyTxAuxData era)
 
 instance (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWitsRaw era) where
-  decCBOR =
-    decode $
-      SparseKeyed
-        "ShelleyTxWits"
-        (ShelleyTxWitsRaw mempty mempty mempty)
-        witField
-        []
+  decCBOR = decodeSparseKeyed TypeName [] (ShelleyTxWitsRaw mempty mempty mempty) decoderByKey
     where
-      witField :: Word -> Field (ShelleyTxWitsRaw era)
-      witField 0 = field (\x wits -> wits {stwrAddrTxWits = x}) From
-      witField 1 =
-        field
-          (\x wits -> wits {stwrScriptTxWits = x})
-          (D $ Map.fromElems (hashScript @era) <$> decodeList decCBOR)
-      witField 2 = field (\x wits -> wits {stwrBootAddrTxWits = x}) From
-      witField n = invalidField n
+      decoderByKey :: ShelleyTxWitsRaw era -> Word -> Maybe (Decoder s (ShelleyTxWitsRaw era))
+      decoderByKey acc = \case
+        0 -> Just $ do
+          x <- decCBOR
+          pure $ acc {stwrAddrTxWits = x}
+        1 -> Just $ do
+          x <- Map.fromElems (hashScript @era) <$> decodeList decCBOR
+          pure $ acc {stwrScriptTxWits = x}
+        2 -> Just $ do
+          x <- decCBOR
+          pure $ acc {stwrBootAddrTxWits = x}
+        _ -> Nothing
+      {-# INLINE decoderByKey #-}
 
 instance (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWits era) where
   decCBOR = MkShelleyTxWits <$> decodeMemoized decCBOR