Remove bytestring from Block type

Author: teodanciu

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -193,7 +193,7 @@ alonzoBbodyTransition =
     >>= \( TRC
             ( BbodyEnv pp account
               , BbodyState ls b
-              , UnserialisedBlock bh txsSeq
+              , Block bh txsSeq
               )
           ) -> do
         let txs = txSeqTxns txsSeq

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs

@@ -278,7 +278,7 @@ conwayBbodyTransition = do
     >>= \( TRC
             ( _
               , state@(BbodyState ls _)
-              , UnserialisedBlock _ txsSeq
+              , Block _ txsSeq
               )
           ) -> do
         let utxo = utxosUtxo (lsUTxOState ls)

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/BbodySpec.hs

@@ -92,7 +92,7 @@ spec = describe "BBODY" $ do
       tryRunImpRule @"BBODY"
         (BbodyEnv pp account)
         (BbodyState ls (BlocksMade Map.empty))
-        (UnsafeUnserialisedBlock bhView txSeq)
+        (Block bhView txSeq)
     predFailures
       `shouldBe` NE.fromList
         [ injectFailure

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs

@@ -179,7 +179,7 @@ bbodyTransition =
     >>= \( TRC
             ( BbodyEnv pp account
               , BbodyState ls b
-              , UnserialisedBlock bhview txsSeq
+              , Block bhview txsSeq
               )
           ) -> do
         let txs = fromTxSeq txsSeq

eras/shelley/test-suite/bench/BenchValidation.hs

@@ -94,7 +94,7 @@ benchValidate ::
   ValidateInput era ->
   IO (NewEpochState era)
 benchValidate (ValidateInput globals state (Block bh txs)) =
-  let block = UnsafeUnserialisedBlock (makeHeaderView bh) txs
+  let block = Block (makeHeaderView bh) txs
    in case API.applyBlockEitherNoEvents ValidateAll globals state block of
         Right x -> pure x
         Left x -> error (show x)
@@ -112,7 +112,7 @@ applyBlock ::
   Int ->
   Int
 applyBlock (ValidateInput globals state (Block bh txs)) n =
-  let block = UnsafeUnserialisedBlock (makeHeaderView bh) txs
+  let block = Block (makeHeaderView bh) txs
    in case API.applyBlockEitherNoEvents ValidateAll globals state block of
         Right x -> seq (rnf x) (n + 1)
         Left x -> error (show x)
@@ -122,7 +122,7 @@ benchreValidate ::
   ValidateInput era ->
   NewEpochState era
 benchreValidate (ValidateInput globals state (Block bh txs)) =
-  API.applyBlockNoValidaton globals state (UnsafeUnserialisedBlock (makeHeaderView bh) txs)
+  API.applyBlockNoValidaton globals state (Block (makeHeaderView bh) txs)
 
 -- ==============================================================
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/LaxBlock.hs

@@ -11,14 +11,7 @@
 
 module Test.Cardano.Ledger.Shelley.LaxBlock where
 
-import Cardano.Ledger.Binary (
-  Annotator (..),
-  DecCBOR (decCBOR),
-  Decoder,
-  ToCBOR,
-  annotatorSlice,
-  decodeRecordNamed,
- )
+import Cardano.Ledger.Binary
 import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Core (Era, EraSegWits (TxSeq), EraTx)
 import Cardano.Ledger.Shelley.BlockChain (ShelleyTxSeq, txSeqDecoder)
@@ -28,7 +21,13 @@ import Data.Typeable (Typeable)
 --   encoding of parts of the segwit.
 --   This is only for testing.
 newtype LaxBlock h era = LaxBlock (Block h era)
-  deriving (ToCBOR)
+
+deriving newtype instance
+  ( Era era
+  , EncCBORGroup (TxSeq era)
+  , EncCBOR h
+  ) =>
+  ToCBOR (LaxBlock h era)
 
 deriving newtype instance
   ( EraSegWits era
@@ -45,11 +44,11 @@ blockDecoder ::
   Bool ->
   forall s.
   Decoder s (Annotator (Block h era))
-blockDecoder lax = annotatorSlice $
+blockDecoder lax =
   decodeRecordNamed "Block" (const 4) $ do
     header <- decCBOR
     txns <- txSeqDecoder lax
-    pure $ Block' <$> header <*> txns
+    pure $ Block <$> header <*> txns
 
 deriving stock instance (Era era, Show (TxSeq era), Show h) => Show (LaxBlock h era)
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs

@@ -581,7 +581,7 @@ withdrawals ::
   EraGen era =>
   Block (BHeader MockCrypto) era ->
   Coin
-withdrawals (UnserialisedBlock _ txseq) =
+withdrawals (Block _ txseq) =
   F.foldl'
     ( \c tx ->
         let wdrls = unWithdrawals $ tx ^. bodyTxL . withdrawalsTxBodyL

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs

@@ -301,7 +301,6 @@ chainTransition ::
   , State (EraRule "TICK" era) ~ NewEpochState era
   , Signal (EraRule "TICK" era) ~ SlotNo
   , Embed (PRTCL MockCrypto) (CHAIN era)
-  , EncCBORGroup (TxSeq era)
   , ProtVerAtMost era 6
   , State (EraRule "LEDGERS" era) ~ LedgerState era
   , EraGov era
@@ -370,10 +369,9 @@ chainTransition =
               , bh
               )
 
-        let thouShaltNot = error "A block with a header view should never be hashed"
         BbodyState ls' bcur' <-
           trans @(EraRule "BBODY" era) $
-            TRC (BbodyEnv pp' account, BbodyState ls bcur, Block' bhView txs thouShaltNot)
+            TRC (BbodyEnv pp' account, BbodyState ls bcur, Block bhView txs)
 
         let nes'' = updateNES nes' bcur' ls'
             bhb = bhbody bh

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs

@@ -137,7 +137,7 @@ relevantCasesAreCoveredForTrace ::
   Property
 relevantCasesAreCoveredForTrace tr = do
   let blockTxs :: Block (BHeader MockCrypto) era -> [Tx era]
-      blockTxs (UnserialisedBlock _ txSeq) = toList (fromTxSeq @era txSeq)
+      blockTxs (Block _ txSeq) = toList (fromTxSeq @era txSeq)
       bs = traceSignals OldestFirst tr
       txs = concat (blockTxs <$> bs)
       certsByTx_ = certsByTx @era txs

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/PoolReap.hs

@@ -80,7 +80,7 @@ tests =
     poolState target = (chainNes target) ^. nesEsL . esLStateL . lsCertStateL . certPStateL
 
     removedAfterPoolreap_ :: SourceSignalTarget (CHAIN era) -> Property
-    removedAfterPoolreap_ (SourceSignalTarget {source, target, signal = (UnserialisedBlock bh _)}) =
+    removedAfterPoolreap_ (SourceSignalTarget {source, target, signal = (Block bh _)}) =
       let e = (epochFromSlotNo . bheaderSlotNo . bhbody) bh
        in removedAfterPoolreap (poolState source) (poolState target) e
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs

@@ -254,7 +254,7 @@ ledgerTraceBase chainSt block =
   , txs
   )
   where
-    (UnserialisedBlock (BHeader bhb _) txSeq) = block
+    (Block (BHeader bhb _) txSeq) = block
     slot = bheaderSlotNo bhb
     tickedChainSt = tickChainState slot chainSt
     nes = (nesEs . chainNes) tickedChainSt

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs

@@ -987,7 +987,7 @@ tests =
        in checkEncodingCBORAnnotated
             shelleyProtVer
             "empty_block"
-            (Block @C bh txns)
+            (Block @(BHeader MockCrypto) @C bh txns)
             ( (T $ TkListLen 4)
                 <> S bh
                 <> T (TkListLen 0 . TkListLen 0 . TkMapLen 0)
@@ -1048,7 +1048,7 @@ tests =
        in checkEncodingCBORAnnotated
             shelleyProtVer
             "rich_block"
-            (Block @C bh txns)
+            (Block @(BHeader MockCrypto) @C bh txns)
             ( (T $ TkListLen 4)
                 -- header
                 <> S bh

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 1.17.0.0
 
+* Replace `Block'` constructor with `Block`
+* Remove patterns: `Block`, `UnserialisedBlock` and `UnsafeUnserialisedBlock`
+* Add ` EncCBORGroup (TxSeq era)` and `EncCBOR h` constraints to `EncCBOR` and `ToCBOR` instances for `Block`
 * 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/Block.hs

@@ -15,7 +15,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Ledger.Block (
-  Block (Block, Block', UnserialisedBlock, UnsafeUnserialisedBlock),
+  Block (Block),
   bheader,
   bbody,
   neededTxInsForBlock,
@@ -27,17 +27,13 @@ import Cardano.Ledger.Binary (
   DecCBOR (decCBOR),
   EncCBOR (..),
   EncCBORGroup (..),
-  annotatorSlice,
   decodeRecordNamed,
   encodeListLen,
-  serialize,
+  toPlainEncoding,
  )
 import qualified Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Core
-import Cardano.Ledger.MemoBytes (MemoBytes (Memo), decodeMemoized)
 import Cardano.Ledger.TxIn (TxIn (..))
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString.Short as SBS
 import Data.Foldable (toList)
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -47,7 +43,7 @@ import Lens.Micro ((^.))
 import NoThunks.Class (NoThunks (..))
 
 data Block h era
-  = Block' !h !(TxSeq era) BSL.ByteString
+  = Block !h !(TxSeq era)
   deriving (Generic)
 
 deriving stock instance
@@ -65,111 +61,63 @@ deriving anyclass instance
   ) =>
   NoThunks (Block h era)
 
-pattern Block ::
+instance
   forall era h.
   ( Era era
   , EncCBORGroup (TxSeq era)
   , EncCBOR h
   ) =>
-  h ->
-  TxSeq era ->
-  Block h era
-pattern Block h txns <-
-  Block' h txns _
-  where
-    Block h txns =
-      let bytes =
-            serialize (eraProtVerLow @era) $
-              encodeListLen (1 + listLen txns) <> encCBOR h <> encCBORGroup txns
-       in Block' h txns bytes
-
-{-# COMPLETE Block #-}
-
--- | Access a block without its serialised bytes. This is often useful when
--- we're using a 'BHeaderView' in place of the concrete header.
-pattern UnserialisedBlock ::
-  h ->
-  TxSeq era ->
-  Block h era
-pattern UnserialisedBlock h txns <- Block' h txns _
-
-{-# COMPLETE UnserialisedBlock #-}
-
--- | Unsafely construct a block without the ability to serialise its bytes.
---
---   Anyone calling this pattern must ensure that the resulting block is never
---   serialised. Any uses of this pattern outside of testing code should be
---   regarded with suspicion.
-pattern UnsafeUnserialisedBlock ::
-  h ->
-  TxSeq era ->
-  Block h era
-pattern UnsafeUnserialisedBlock h txns <-
-  Block' h txns _
+  EncCBOR (Block h era)
   where
-    UnsafeUnserialisedBlock h txns =
-      let bytes = error "`UnsafeUnserialisedBlock` used to construct a block which was later serialised."
-       in Block' h txns bytes
-
-{-# COMPLETE UnsafeUnserialisedBlock #-}
-
-instance (EraTx era, Typeable h) => EncCBOR (Block h era)
-
-instance (EraTx era, Typeable h) => Plain.ToCBOR (Block h era) where
-  toCBOR (Block' _ _ blockBytes) = Plain.encodePreEncoded $ BSL.toStrict blockBytes
+  encCBOR (Block h txns) =
+    encodeListLen (1 + listLen txns) <> encCBOR h <> encCBORGroup txns
 
 instance
-  ( EraSegWits era
-  , DecCBOR (Annotator h)
-  , Typeable h
+  forall era h.
+  ( Era era
+  , EncCBORGroup (TxSeq era)
+  , EncCBOR h
   ) =>
-  DecCBOR (Annotator (Block h era))
+  Plain.ToCBOR (Block h era)
   where
-  decCBOR = annotatorSlice $
-    decodeRecordNamed "Block" (const blockSize) $ do
-      header <- decCBOR
-      txns <- decCBOR
-      pure $ Block' <$> header <*> txns
-    where
-      blockSize =
-        1 -- header
-          + fromIntegral (numSegComponents @era)
-
-data BlockRaw h era = BlockRaw !h !(TxSeq era)
+  toCBOR = toPlainEncoding (eraProtVerLow @era) . encCBOR
 
 instance
   ( EraSegWits era
   , DecCBOR h
   , DecCBOR (TxSeq era)
   ) =>
-  DecCBOR (BlockRaw h era)
+  DecCBOR (Block h era)
   where
   decCBOR =
     decodeRecordNamed "Block" (const blockSize) $ do
       header <- decCBOR
       txns <- decCBOR
-      pure $ BlockRaw header txns
+      pure $ Block header txns
     where
       blockSize = 1 + fromIntegral (numSegComponents @era)
 
 instance
   ( EraSegWits era
-  , DecCBOR h
-  , DecCBOR (TxSeq era)
+  , DecCBOR (Annotator h)
+  , Typeable h
   ) =>
-  DecCBOR (Block h era)
+  DecCBOR (Annotator (Block h era))
   where
-  decCBOR = do
-    Memo (BlockRaw h txSeq) bs <- decodeMemoized (decCBOR @(BlockRaw h era))
-    pure $ Block' h txSeq (BSL.fromStrict (SBS.fromShort bs))
+  decCBOR = decodeRecordNamed "Block" (const blockSize) $ do
+    header <- decCBOR
+    txns <- decCBOR
+    pure $ Block <$> header <*> txns
+    where
+      blockSize = 1 + fromIntegral (numSegComponents @era)
 
 bheader ::
   Block h era ->
   h
-bheader (Block' bh _ _) = bh
+bheader (Block bh _) = bh
 
 bbody :: Block h era -> TxSeq era
-bbody (Block' _ txs _) = txs
+bbody (Block _ txs) = txs
 
 -- | The validity of any individual block depends only on a subset
 -- of the UTxO stored in the ledger state. This function returns
@@ -185,7 +133,7 @@ neededTxInsForBlock ::
   EraSegWits era =>
   Block h era ->
   Set TxIn
-neededTxInsForBlock (Block' _ txsSeq _) = Set.filter isNotNewInput allTxIns
+neededTxInsForBlock (Block _ txsSeq) = Set.filter isNotNewInput allTxIns
   where
     txBodies = map (^. bodyTxL) $ toList $ fromTxSeq txsSeq
     allTxIns = Set.unions $ map (^. allInputsTxBodyF) txBodies

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs

@@ -705,7 +705,7 @@ coldKeys = KeyPair vk sk
 
 makeNaiveBlock ::
   forall era. EraSegWits era => [Tx era] -> Block BHeaderView era
-makeNaiveBlock txs = UnsafeUnserialisedBlock bhView txSeq
+makeNaiveBlock txs = Block bhView txSeq
   where
     bhView =
       BHeaderView

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

@@ -247,7 +247,7 @@ instance
   Same era (ShelleyLedgerExamples era)
   where
   same proof x1 x2 = case (sleBlock x1, sleBlock x2) of
-    (Block' h1 a1 _, Block' h2 a2 _) ->
+    (Block h1 a1, Block h2 a2) ->
       sameWithDependency
         [ SomeM "Tx" (sameTx proof) (sleTx x1) (sleTx x2)
         , SomeM "TxSeq" (sameTxSeq proof) a1 a2