Remove redundant memoization of bytes for BootstrapWitness

Author: lehins

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

@@ -218,7 +218,7 @@ shelleyEqTxWitsRaw :: EraTxWits era => TxWits era -> TxWits era -> Bool
 shelleyEqTxWitsRaw txWits1 txWits2 =
   txWits1 ^. addrTxWitsL == txWits2 ^. addrTxWitsL
     && liftEq eqRaw (txWits1 ^. scriptTxWitsL) (txWits2 ^. scriptTxWitsL)
-    && liftEq eqRaw (txWits1 ^. bootAddrTxWitsL) (txWits2 ^. bootAddrTxWitsL)
+    && txWits1 ^. bootAddrTxWitsL == txWits2 ^. bootAddrTxWitsL
 
 instance EraScript era => DecCBOR (Annotator (ShelleyTxWitsRaw era)) where
   decCBOR = decodeWits

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.18.0.0
 
+* Remove `eqBootstrapWitnessRaw` and `BootstrapWitnessRaw`
+* Rename `bwSig` to `bwSignature` for `BootstrapWitness`
 * Remove `witVKeyBytes` and `eqWitVKeyRaw`
 * Remove `EqRaw` instance for `WitVKey`
 * Replace `Block'` constructor with `Block`
@@ -10,8 +12,6 @@
 
 ## 1.17.0.0
 
-* Remove `eqBootstrapWitnessRaw` and `BootstrapWitnessRaw`
-* Rename `bwSig` to `bwSignature` for `BootstrapWitness`
 * Add `BoootstrapWitnessRaw` type
 * Add `EraStake`, `CanGetInstantStake`,  `CanSetInstantStake` , `snapShotFromInstantStake`, `resolveActiveInstantStakeCredentials`
 * Add boolean argument to `fromCborRigorousBothAddr` for lenient `Ptr` decoding

libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs

@@ -5,70 +5,50 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Cardano.Ledger.Keys.Bootstrap (
-  BootstrapWitness (
-    BootstrapWitness,
-    bwKey,
-    bwSig,
-    bwChainCode,
-    bwAttributes
-  ),
-  BootstrapWitnessRaw,
+  BootstrapWitness (..),
   ChainCode (..),
   bootstrapWitKeyHash,
   unpackByronVKey,
   makeBootstrapWitness,
   verifyBootstrapWit,
-  eqBootstrapWitnessRaw,
 )
 where
 
 import qualified Cardano.Chain.Common as Byron
 import Cardano.Crypto.DSIGN (SignedDSIGN (..))
 import qualified Cardano.Crypto.DSIGN as DSIGN
+import qualified Cardano.Crypto.DSIGN.Class as C
 import qualified Cardano.Crypto.Hash as Hash
 import qualified Cardano.Crypto.Signing as Byron
 import qualified Cardano.Crypto.Wallet as WC
 import Cardano.Ledger.Binary (
   Annotator,
   DecCBOR (..),
   EncCBOR (..),
-  byronProtVer,
+ )
+import Cardano.Ledger.Binary.Plain (
+  FromCBOR (..),
+  ToCBOR (..),
   decodeRecordNamed,
   encodeListLen,
   serialize',
  )
-import Cardano.Ledger.Binary.Crypto (
-  decodeSignedDSIGN,
-  encodeSignedDSIGN,
- )
-import qualified Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Hashes (ADDRHASH, EraIndependentTxBody, HASH, Hash, KeyHash (..))
 import Cardano.Ledger.Keys.Internal (
   DSIGN,
   KeyRole (..),
   VKey (..),
   verifySignedDSIGN,
  )
-import Cardano.Ledger.MemoBytes (
-  EqRaw (..),
-  Mem,
-  MemoBytes,
-  Memoized (..),
-  getMemoRawType,
-  mkMemoized,
- )
-import Control.DeepSeq (NFData)
+import Control.DeepSeq (NFData (..), rwhnf)
 import Data.ByteString (ByteString)
 import Data.Coerce (coerce)
 import Data.Maybe (fromMaybe)
