"Added the TxBody type with validity intervals and forge fields. Tied…

… this

together with the Timelocks scripts. TxBody is newtype wrapped around a MemoBytes.
It exports a set of HasField instances appropriate for a TxBody. Also created a
test file with a minumum number of test, testing the HasField use and roundtripp
CBOR properties. Cleaned up and extended Jareds idea of using EraIndependentTxBody.
Extended this to all types with a HashAnnotated instance, which now adds an
associated type family HashIndex. Made all uses consistent with this approach,
Removed the function eraIndTxBodyHash, which can be replaced hashAnnotated."

semantics/executable-spec/src/Data/MemoBytes.hs

@@ -70,6 +70,11 @@ instance Show t => Show (MemoBytes t) where show (Memo y _) = show y
 
 instance Ord t => Ord (MemoBytes t) where compare (Memo x _) (Memo y _) = compare x y
 
+{-
+instance HasField tag t c => HasField (tag::Symbol) (MemoBytes t) c where
+   getField (Memo x _) = getField @tag x
+-}
+
 shorten :: Lazy.ByteString -> ShortByteString
 shorten x = toShort (toStrict x)
 

shelley-ma/impl/cardano-ledger-shelley-ma.cabal

@@ -58,3 +58,50 @@ library
     -Wredundant-constraints
     -Wpartial-fields
   default-language:    Haskell2010
+
+
+test-suite cardano-ledger-test
+    type:                exitcode-stdio-1.0
+    main-is:             Tests.hs
+    other-modules:
+      Test.Cardano.Ledger.ShelleyMA.TxBody
+      Test.Cardano.Ledger.ShelleyMA.Timelocks
+
+    hs-source-dirs:      test
+    default-language:    Haskell2010
+    ghc-options:
+      -threaded
+      -rtsopts
+      -with-rtsopts=-N
+      -Wall
+      -Wcompat
+      -Wincomplete-record-updates
+      -Wincomplete-uni-patterns
+      -Wredundant-constraints
+      -- We set a bound here so that we're alerted of potential space
+      -- leaks in our generators (or test) code.
+      --
+      -- The 4 megabytes stack bound and 200 megabytes heap bound were
+      -- determined ad-hoc.
+      "-with-rtsopts=-K4m -M250m"
+    build-depends:
+      cardano-ledger-shelley-ma,
+      base >=4.9 && <4.15,
+      bytestring,
+      cardano-binary,
+      cardano-crypto-class,
+      cardano-crypto-praos,
+      cardano-prelude,
+      cardano-slotting,
+      cborg,
+      containers,
+      deepseq,
+      groups,
+      nothunks,
+      partial-order,
+      shelley-spec-ledger,
+      small-steps,
+      tasty-hedgehog,
+      tasty-hunit,
+      tasty-quickcheck,
+      tasty,

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Timelocks.hs

@@ -248,6 +248,18 @@ hashTimelockScript =
     . Hash.castHash
     . Hash.hashWith (\x -> nativeTimelockTag <> serialize' x)
 
+{-
+instance
+  ( Era era,
+    HasField "vldt" (Core.TxBody era) ValidityInterval,
+    Shelley.TxBodyConstraints era
+  ) =>
+  MultiSignatureScript (Timelock era) era
+  where
+  validateScript = validateTimelock
+  hashScript = hashTimelockScript
+-}
+
 showTimelock :: Era era => Timelock era -> String
 showTimelock (Interval (ValidityInterval SNothing SNothing)) = "(Interval -inf .. +inf)"
 showTimelock (Interval (ValidityInterval (SJust (SlotNo x)) SNothing)) = "(Interval " ++ show x ++ " .. +inf)"

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs

@@ -29,9 +29,13 @@ where
 import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Compactible (CompactForm (..), Compactible (..))
 import Cardano.Ledger.Core (Script, Value)
+<<<<<<< HEAD
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Era)
 import Cardano.Ledger.ShelleyMA (MaryOrAllegra, ShelleyMAEra)
