Introduction of a Memoized type class and using it throught ledger.

This class allows us to abstract away common parts from MemoBytes usage
and reduce duplication. Besides improving safety it also provides us
with an easy way to operate on the underlying raw type.

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

@@ -15,6 +15,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 -- This is needed to make Plutus.Data instances
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -64,13 +65,22 @@ import Cardano.Ledger.Binary
     fromPlainDecoder,
     fromPlainEncoding,
     peekTokenType,
-    withSlice,
   )
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (HASH)
 import qualified Cardano.Ledger.Crypto as CC
-import Cardano.Ledger.MemoBytes (Mem, MemoBytes (..), MemoHashIndex, memoBytes, mkMemoBytes, shortToLazy)
+import Cardano.Ledger.MemoBytes
+  ( Mem,
+    MemoBytes (..),
+    MemoHashIndex,
+    Memoized (RawType),
+    getMemoRawType,
+    getMemoSafeHash,
+    mkMemoBytes,
+    mkMemoized,
+    shortToLazy,
+  )
 import qualified Cardano.Ledger.MemoBytes as Memo
 import Cardano.Ledger.SafeHash
   ( HashAnnotated,
@@ -98,12 +108,7 @@ import qualified PlutusLedgerApi.V1 as Plutus
 -- It is imported from the Plutus package, but it needs a few additional
 -- instances to also work in the ledger.
 
-instance FromCBOR (Annotator Plutus.Data) where
-  fromCBOR = pure <$> fromPlainDecoder Cborg.decode
-
-instance ToCBOR Plutus.Data where
-  toCBOR = fromPlainEncoding . Cborg.encode
-
+-- TODO: Move to PlutusCore.Data module
 deriving instance NoThunks Plutus.Data
 
 -- ============================================================================
@@ -113,7 +118,10 @@ deriving instance NoThunks Plutus.Data
 -- | This is a wrapper with a phantom era for Plutus.Data, since we need
 -- something with kind (* -> *) for MemoBytes
 newtype PlutusData era = PlutusData Plutus.Data
-  deriving newtype (Eq, Generic, Show, ToCBOR, NFData, NoThunks, Cborg.Serialise)
+  deriving newtype (Eq, Generic, Show, NFData, NoThunks, Cborg.Serialise)
+
+instance Typeable era => ToCBOR (PlutusData era) where
+  toCBOR (PlutusData d) = fromPlainEncoding $ Cborg.encode d
 
 instance Typeable era => FromCBOR (Annotator (PlutusData era)) where
   fromCBOR = pure <$> fromPlainDecoder Cborg.decode
@@ -122,30 +130,29 @@ newtype Data era = DataConstr (MemoBytes PlutusData era)
   deriving (Eq, Generic)
   deriving newtype (SafeToHash, ToCBOR, NFData)
 
+instance Memoized Data where
+  type RawType Data = PlutusData
+
 deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (Data era)
 
-instance (Era era) => FromCBOR (Annotator (Data era)) where
-  fromCBOR = do
-    (Annotator getT, Annotator getBytes) <- withSlice fromCBOR
-    pure (Annotator (\fullbytes -> DataConstr (mkMemoBytes (getT fullbytes) (getBytes fullbytes))))
+deriving via Mem PlutusData era instance Era era => FromCBOR (Annotator (Data era))
 
 type instance MemoHashIndex PlutusData = EraIndependentData
 
 instance (EraCrypto era ~ c) => HashAnnotated (Data era) EraIndependentData c where
-  hashAnnotated (DataConstr mb) = mbHash mb
+  hashAnnotated = getMemoSafeHash
 
 instance Typeable era => NoThunks (Data era)
 
 pattern Data :: Era era => Plutus.Data -> Data era
-pattern Data p <-
-  DataConstr (Memo (PlutusData p) _)
+pattern Data p <- (getMemoRawType -> PlutusData p)
   where
-    Data p = DataConstr $ memoBytes (To $ PlutusData p)
+    Data p = mkMemoized $ PlutusData p
 
 {-# COMPLETE Data #-}
 
-getPlutusData :: Era era => Data era -> Plutus.Data
-getPlutusData (DataConstr (Memo (PlutusData d) _)) = d
+getPlutusData :: Data era -> Plutus.Data
+getPlutusData (getMemoRawType -> PlutusData d) = d
 
 -- | Inlined data must be stored in the most compact form because it contributes
 -- to the memory overhead of the ledger state. Constructor is intentionally not
@@ -241,66 +248,57 @@ datumDataHash = \case
 -- =============================================================================
 -- Version without serialized bytes
 
-data AuxiliaryDataRaw era = AuxiliaryDataRaw
+data AlonzoTxAuxDataRaw era = AlonzoTxAuxDataRaw
   { txMD' :: !(Map Word64 Metadatum),
     scripts' :: !(StrictSeq (Script era))
   }
   deriving (Generic)
 
-deriving instance Eq (Script era) => Eq (AuxiliaryDataRaw era)
+deriving instance Eq (Script era) => Eq (AlonzoTxAuxDataRaw era)
 
-deriving instance Show (Script era) => Show (AuxiliaryDataRaw era)
+deriving instance Show (Script era) => Show (AlonzoTxAuxDataRaw era)
 
-instance NFData (Script era) => NFData (AuxiliaryDataRaw era)
+instance NFData (Script era) => NFData (AlonzoTxAuxDataRaw era)
 
 deriving via
-  InspectHeapNamed "AuxiliaryDataRaw" (AuxiliaryDataRaw era)
+  InspectHeapNamed "AlonzoTxAuxDataRaw" (AlonzoTxAuxDataRaw era)
   instance
-    NoThunks (AuxiliaryDataRaw era)
+    NoThunks (AlonzoTxAuxDataRaw era)
 
 instance
   ( Typeable era,
     Script era ~ AlonzoScript era,
     ToCBOR (Script era),
     Typeable (EraCrypto era)
   ) =>
-  ToCBOR (AuxiliaryDataRaw era)
+  ToCBOR (AlonzoTxAuxDataRaw era)
   where
-  toCBOR (AuxiliaryDataRaw m s) =
-    encode (encodeRaw m s)
-
-encodeRaw ::
-  ( Script era ~ AlonzoScript era,
-    Typeable era
-  ) =>
-  Map Word64 Metadatum ->
-  StrictSeq (Script era) ->
-  Encode ('Closed 'Sparse) (AuxiliaryDataRaw era)
-encodeRaw metadata allScripts =
-  Tag 259 $
-    Keyed
-      (\m tss p1 p2 -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> p1 <> p2))
-      !> Omit null (Key 0 $ To metadata)
-      !> Omit null (Key 1 $ E (toCBOR . mapMaybe getTimelock) timelocks)
-      !> Omit null (Key 2 $ E (toCBOR . mapMaybe getPlutus) plutusV1Scripts)
-      !> Omit null (Key 3 $ E (toCBOR . mapMaybe getPlutus) plutusV2Scripts)
-  where
-    getTimelock (TimelockScript x) = Just x
-    getTimelock _ = Nothing
-    getPlutus (PlutusScript _ x) = Just x
-    getPlutus _ = Nothing
-    sortScripts (ts, v1, v2) s@(TimelockScript _) = (s : ts, v1, v2)
-    sortScripts (ts, v1, v2) s@(PlutusScript PlutusV1 _) = (ts, s : v1, v2)
-    sortScripts (ts, v1, v2) s@(PlutusScript PlutusV2 _) = (ts, v1, s : v2)
-    (timelocks, plutusV1Scripts, plutusV2Scripts) =
-      foldl' sortScripts (mempty, mempty, mempty) allScripts
+  toCBOR (AlonzoTxAuxDataRaw metadata allScripts) =
+    encode $
+      Tag 259 $
+        Keyed
+          (\m tss p1 p2 -> AlonzoTxAuxDataRaw m (StrictSeq.fromList $ tss <> p1 <> p2))
+          !> Omit null (Key 0 $ To metadata)
+          !> Omit null (Key 1 $ E (toCBOR . mapMaybe getTimelock) timelocks)
+          !> Omit null (Key 2 $ E (toCBOR . mapMaybe getPlutus) plutusV1Scripts)
+          !> Omit null (Key 3 $ E (toCBOR . mapMaybe getPlutus) plutusV2Scripts)
+    where
+      getTimelock (TimelockScript x) = Just x
+      getTimelock _ = Nothing
+      getPlutus (PlutusScript _ x) = Just x
+      getPlutus _ = Nothing
+      sortScripts (ts, v1, v2) s@(TimelockScript _) = (s : ts, v1, v2)
+      sortScripts (ts, v1, v2) s@(PlutusScript PlutusV1 _) = (ts, s : v1, v2)
+      sortScripts (ts, v1, v2) s@(PlutusScript PlutusV2 _) = (ts, v1, s : v2)
+      (timelocks, plutusV1Scripts, plutusV2Scripts) =
+        foldl' sortScripts (mempty, mempty, mempty) allScripts
 
 instance
   ( Era era,
     FromCBOR (Annotator (Script era)),
     Script era ~ AlonzoScript era
   ) =>
-  FromCBOR (Annotator (AuxiliaryDataRaw era))
+  FromCBOR (Annotator (AlonzoTxAuxDataRaw era))
   where
   fromCBOR =
     peekTokenType >>= \case
@@ -316,13 +314,13 @@ instance
     where
       decodeShelley =
         decode
-          ( Ann (Emit AuxiliaryDataRaw)
+          ( Ann (Emit AlonzoTxAuxDataRaw)
               <*! Ann From
               <*! Ann (Emit StrictSeq.empty)
           )
       decodeShelleyMA =
         decode
-          ( Ann (RecD AuxiliaryDataRaw)
+          ( Ann (RecD AlonzoTxAuxDataRaw)
               <*! Ann From
               <*! D
                 ( sequence
@@ -335,7 +333,7 @@ instance
           TagD 259 $
             SparseKeyed "AuxiliaryData" (pure emptyAuxData) auxDataField []
 
-      auxDataField :: Word -> Field (Annotator (AuxiliaryDataRaw era))
+      auxDataField :: Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
       auxDataField 0 = fieldA (\x ad -> ad {txMD' = x}) From
       auxDataField 1 =
         fieldAA
@@ -351,15 +349,18 @@ instance
           (D (decodeStrictSeq fromCBOR))
       auxDataField n = field (\_ t -> t) (Invalid n)
 
-emptyAuxData :: AuxiliaryDataRaw era
-emptyAuxData = AuxiliaryDataRaw mempty mempty
+emptyAuxData :: AlonzoTxAuxDataRaw era
+emptyAuxData = AlonzoTxAuxDataRaw mempty mempty
 
 -- ================================================================================
 -- Version with serialized bytes.
 
-newtype AlonzoTxAuxData era = AuxiliaryDataConstr (MemoBytes AuxiliaryDataRaw era)
+newtype AlonzoTxAuxData era = AuxiliaryDataConstr (MemoBytes AlonzoTxAuxDataRaw era)
   deriving newtype (ToCBOR, SafeToHash)
 
+instance Memoized AlonzoTxAuxData where
+  type RawType AlonzoTxAuxData = AlonzoTxAuxDataRaw
+
 type AuxiliaryData era = AlonzoTxAuxData era
 
 {-# DEPRECATED AuxiliaryData "Use `AlonzoTxAuxData` instead" #-}
@@ -385,20 +386,20 @@ validateAlonzoTxAuxData pv (AlonzoTxAuxData metadata scrips) =
     && all (validScript pv) scrips
 
 instance (EraCrypto era ~ c) => HashAnnotated (AuxiliaryData era) EraIndependentTxAuxData c where
-  hashAnnotated (AuxiliaryDataConstr mb) = mbHash mb
+  hashAnnotated = getMemoSafeHash
 
 deriving newtype instance NFData (Script era) => NFData (AuxiliaryData era)
 
 deriving instance Eq (Script era) => Eq (AuxiliaryData era)
 
 deriving instance (Show (Script era), HashAlgorithm (HASH (EraCrypto era))) => Show (AuxiliaryData era)
 
-type instance MemoHashIndex AuxiliaryDataRaw = EraIndependentTxAuxData
+type instance MemoHashIndex AlonzoTxAuxDataRaw = EraIndependentTxAuxData
 
-deriving via InspectHeapNamed "AuxiliaryDataRaw" (AuxiliaryData era) instance NoThunks (AuxiliaryData era)
+deriving via InspectHeapNamed "AlonzoTxAuxDataRaw" (AuxiliaryData era) instance NoThunks (AuxiliaryData era)
 
 deriving via
-  (Mem AuxiliaryDataRaw era)
+  (Mem AlonzoTxAuxDataRaw era)
   instance
     ( Era era,
       FromCBOR (Annotator (Script era)),
@@ -415,13 +416,9 @@ pattern AlonzoTxAuxData ::
   StrictSeq (Script era) ->
   AuxiliaryData era
 pattern AlonzoTxAuxData {txMD, scripts} <-
-  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD scripts) _)
+  (getMemoRawType -> AlonzoTxAuxDataRaw txMD scripts)
   where
-    AlonzoTxAuxData m s =
-      AuxiliaryDataConstr
-        ( memoBytes
-            (encodeRaw m s)
-        )
+    AlonzoTxAuxData m s = mkMemoized $ AlonzoTxAuxDataRaw m s
 
 {-# COMPLETE AlonzoTxAuxData #-}
 
@@ -431,7 +428,7 @@ pattern AlonzoTxAuxData' ::
   StrictSeq (Script era) ->
   AlonzoTxAuxData era
 pattern AlonzoTxAuxData' txMD_ scripts_ <-
-  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD_ scripts_) _)
+  (getMemoRawType -> AlonzoTxAuxDataRaw txMD_ scripts_)
 
 {-# COMPLETE AlonzoTxAuxData' #-}
 

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

@@ -41,7 +41,6 @@ module Cardano.Ledger.Alonzo.Scripts
     decodeCostModel,
     CostModels (..),
     PV1.CostModelApplyError (..),
-    contentsEq,
   )
 where
 
@@ -85,7 +84,6 @@ import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.SafeHash (SafeToHash (..))
 import Cardano.Ledger.Shelley (nativeMultiSigTag)
 import Cardano.Ledger.ShelleyMA.Timelocks (Timelock)
-import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelocks
 import Control.DeepSeq (NFData (..), deepseq, rwhnf)
 import Control.Monad (when)
 import Control.Monad.Trans.Writer (WriterT (runWriterT))
@@ -384,7 +382,7 @@ instance ToCBOR Prices where
 instance FromCBOR Prices where
   fromCBOR = decode $ RecD Prices <! From <! From
 
-instance forall era. (Typeable (EraCrypto era), Typeable era) => ToCBOR (Script era) where
+instance (Typeable (EraCrypto era), Typeable era) => ToCBOR (Script era) where
   toCBOR x = encode (encodeScript x)
 
 encodeScript :: (Typeable era) => Script era -> Encode 'Open (Script era)
@@ -421,7 +419,3 @@ validScript pv script =
 transProtocolVersion :: ProtVer -> PV1.ProtocolVersion
 transProtocolVersion (ProtVer major minor) =
   PV1.ProtocolVersion ((fromIntegral :: Word64 -> Int) (getVersion64 major)) (fromIntegral minor)
-
-contentsEq :: Script era -> Script era -> Bool
-contentsEq (TimelockScript x) (TimelockScript y) = Timelocks.contentsEq x y
-contentsEq x y = x == y