Expand missing transaction content in examples in Test.Cardano.Ledger.<era>.Examples and refactor transaction examples to reduce duplication

Author: koslambrou

eras/allegra/impl/CHANGELOG.md

@@ -11,6 +11,12 @@
 
 * Change `ipv4` and `ipv6` to use exact byte sizes (4 and 16 respectively), no longer allowing leftover bytes
 
+### `testlib`
+
+* In `Test.Cardano.Ledger.Allegra.Examples`:
+  - Remove `mkAllegraBasedExampleTx`, `exampleAllegraBasedTxBody`, `exampleAllegraBasedShelleyTxBody`
+  - Add `exampleAllegraBasedTx`
+
 ## 1.9.0.0
 
 * Add `Generic` instance for `ApplyTxError`

eras/allegra/impl/cardano-ledger-allegra.cabal

@@ -169,6 +169,7 @@ library testlib
     QuickCheck,
     base,
     bytestring,
+    cardano-data,
     cardano-ledger-allegra,
     cardano-ledger-binary,
     cardano-ledger-core:{cardano-ledger-core, testlib},

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Examples.hs

@@ -4,11 +4,11 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
+-- | The example transactions in this module are not valid transactions. We
+-- don't care, we are only interested in serialisation, not validation.
 module Test.Cardano.Ledger.Allegra.Examples (
   ledgerExamples,
-  mkAllegraBasedExampleTx,
-  exampleAllegraBasedTxBody,
-  exampleAllegraBasedShelleyTxBody,
+  exampleAllegraBasedTx,
 ) where
 
 import Cardano.Ledger.Allegra
@@ -24,16 +24,19 @@ import Cardano.Ledger.Shelley.Rules (
  )
 import Cardano.Ledger.Shelley.Scripts
 import Cardano.Slotting.Slot
-import qualified Data.Map.Strict as Map
+import qualified Data.MapExtras as Map
 import qualified Data.Sequence.Strict as StrictSeq
+import Data.Typeable (Typeable)
 import Lens.Micro
 import Test.Cardano.Ledger.Shelley.Examples (
   LedgerExamples,
+  addShelleyBasedTopTxExampleFee,
+  addShelleyToBabbageExampleProposedPUpdates,
+  addShelleyToBabbageTxCerts,
+  addShelleyToConwayTxCerts,
   exampleCoin,
-  exampleShelleyBasedShelleyTxBody,
-  exampleShelleyBasedTxBody,
+  exampleShelleyBasedTx,
   mkKeyHash,
-  mkShelleyBasedExampleTx,
   mkShelleyBasedLedgerExamples,
  )
 
@@ -44,53 +47,45 @@ ledgerExamples =
         DelegateeNotRegisteredDELEG @AllegraEra (mkKeyHash 1)
     )
     exampleCoin
-    (mkAllegraBasedExampleTx $ exampleAllegraBasedShelleyTxBody exampleCoin)
+    exampleAllegraTx
     NoGenesis
 
-mkAllegraBasedExampleTx ::
+-- Complete Allegra transaction that is compatible until Babbage era
+-- ('ConwayEra' is not an instance of 'ShelleyEraTxBody').
+exampleAllegraTx ::
   forall era.
   ( EraTx era
   , AllegraEraTxAuxData era
   , AllegraEraScript era
+  , AllegraEraTxBody era
+  , ShelleyEraTxBody era
   ) =>
-  TxBody TopTx era ->
   Tx TopTx era
-mkAllegraBasedExampleTx txBody =
-  mkShelleyBasedExampleTx @era txBody
-    & witsTxL . scriptTxWitsL <>~ Map.singleton (hashScript script) script
-    & auxDataTxL
-      %~ fmap
-        ( \auxData ->
-            auxData & nativeScriptsTxAuxDataL <>~ StrictSeq.singleton exampleTimelock
-        )
-  where
-    script = fromNativeScript exampleTimelock
+exampleAllegraTx =
+  exampleAllegraBasedTx
+    & addShelleyBasedTopTxExampleFee
+    & addShelleyToBabbageExampleProposedPUpdates
+    & addShelleyToBabbageTxCerts
+    & addShelleyToConwayTxCerts
 
-exampleAllegraBasedShelleyTxBody ::
-  forall era.
-  ( AllegraEraTxBody era
-  , ShelleyEraTxBody era
+-- Complete transaction which is compatible with any era starting with Allegra.
+-- This transaction forms the basis on which future era transactions will be
+-- at the very least based on.
+exampleAllegraBasedTx ::
+  forall era l.
+  ( EraTx era
+  , AllegraEraTxAuxData era
+  , AllegraEraScript era
+  , AllegraEraTxBody era
+  , Typeable l
   ) =>
-  Value era ->
-  TxBody TopTx era
-exampleAllegraBasedShelleyTxBody value =
-  mkAllegraBasedExampleTxBody (exampleShelleyBasedShelleyTxBody value)
-
-exampleAllegraBasedTxBody ::
-  forall era.
-  AllegraEraTxBody era =>
-  Value era ->
-  TxBody TopTx era
-exampleAllegraBasedTxBody value =
-  mkAllegraBasedExampleTxBody (exampleShelleyBasedTxBody value)
-
-mkAllegraBasedExampleTxBody ::
-  forall era.
-  AllegraEraTxBody era =>
-  TxBody TopTx era ->
-  TxBody TopTx era
-mkAllegraBasedExampleTxBody txBody =
-  txBody & vldtTxBodyL .~ ValidityInterval (SJust (SlotNo 2)) (SJust (SlotNo 4))
+  Tx l era
+exampleAllegraBasedTx =
+  exampleShelleyBasedTx
+    & witsTxL . scriptTxWitsL <>~ Map.fromElems hashScript [fromNativeScript exampleTimelock]
+    & modifyTxAuxData
+      (nativeScriptsTxAuxDataL <>~ StrictSeq.singleton exampleTimelock)
+    & bodyTxL . vldtTxBodyL .~ ValidityInterval (SJust (SlotNo 2)) (SJust (SlotNo 4))
 
 exampleTimelock :: AllegraEraScript era => NativeScript era
 exampleTimelock =

eras/alonzo/impl/CHANGELOG.md

@@ -43,6 +43,9 @@
 * Add `genDatumPresent`
 * Added `Proxy era` argument to `exUnitsRule`
 * `TranslationInstance` has a new field `tiPlutusPurpose`
+* In `Test.Cardano.Ledger.Alonzo.Examples`:
+  - Remove `mkAlonzoBasedExampleTx`, `exampleAlonzoBasedShelleyTxBody`, `exampleAlonzoBasedTxBody`, `exampleRedeemer`
+  - Add `exampleAlonzoBasedTopTx`, `exampleAlonzoBasedTopTx`, `addAlonzoToConwayExampleReqSigners`
 
 ## 1.15.0.0