Redefine Header with MemoBytes (#1687)

Since we removed the `era` type parameter in `MemoBytes` (in
`cardano-ledger-core`), we can use `MemoBytes` to define more types that
need to be memoized - `Header` among them.

This simplifies the definition of `Header` and also brings some
instances for free.

Closes IntersectMBO/cardano-ledger#4850

Author: teodanciu

ouroboros-consensus-protocol/changelog.d/20250918_191621_teodora.danciu.md

@@ -0,0 +1,3 @@
+### Non-Breaking
+
+- Added `SafeToHash` instance for `BHeader`

ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Header.hs

@@ -2,9 +2,12 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Block header associated with Praos.
 --
@@ -39,10 +42,8 @@ import Cardano.Ledger.Binary
   , DecCBOR (decCBOR)
   , EncCBOR (..)
   , ToCBOR (..)
-  , encodedSigKESSizeExpr
   , serialize'
   , unCBORGroup
-  , withSlice
   )
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Binary.Crypto
@@ -56,18 +57,25 @@ import Cardano.Ledger.Hashes
   ( EraIndependentBlockBody
   , EraIndependentBlockHeader
   , HASH
+  , SafeToHash
+  , originalBytesSize
   )
 import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey)
+import Cardano.Ledger.MemoBytes
+  ( Mem
+  , MemoBytes
+  , Memoized (..)
+  , getMemoRawType
+  , mkMemoized
+  )
 import Cardano.Protocol.Crypto (Crypto, KES, VRF)
 import Cardano.Protocol.TPraos.BHeader (PrevHash)
 import Cardano.Protocol.TPraos.OCert (OCert)
 import Cardano.Slotting.Block (BlockNo)
 import Cardano.Slotting.Slot (SlotNo)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BSL
 import Data.Word (Word32)
 import GHC.Generics (Generic)
-import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
+import NoThunks.Class (NoThunks (..))
 import Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF)
 
 -- | The body of the header is the part which gets hashed to form the hash
@@ -121,54 +129,31 @@ instance Crypto c => Eq (HeaderRaw c) where
     headerRawSig h1 == headerRawSig h2
       && headerRawBody h1 == headerRawBody h2
 
--- | Checks the binary representation first.
-instance Crypto c => Eq (Header c) where
-  h1 == h2 =
-    headerBytes h1 == headerBytes h2
-      && headerRaw h1 == headerRaw h2
-
 instance
   Crypto crypto =>
   NoThunks (HeaderRaw crypto)
 
 -- | Full header type, carrying its own memoised bytes.
-data Header crypto = HeaderConstr
-  { headerRaw :: !(HeaderRaw crypto)
-  , headerBytes :: BS.ByteString -- lazy on purpose, constructed on demand
-  }
-  deriving (Show, Generic)
-  deriving NoThunks via AllowThunksIn '["headerBytes"] (Header crypto)
+newtype Header crypto = HeaderConstr (MemoBytes (HeaderRaw crypto))
+  deriving Generic
+  deriving newtype (Eq, Show, NoThunks, Plain.ToCBOR, SafeToHash)
+
+instance Memoized (Header crypto) where
+  type RawType (Header crypto) = HeaderRaw crypto
 
 pattern Header ::
   Crypto crypto =>
   HeaderBody crypto ->
   KES.SignedKES (KES crypto) (HeaderBody crypto) ->
   Header crypto
-pattern Header{headerBody, headerSig} <-
-  HeaderConstr
-    { headerRaw =
-      HeaderRaw
-        { headerRawBody = headerBody
-        , headerRawSig = headerSig
-        }
-    }
+pattern Header{headerBody, headerSig} <- (getMemoRawType -> HeaderRaw headerBody headerSig)
   where
-    Header body sig =
-      let header =
-            HeaderRaw
-              { headerRawBody = body
-              , headerRawSig = sig
-              }
-       in HeaderConstr
-            { headerRaw = header
-            , headerBytes = serialize' (pvMajor (hbProtVer body)) header
-            }
-
+    Header body sig = mkMemoized (pvMajor (hbProtVer body)) $ HeaderRaw body sig
 {-# COMPLETE Header #-}
 
 -- | Compute the size of the header
 headerSize :: Header crypto -> Int
-headerSize (HeaderConstr _ bytes) = BS.length bytes
+headerSize = originalBytesSize
 
 -- | Hash a header
 headerHash ::
@@ -239,16 +224,9 @@ instance Crypto crypto => DecCBOR (HeaderRaw crypto) where
 instance Crypto crypto => DecCBOR (Annotator (HeaderRaw crypto)) where
   decCBOR = pure <$> decCBOR
 
-instance Crypto c => Plain.ToCBOR (Header c) where
-  toCBOR (HeaderConstr _ bytes) = Plain.encodePreEncoded bytes
-
-instance Crypto c => EncCBOR (Header c) where
-  encodedSizeExpr size proxy =
-    1
-      + encodedSizeExpr size (headerRawBody . headerRaw <$> proxy)
-      + encodedSigKESSizeExpr (KES.getSig . headerRawSig . headerRaw <$> proxy)
+instance Crypto c => EncCBOR (Header c)
 
-instance Crypto c => DecCBOR (Annotator (Header c)) where
-  decCBOR = do
-    (Annotator getT, Annotator getBytes) <- withSlice decCBOR
-    pure (Annotator (\fullbytes -> HeaderConstr (getT fullbytes) (BSL.toStrict (getBytes fullbytes))))
+deriving via
+  Mem (HeaderRaw crypto)
+  instance
+    Crypto crypto => DecCBOR (Annotator (Header crypto))