Merge pull request #5122 from IntersectMBO/lehins/memoize-block-body-hash

Memoize block body hash computation

Author: lehins

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq/Internal.hs

@@ -25,6 +25,7 @@
 module Cardano.Ledger.Alonzo.TxSeq.Internal (
   AlonzoTxSeq (.., AlonzoTxSeq),
   hashAlonzoTxSeq,
+  hashAlonzoSegWits,
   alignedValidFlags,
 ) where
 
@@ -47,7 +48,7 @@ import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.BlockChain (auxDataSeqDecoder)
 import Control.Monad (unless)
 import Data.ByteString (ByteString)
-import Data.ByteString.Builder (shortByteString, toLazyByteString)
+import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Coerce (coerce)
 import Data.Maybe.Strict (maybeToStrictMaybe, strictMaybeToMaybe)
@@ -72,12 +73,14 @@ import NoThunks.Class (AllowThunksIn (..), NoThunks)
 
 data AlonzoTxSeq era = AlonzoTxSeqRaw
   { txSeqTxns :: !(StrictSeq (Tx era))
+  , txSeqHash :: Hash.Hash HASH EraIndependentBlockBody
+  -- ^ Memoized hash to avoid recomputation. Lazy on purpose.
   , txSeqBodyBytes :: BSL.ByteString
-  -- ^ Bytes encoding @Seq ('AlonzoTxBody' era)@
+  -- ^ Bytes encoding @Seq ('TxBody' era)@
   , txSeqWitsBytes :: BSL.ByteString
-  -- ^ Bytes encoding @Seq ('TxWitness' era)@
+  -- ^ Bytes encoding @Seq ('TxWits' era)@
   , txSeqMetadataBytes :: BSL.ByteString
-  -- ^ Bytes encoding a @Map Int ('AuxiliaryData')@. Missing indices have
+  -- ^ Bytes encoding a @'TxAuxData')@. Missing indices have
   -- 'SNothing' for metadata
   , txSeqIsValidBytes :: BSL.ByteString
   -- ^ Bytes representing a set of integers. These are the indices of
@@ -100,7 +103,7 @@ pattern AlonzoTxSeq ::
   StrictSeq (Tx era) ->
   AlonzoTxSeq era
 pattern AlonzoTxSeq xs <-
-  AlonzoTxSeqRaw xs _ _ _ _
+  AlonzoTxSeqRaw xs _ _ _ _ _
   where
     AlonzoTxSeq txns =
       let version = eraProtVerLow @era
@@ -110,24 +113,30 @@ pattern AlonzoTxSeq xs <-
           metaChunk index m = encodeIndexed <$> strictMaybeToMaybe m
             where
               encodeIndexed metadata = encCBOR index <> encodePreEncoded metadata