@@ -81,65 +61,40 @@ import Quiet
 newtype ChainCode = ChainCode {unChainCode :: ByteString}
   deriving (Eq, Generic)
   deriving (Show) via Quiet ChainCode
-  deriving newtype (NoThunks, EncCBOR, DecCBOR, NFData)
+  deriving newtype (NoThunks, ToCBOR, FromCBOR, EncCBOR, DecCBOR, NFData)
 
-data BootstrapWitnessRaw = BootstrapWitnessRaw
-  { bwrKey :: !(VKey 'Witness)
-  , bwrSignature :: !(SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
-  , bwrChainCode :: !ChainCode
-  , bwrAttributes :: !ByteString
+data BootstrapWitness = BootstrapWitness
+  { bwKey :: !(VKey 'Witness)
+  , bwSignature :: !(SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
+  , bwChainCode :: !ChainCode
+  , bwAttributes :: !ByteString
   }
   deriving (Generic, Show, Eq)
 
-instance NFData BootstrapWitnessRaw
-instance NoThunks BootstrapWitnessRaw
+instance NFData BootstrapWitness where
+  rnf = rwhnf
+
+instance NoThunks BootstrapWitness
 
-instance EncCBOR BootstrapWitnessRaw where
-  encCBOR cwr@(BootstrapWitnessRaw _ _ _ _) =
-    let BootstrapWitnessRaw {..} = cwr
+instance ToCBOR BootstrapWitness where
+  toCBOR cwr@(BootstrapWitness _ _ _ _) =
+    let BootstrapWitness {..} = cwr
      in encodeListLen 4
-          <> encCBOR bwrKey
-          <> encodeSignedDSIGN bwrSignature
-          <> encCBOR bwrChainCode
-          <> encCBOR bwrAttributes
+          <> toCBOR bwKey
+          <> C.encodeSignedDSIGN bwSignature
+          <> toCBOR bwChainCode
+          <> toCBOR bwAttributes
+instance EncCBOR BootstrapWitness
 
-instance DecCBOR BootstrapWitnessRaw where
-  decCBOR =
+instance FromCBOR BootstrapWitness where
+  fromCBOR =
     decodeRecordNamed "BootstrapWitnessRaw" (const 4) $
-      BootstrapWitnessRaw <$> decCBOR <*> decodeSignedDSIGN <*> decCBOR <*> decCBOR
+      BootstrapWitness <$> fromCBOR <*> C.decodeSignedDSIGN <*> fromCBOR <*> fromCBOR
+instance DecCBOR BootstrapWitness
 
-instance DecCBOR (Annotator BootstrapWitnessRaw) where
+instance DecCBOR (Annotator BootstrapWitness) where
   decCBOR = pure <$> decCBOR
 
-newtype BootstrapWitness = BootstrapWitnessConstr (MemoBytes BootstrapWitnessRaw)
-  deriving (Generic)
-  deriving newtype (Show, Eq, NFData, NoThunks, Plain.ToCBOR, DecCBOR)
-
-instance Memoized BootstrapWitness where
-  type RawType BootstrapWitness = BootstrapWitnessRaw
-
-instance EncCBOR BootstrapWitness
-
-deriving via
-  Mem BootstrapWitnessRaw
-  instance
-    DecCBOR (Annotator BootstrapWitness)
-
-pattern BootstrapWitness ::
-  VKey 'Witness ->
-  SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) ->
-  ChainCode ->
-  ByteString ->
-  BootstrapWitness
-pattern BootstrapWitness {bwKey, bwSig, bwChainCode, bwAttributes} <-
-  ( getMemoRawType ->
-      BootstrapWitnessRaw bwKey bwSig bwChainCode bwAttributes
-    )
-  where
-    BootstrapWitness bwKey bwSig bwChainCode bwAttributes =
-      mkMemoized minBound $ BootstrapWitnessRaw bwKey bwSig bwChainCode bwAttributes
-{-# COMPLETE BootstrapWitness #-}
-
 instance Ord BootstrapWitness where
   compare = comparing bootstrapWitKeyHash
 
@@ -195,7 +150,7 @@ verifyBootstrapWit txbodyHash witness =
   verifySignedDSIGN
     (bwKey witness)
     txbodyHash
-    (coerce . bwSig $ witness)
+    (coerce $ bwSignature witness)
 
 coerceSignature :: WC.XSignature -> DSIGN.SigDSIGN DSIGN.Ed25519DSIGN
 coerceSignature sig =
@@ -208,7 +163,7 @@ makeBootstrapWitness ::
   Byron.Attributes Byron.AddrAttributes ->
   BootstrapWitness
 makeBootstrapWitness txBodyHash byronSigningKey addrAttributes =
-  BootstrapWitness vk signature cc (serialize' byronProtVer addrAttributes)
+  BootstrapWitness vk signature cc (serialize' addrAttributes)
   where
     (vk, cc) = unpackByronVKey $ Byron.toVerification byronSigningKey
     signature =
@@ -217,13 +172,3 @@ makeBootstrapWitness txBodyHash byronSigningKey addrAttributes =
           (mempty :: ByteString)
           (Byron.unSigningKey byronSigningKey)
           (Hash.hashToBytes txBodyHash)
-
-eqBootstrapWitnessRaw :: BootstrapWitness -> BootstrapWitness -> Bool
-eqBootstrapWitnessRaw bw1 bw2 =
-  bwKey bw1 == bwKey bw2
-    && bwSig bw1 == bwSig bw2
-    && bwChainCode bw1 == bwChainCode bw2
-    && bwAttributes bw1 == bwAttributes bw2
-
-instance EqRaw BootstrapWitness where
-  eqRaw = eqBootstrapWitnessRaw

libs/cardano-ledger-core/test/Test/Cardano/Ledger/AddressSpec.hs

@@ -57,7 +57,7 @@ spec =
             BootstrapWitness
               { bwKey = shelleyVKey
               , bwChainCode = chainCode
-              , bwSig = sig
+              , bwSignature = sig
               , bwAttributes = serialize' byronProtVer $ Byron.addrAttributes byronAddr
               }
       pure $

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs

@@ -370,10 +370,10 @@ instance Arbitrary ChainCode where
 instance Arbitrary BootstrapWitness where
   arbitrary = do
     bwKey <- arbitrary
-    bwSig <- arbitrary
+    bwSignature <- arbitrary
     bwChainCode <- arbitrary
     bwAttributes <- arbitrary
-    pure $ BootstrapWitness {bwKey, bwSig, bwChainCode, bwAttributes}
+    pure $ BootstrapWitness {bwKey, bwSignature, bwChainCode, bwAttributes}
 
 instance Arbitrary GenDelegPair where
   arbitrary = GenDelegPair <$> arbitrary <*> arbitrary

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/TreeDiff.hs

@@ -112,7 +112,6 @@ instance ToExpr CostModels
 instance ToExpr (WitVKey kr)
 
 -- Keys/Bootstrap
-instance ToExpr BootstrapWitnessRaw
 instance ToExpr BootstrapWitness
 
 instance ToExpr ChainCode

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs

@@ -285,7 +285,6 @@ import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Text (Text, pack)
-import Data.Typeable (Typeable)
 import qualified Data.VMap as VMap
 import Data.Void (Void, absurd)
 import Data.Word (Word16, Word32, Word64, Word8)
@@ -2876,12 +2875,7 @@ pcWitVKey _p (WitVKey vk@(VKey x) sig) =
     hash = pcKeyHash (hashKey vk)
     sigstring = show sig
 
-instance
-  ( Reflect era
-  , Typeable keyrole
-  ) =>
-  PrettyA (WitVKey keyrole)
-  where
+instance Reflect era => PrettyA (WitVKey keyrole) where
   prettyA = pcWitVKey @era reify
 
 -- =====================================