+=======
+import Cardano.Ledger.Era (Era)
+>>>>>>> 622da3ac... "Added the TxBody type with validity intervals and forge fields. Tied this
 import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..), decodeVI, encodeVI)
 import Data.Coders
   ( Decode (..),
@@ -50,7 +54,10 @@ import GHC.Records
 import NoThunks.Class (NoThunks (..))
 import Shelley.Spec.Ledger.BaseTypes (StrictMaybe)
 import Shelley.Spec.Ledger.Coin (Coin (..))
+<<<<<<< HEAD
 import Shelley.Spec.Ledger.Hashing (EraIndependentTxBody, HashAnnotated (..))
+=======
+>>>>>>> 622da3ac... "Added the TxBody type with validity intervals and forge fields. Tied this
 import Shelley.Spec.Ledger.MetaData (MetaDataHash)
 import Shelley.Spec.Ledger.PParams (Update)
 import Shelley.Spec.Ledger.Serialization (encodeFoldable)
@@ -73,7 +80,8 @@ type FamsFrom era =
     Typeable (Script era),
     FromCBOR (CompactForm (Value era)), -- Arises because TxOut uses Compact form
     FromCBOR (Value era),
-    FromCBOR (Annotator (Script era)) -- Arises becaause DCert memoizes its bytes
+    FromCBOR (Annotator (Script era)), -- Arises becaause DCert memoizes its bytes
+    FromCBOR (Script era)
   )
 
 type FamsTo era =
@@ -88,7 +96,7 @@ type FamsTo era =
 data TxBody' era = TxBody'
   { inputs :: !(Set (TxIn era)),
     outputs :: !(StrictSeq (TxOut era)),
-    certs :: !(StrictSeq (DCert era)),
+    dcerts :: !(StrictSeq (DCert era)),
     wdrls :: !(Wdrl era),
     txfee :: !Coin,
     vldt :: !ValidityInterval, -- imported from Timelocks
@@ -104,9 +112,8 @@ data TxBody' era = TxBody'
 
 deriving instance (Compactible (Value era), Eq (Value era)) => Eq (TxBody' era)
 
-deriving instance
-  (Era era, Compactible (Value era), Show (Value era)) =>
-  Show (TxBody' era)
+deriving instance (Era era, Compactible (Value era), Show (Value era)) => Show (TxBody' era)
+
 
 deriving instance Generic (TxBody' era)
 
@@ -141,21 +148,13 @@ instance
 newtype TxBody e = STxBody (MemoBytes (TxBody' e))
   deriving (Typeable)
 
-type instance
-  Core.TxBody (ShelleyMAEra (ma :: MaryOrAllegra) c) =
-    TxBody (ShelleyMAEra ma c)
-
 deriving instance (Compactible (Value era), Eq (Value era)) => Eq (TxBody era)
 
-deriving instance
-  (Era era, Compactible (Value era), Show (Value era)) =>
-  Show (TxBody era)
+deriving instance (Era era, Compactible (Value era), Show (Value era)) => Show (TxBody era)
 
 deriving instance Generic (TxBody era)
 
-deriving newtype instance
-  (Typeable era, NoThunks (Value era)) =>
-  NoThunks (TxBody era)
+deriving newtype instance (Typeable era, NoThunks (Value era)) => NoThunks (TxBody era)
 
 deriving newtype instance (Typeable era) => ToCBOR (TxBody era)
 
@@ -224,8 +223,8 @@ instance HasField "inputs" (TxBody e) (Set (TxIn e)) where
 instance HasField "outputs" (TxBody e) (StrictSeq (TxOut e)) where
   getField (STxBody (Memo m _)) = getField @"outputs" m
 
-instance HasField "certs" (TxBody e) (StrictSeq (DCert e)) where
-  getField (STxBody (Memo m _)) = getField @"certs" m
+instance HasField "dcerts" (TxBody e) (StrictSeq (DCert e)) where
+  getField (STxBody (Memo m _)) = getField @"dcerts" m
 
 instance HasField "wdrls" (TxBody e) (Wdrl e) where
   getField (STxBody (Memo m _)) = getField @"wdrls" m
@@ -236,10 +235,10 @@ instance HasField "txfee" (TxBody e) Coin where
 instance HasField "vldt" (TxBody e) ValidityInterval where
   getField (STxBody (Memo m _)) = getField @"vldt" m
 
-instance HasField "update" (TxBody e) (StrictMaybe (Update e)) where
+instance HasField "txupdate" (TxBody e) (StrictMaybe (Update e)) where
   getField (STxBody (Memo m _)) = getField @"txupdate" m
 
-instance HasField "mdHash" (TxBody e) (StrictMaybe (MetaDataHash e)) where
+instance HasField "mdhash" (TxBody e) (StrictMaybe (MetaDataHash e)) where
   getField (STxBody (Memo m _)) = getField @"mdhash" m
 
 instance (Value e ~ vv) => HasField "forge" (TxBody e) vv where