+          txSeqBodies =
+            serializeFoldablePreEncoded $ originalBytes . view bodyTxL <$> txns
+          txSeqWits =
+            serializeFoldablePreEncoded $ originalBytes . view witsTxL <$> txns
+          txSeqAuxDatas =
+            serialize version . encodeFoldableMapEncoder metaChunk $
+              fmap originalBytes . view auxDataTxL <$> txns
+          txSeqIsValids =
+            serialize version $ encCBOR $ nonValidatingIndices txns
        in AlonzoTxSeqRaw
             { txSeqTxns = txns
-            , txSeqBodyBytes =
-                serializeFoldablePreEncoded $ originalBytes . view bodyTxL <$> txns
-            , txSeqWitsBytes =
-                serializeFoldablePreEncoded $ originalBytes . view witsTxL <$> txns
-            , txSeqMetadataBytes =
-                serialize version . encodeFoldableMapEncoder metaChunk $
-                  fmap originalBytes . view auxDataTxL <$> txns
-            , txSeqIsValidBytes =
-                serialize version $ encCBOR $ nonValidatingIndices txns
+            , txSeqHash = hashAlonzoSegWits txSeqBodies txSeqWits txSeqAuxDatas txSeqIsValids
+            , txSeqBodyBytes = txSeqBodies
+            , txSeqWitsBytes = txSeqWits
+            , txSeqMetadataBytes = txSeqAuxDatas
+            , txSeqIsValidBytes = txSeqIsValids
             }
 
 {-# COMPLETE AlonzoTxSeq #-}
 
 deriving via
   AllowThunksIn
-    '[ "txSeqBodyBytes"
+    '[ "txSeqHash"
+     , "txSeqBodyBytes"
      , "txSeqWitsBytes"
      , "txSeqMetadataBytes"
      , "txSeqIsValidBytes"
@@ -145,7 +154,7 @@ deriving stock instance Eq (Tx era) => Eq (AlonzoTxSeq era)
 --------------------------------------------------------------------------------
 
 instance Era era => EncCBORGroup (AlonzoTxSeq era) where
-  encCBORGroup (AlonzoTxSeqRaw _ bodyBytes witsBytes metadataBytes invalidBytes) =
+  encCBORGroup (AlonzoTxSeqRaw _ _ bodyBytes witsBytes metadataBytes invalidBytes) =
     encodePreEncoded $
       BSL.toStrict $
         bodyBytes <> witsBytes <> metadataBytes <> invalidBytes
@@ -162,21 +171,32 @@ hashAlonzoTxSeq ::
   forall era.
   AlonzoTxSeq era ->
   Hash HASH EraIndependentBlockBody
-hashAlonzoTxSeq (AlonzoTxSeqRaw _ bodies ws md vs) =
-  coerce $
-    hashStrict $
-      BSL.toStrict $
-        toLazyByteString $
-          mconcat
-            [ hashPart bodies
-            , hashPart ws
-            , hashPart md
-            , hashPart vs
-            ]
+hashAlonzoTxSeq = txSeqHash
+
+hashAlonzoSegWits ::
+  BSL.ByteString ->
+  -- | Bytes for transaction bodies
+  BSL.ByteString ->
+  -- | Bytes for transaction witnesses
+  BSL.ByteString ->
+  -- | Bytes for transaction auxiliary datas
+  BSL.ByteString ->
+  -- | Bytes for transaction isValid flags
+  Hash HASH EraIndependentBlockBody
+hashAlonzoSegWits txSeqBodies txSeqWits txAuxData txSeqIsValids =
+  coerce . hashLazy . toLazyByteString $
+    hashPart txSeqBodies
+      <> hashPart txSeqWits
+      <> hashPart txAuxData
+      <> hashPart txSeqIsValids
   where
-    hashStrict :: ByteString -> Hash HASH ByteString
-    hashStrict = Hash.hashWith id
-    hashPart = shortByteString . Hash.hashToBytesShort . hashStrict . BSL.toStrict
+    hashLazy :: BSL.ByteString -> Hash HASH ByteString
+    hashLazy = Hash.hashWith id . BSL.toStrict
+    {-# INLINE hashLazy #-}
+    hashPart :: BSL.ByteString -> Builder
+    hashPart = shortByteString . Hash.hashToBytesShort . hashLazy
+    {-# INLINE hashPart #-}
+{-# INLINE hashAlonzoSegWits #-}
 
 instance
   ( AlonzoEraTx era
@@ -198,24 +218,19 @@ instance
 
     (isValIdxs, isValAnn) <- withSlice decCBOR
     let validFlags = alignedValidFlags bodiesLength isValIdxs
-    unless
-      (bodiesLength == witsLength)
-      ( fail $
-          "different number of transaction bodies ("
-            <> show bodiesLength
-            <> ") and witness sets ("
-            <> show witsLength
-            <> ")"
-      )
-    unless
-      (all inRange isValIdxs)
-      ( fail
-          ( "Some IsValid index is not in the range: 0 .. "
-              ++ show (bodiesLength - 1)
-              ++ ", "
-              ++ show isValIdxs
-          )
-      )
+    unless (bodiesLength == witsLength) $
+      fail $
+        "different number of transaction bodies ("
+          <> show bodiesLength
+          <> ") and witness sets ("
+          <> show witsLength
+          <> ")"
+    unless (all inRange isValIdxs) $
+      fail $
+        "Some IsValid index is not in the range: 0 .. "
+          ++ show (bodiesLength - 1)
+          ++ ", "
+          ++ show isValIdxs
 
     let txns =
           sequenceA $
@@ -224,6 +239,7 @@ instance
     pure $
       AlonzoTxSeqRaw
         <$> txns
+        <*> (hashAlonzoSegWits <$> bodiesAnn <*> witsAnn <*> auxDataAnn <*> isValAnn)
         <*> bodiesAnn
         <*> witsAnn
         <*> auxDataAnn

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

@@ -62,24 +62,20 @@ instance
     auxData <- auxDataSeqDecoder @(TxAuxData era) bodiesLength auxDataMap
     Annotated isValidIdxs isValidBytes <- decodeAnnotated decCBOR
     let validFlags = alignedValidFlags bodiesLength isValidIdxs
-    unless
-      (bodiesLength == witsLength)
-      ( fail $
-          "different number of transaction bodies ("
-            <> show bodiesLength
-            <> ") and witness sets ("
-            <> show witsLength
-            <> ")"
-      )
-    unless
-      (all inRange isValidIdxs)
-      ( fail
-          ( "Some IsValid index is not in the range: 0 .. "
-              ++ show (bodiesLength - 1)
-              ++ ", "
-              ++ show isValidIdxs
-          )
-      )
+    unless (bodiesLength == witsLength) $
+      fail $
+        "different number of transaction bodies ("
+          <> show bodiesLength
+          <> ") and witness sets ("
+          <> show witsLength
+          <> ")"
+    unless (all inRange isValidIdxs) $
+      fail $
+        "Some IsValid index is not in the range: 0 .. "
+          ++ show (bodiesLength - 1)
+          ++ ", "
+          ++ show isValidIdxs
+
     let mkTx body wit isValid aData =
           mkBasicTx body
             & witsTxL .~ wit
@@ -91,6 +87,7 @@ instance
     pure $
       AlonzoTxSeqRaw
         txs
+        (hashAlonzoSegWits bodiesBytes witsBytes auxDataBytes isValidBytes)
         bodiesBytes
         witsBytes
         auxDataBytes

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

@@ -21,6 +21,7 @@ module Cardano.Ledger.Shelley.BlockChain (
   auxDataSeqDecoder,
   txSeqTxns,
   bbHash,
+  hashShelleySegWits,
   bBodySize,
   slotToNonce,
   --
@@ -55,6 +56,7 @@ import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
 import Cardano.Ledger.Slot (SlotNo (..))
 import Control.Monad (unless)
 import Data.ByteString (ByteString)
+import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Coerce (coerce)
 import Data.IntMap (IntMap)
@@ -72,23 +74,29 @@ import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
 
 data ShelleyTxSeq era = TxSeq'
   { txSeqTxns' :: !(StrictSeq (ShelleyTx era))
+  , txSeqHash :: Hash.Hash HASH EraIndependentBlockBody
+  -- ^ Memoized hash to avoid recomputation. Lazy on purpose.
   , txSeqBodyBytes :: BSL.ByteString
+  -- ^ Bytes encoding @Seq ('TxBody' era)@
   , txSeqWitsBytes :: BSL.ByteString
+  -- ^ Bytes encoding @Seq ('TxWits' era)@
   , txSeqMetadataBytes :: BSL.ByteString
-  -- bytes representing a (Map index metadata). Missing indices have SNothing for metadata
+  -- ^ Bytes encoding a @Seq ('TxAuxData' era)@. Missing indices have
+  -- 'SNothing' for metadata
   }
   deriving (Generic)
 
 instance EraSegWits ShelleyEra where
   type TxSeq ShelleyEra = ShelleyTxSeq ShelleyEra
   fromTxSeq = txSeqTxns
   toTxSeq = ShelleyTxSeq
-  hashTxSeq = bbHash
+  hashTxSeq = txSeqHash
   numSegComponents = 3
 
 deriving via
   AllowThunksIn
-    '[ "txSeqBodyBytes"
+    '[ "txSeqHash"
+     , "txSeqBodyBytes"
      , "txSeqWitsBytes"
      , "txSeqMetadataBytes"
      ]
@@ -131,7 +139,7 @@ pattern ShelleyTxSeq ::
   StrictSeq (Tx era) ->
   ShelleyTxSeq era
 pattern ShelleyTxSeq xs <-
-  TxSeq' xs _ _ _
+  TxSeq' xs _ _ _ _
   where
     ShelleyTxSeq txns =
       let version = eraProtVerLow @era
@@ -141,29 +149,32 @@ pattern ShelleyTxSeq xs <-
           metaChunk index m = encodePair <$> strictMaybeToMaybe m
             where
               encodePair metadata = encCBOR index <> encodePreEncoded metadata
+          txSeqBodies = serializeFoldable $ coreBodyBytes @era <$> txns
+          txSeqWits = serializeFoldable $ coreWitnessBytes @era <$> txns
+          txSeqAuxDatas =
+            serialize version . encodeFoldableMapEncoder metaChunk $ coreAuxDataBytes @era <$> txns
        in TxSeq'
             { txSeqTxns' = txns
+            , txSeqHash = hashShelleySegWits txSeqBodies txSeqWits txSeqAuxDatas
             , -- bytes encoding "Seq (TxBody era)"
-              txSeqBodyBytes = serializeFoldable $ coreBodyBytes @era <$> txns
+              txSeqBodyBytes = txSeqBodies
             , -- bytes encoding "Seq (TxWits era)"
-              txSeqWitsBytes = serializeFoldable $ coreWitnessBytes @era <$> txns
+              txSeqWitsBytes = txSeqWits
             , -- bytes encoding a "Map Int TxAuxData"
-              txSeqMetadataBytes =
-                serialize version . encodeFoldableMapEncoder metaChunk $
-                  coreAuxDataBytes @era <$> txns
+              txSeqMetadataBytes = txSeqAuxDatas
             }
 
 {-# COMPLETE ShelleyTxSeq #-}
 
 txSeqTxns :: ShelleyTxSeq era -> StrictSeq (ShelleyTx era)
-txSeqTxns (TxSeq' ts _ _ _) = ts
+txSeqTxns (TxSeq' ts _ _ _ _) = ts
 
 instance
   forall era.
   Era era =>
   EncCBORGroup (ShelleyTxSeq era)
   where
-  encCBORGroup (TxSeq' _ bodyBytes witsBytes metadataBytes) =
+  encCBORGroup (TxSeq' _ _ bodyBytes witsBytes metadataBytes) =
     encodePreEncoded $
       BSL.toStrict $
         bodyBytes <> witsBytes <> metadataBytes
@@ -176,17 +187,27 @@ instance
 
 -- | Hash a given block body
 bbHash :: ShelleyTxSeq era -> Hash HASH EraIndependentBlockBody
-bbHash (TxSeq' _ bodies wits md) =
-  coerce $
-    hashStrict
-      ( hashPart bodies
-          <> hashPart wits
-          <> hashPart md
-      )
+bbHash = txSeqHash
+
+hashShelleySegWits ::
+  BSL.ByteString ->
+  -- | Bytes for transaction bodies
+  BSL.ByteString ->
+  -- | Bytes for transaction witnesses
+  BSL.ByteString ->
+  -- | Bytes for transaction auxiliary datas
+  Hash HASH EraIndependentBlockBody
+hashShelleySegWits bodies wits md =
+  coerce . hashLazy . toLazyByteString $
+    hashPart bodies <> hashPart wits <> hashPart md
   where
-    hashStrict :: ByteString -> Hash HASH ByteString
-    hashStrict = Hash.hashWith id
-    hashPart = Hash.hashToBytes . hashStrict . BSL.toStrict
+    hashLazy :: BSL.ByteString -> Hash HASH ByteString
+    hashLazy = Hash.hashWith id . BSL.toStrict
+    {-# INLINE hashLazy #-}
+    hashPart :: BSL.ByteString -> Builder
+    hashPart = shortByteString . Hash.hashToBytesShort . hashLazy
+    {-# INLINE hashPart #-}
+{-# INLINE hashShelleySegWits #-}
 
 auxDataSeqDecoder ::
   Int -> IntMap a -> Decoder s (Seq (Maybe a))
@@ -246,7 +267,8 @@ instance
         sequenceA $
           StrictSeq.forceToStrict $
             Seq.zipWith3 segWitAnnTx bodies wits metadata
-    pure $ TxSeq' <$> txns <*> bodiesAnn <*> witsAnn <*> metadataAnn
+      hashAnn = hashShelleySegWits <$> bodiesAnn <*> witsAnn <*> metadataAnn
+    pure $ TxSeq' <$> txns <*> hashAnn <*> bodiesAnn <*> witsAnn <*> metadataAnn
 
 slotToNonce :: SlotNo -> Nonce
 slotToNonce (SlotNo s) = mkNonceFromNumber s

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

@@ -66,7 +66,8 @@ instance
     let txs =
           StrictSeq.forceToStrict $
             Seq.zipWith3 ShelleyTx bodies wits (maybeToStrictMaybe <$> auxData)
-    pure $ TxSeq' txs bodiesBytes witsBytes auxDataBytes
+        hash = hashShelleySegWits bodiesBytes witsBytes auxDataBytes
+    pure $ TxSeq' txs hash bodiesBytes witsBytes auxDataBytes
 
 deriving newtype instance DecCBOR (TxBody ShelleyEra)