Merge pull request #5733 from IntersectMBO/jj/block-serialization

Dijkstra era CDDL for `block`, add `block_body`

Author: lehins

eras/allegra/impl/src/Cardano/Ledger/Allegra/BlockBody.hs

@@ -11,17 +11,21 @@ module Cardano.Ledger.Allegra.BlockBody () where
 
 import Cardano.Ledger.Allegra.Era (AllegraEra)
 import Cardano.Ledger.Allegra.Tx ()
+import Cardano.Ledger.BaseTypes (ProtVer (..))
+import Cardano.Ledger.Binary (EncCBORGroup (..), serialize')
 import Cardano.Ledger.Core (EraBlockBody (..))
 import Cardano.Ledger.Shelley.BlockBody (
   ShelleyBlockBody,
   mkBasicBlockBodyShelley,
   shelleyBlockBodyHash,
   txSeqBlockBodyShelleyL,
  )
+import qualified Data.ByteString as BS
 
 instance EraBlockBody AllegraEra where
   type BlockBody AllegraEra = ShelleyBlockBody AllegraEra
   mkBasicBlockBody = mkBasicBlockBodyShelley
   txSeqBlockBodyL = txSeqBlockBodyShelleyL
   hashBlockBody = shelleyBlockBodyHash
   numSegComponents = 3
+  blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBORGroup

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

@@ -34,6 +34,7 @@ module Cardano.Ledger.Alonzo.BlockBody.Internal (
 import qualified Cardano.Crypto.Hash as Hash
 import Cardano.Ledger.Alonzo.Era
 import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
+import Cardano.Ledger.BaseTypes (ProtVer (..))
 import Cardano.Ledger.Binary (
   Annotator (..),
   DecCBOR (..),
@@ -43,13 +44,15 @@ import Cardano.Ledger.Binary (
   encodeFoldableMapEncoder,
   encodePreEncoded,
   serialize,
+  serialize',
   withSlice,
  )
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.BlockBody (auxDataSeqDecoder)
 import Control.DeepSeq (NFData)
 import Control.Monad (unless)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Coerce (coerce)
@@ -97,6 +100,7 @@ instance EraBlockBody AlonzoEra where
   txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = abbHash
   numSegComponents = 4
+  blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBORGroup
 
 mkBasicBlockBodyAlonzo ::
   ( SafeToHash (TxWits era)

eras/babbage/impl/src/Cardano/Ledger/Babbage/BlockBody.hs

@@ -6,11 +6,15 @@ module Cardano.Ledger.Babbage.BlockBody where
 import Cardano.Ledger.Alonzo.BlockBody
 import Cardano.Ledger.Babbage.Era
 import Cardano.Ledger.Babbage.Tx ()
+import Cardano.Ledger.BaseTypes (ProtVer (..))
+import Cardano.Ledger.Binary (EncCBORGroup (..), serialize')
 import Cardano.Ledger.Core
+import qualified Data.ByteString as BS
 
 instance EraBlockBody BabbageEra where
   type BlockBody BabbageEra = AlonzoBlockBody BabbageEra
   mkBasicBlockBody = mkBasicBlockBodyAlonzo
   txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = alonzoBlockBodyHash
   numSegComponents = 4
+  blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBORGroup

eras/conway/impl/cardano-ledger-conway.cabal

@@ -104,6 +104,7 @@ library
   build-depends:
     aeson >=2.2,
     base >=4.18 && <5,
+    bytestring,
     cardano-crypto-class,
     cardano-data >=1.3,
     cardano-ledger-allegra ^>=1.10,

eras/conway/impl/src/Cardano/Ledger/Conway/BlockBody.hs

@@ -4,13 +4,17 @@
 module Cardano.Ledger.Conway.BlockBody where
 
 import Cardano.Ledger.Alonzo.BlockBody
+import Cardano.Ledger.BaseTypes (ProtVer (..))
+import Cardano.Ledger.Binary (EncCBORGroup (..), serialize')
 import Cardano.Ledger.Conway.Era
 import Cardano.Ledger.Conway.Tx ()
 import Cardano.Ledger.Core
+import qualified Data.ByteString as BS
 
 instance EraBlockBody ConwayEra where
   type BlockBody ConwayEra = AlonzoBlockBody ConwayEra
   mkBasicBlockBody = mkBasicBlockBodyAlonzo
   txSeqBlockBodyL = txSeqBlockBodyAlonzoL
   hashBlockBody = alonzoBlockBodyHash
   numSegComponents = 4
+  blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBORGroup

eras/dijkstra/impl/CHANGELOG.md

@@ -15,6 +15,9 @@
 * Add `getDijkstraScriptsProvided`
 * Add `MissingRequiredGuards` constructor to `DijkstraUtxowPredFailure`
 * Add `DijkstraUtxoEnv` and use it as `Environemnt` in `STS` instance of `UTXOW`
+* Refactor `DijkstraBlockBody` to use `MemoBytes` for memoized serialization
+* Add `blockBodySize` implementation for `DijkstraEra`
+* Add `DijkstraBlockBodyRaw`, `MkDijkstraBlockBody`
 * Add `ApplyTick` instance for `DijkstraEra`
 * Add `WrongNetworkInDirectDeposit` constructor to `DijkstraUtxoPredFailure`
 * Add `SubWrongNetworkInDirectDeposit` constructor to `DijkstraSubUtxoPredFailure`
@@ -51,8 +54,14 @@
 * Remove `NoThunks` instance for `DijkstraContextError`
 * Make `DijkstraContextError` constructors lazy
 
+### cddl
+
+* Add `peras_certificate`, `block_body`
+
 ### testlib
 
+* Add `ToExpr` instance for `DijkstraBlockBody`
+* Add `DecCBOR` instance for `DijkstraBlockBodyRaw`
 * Add `genNonEmptyAccountBalanceIntervals`
 * In `Test.Cardano.Ledger.Dijkstra.Examples`:
   - Remove `mkDijkstraBasedExampleTx`, `mkDijkstraBasedExampleTxBody`

eras/dijkstra/impl/cardano-ledger-dijkstra.cabal

@@ -30,6 +30,7 @@ library
   exposed-modules:
     Cardano.Ledger.Dijkstra
     Cardano.Ledger.Dijkstra.BlockBody
+    Cardano.Ledger.Dijkstra.BlockBody.Internal
     Cardano.Ledger.Dijkstra.Core
     Cardano.Ledger.Dijkstra.Era
     Cardano.Ledger.Dijkstra.Genesis
@@ -49,7 +50,6 @@ library
     Cardano.Ledger.Dijkstra.UTxO
 
   other-modules:
-    Cardano.Ledger.Dijkstra.BlockBody.Internal
     Cardano.Ledger.Dijkstra.Forecast
     Cardano.Ledger.Dijkstra.Rules.Bbody
     Cardano.Ledger.Dijkstra.Rules.Cert
@@ -111,7 +111,7 @@ library
     cardano-ledger-babbage ^>=1.14,
     cardano-ledger-binary ^>=1.9,
     cardano-ledger-conway ^>=1.23,
-    cardano-ledger-core:{cardano-ledger-core, internal} >=1.20,
+    cardano-ledger-core:{cardano-ledger-core, internal} >=1.21,
     cardano-ledger-mary,
     cardano-ledger-shelley,
     cardano-slotting,
@@ -210,10 +210,16 @@ library cddl
     -Wunused-packages
 
   build-depends:
+    QuickCheck,
+    antigen,
     base,
     cardano-ledger-conway:cddl,
+    cardano-ledger-core:cddl,
     cardano-ledger-dijkstra,
+    cborg,
+    cuddle,
     heredoc,
+    quickcheck-transformer,
     text,
 
 executable generate-cddl

eras/dijkstra/impl/cddl/data/dijkstra.cddl

@@ -1,18 +1,6 @@
 ; This file was auto-generated using generate-cddl. Please do not modify it directly!
 
-; Valid blocks must also satisfy the following two constraints:
-;   1) the length of transaction_bodies and transaction_witness_sets must be
-;      the same
-;   2) every transaction_index must be strictly smaller than the length of
-;      transaction_bodies
-block = 
-  [ header                 
-  , transaction_bodies       : [* transaction_body]                   
-  , transaction_witness_sets : [* transaction_witness_set]            
-  , auxiliary_data_set       : {* transaction_index => auxiliary_data}
-  , invalid_transactions     : [* transaction_index]                  
-  ]
-
+block = [header, block_body]
 
 transaction = 
   [  transaction_body, transaction_witness_set, true, auxiliary_data/ nil
@@ -99,6 +87,20 @@ protocol_version = [major_protocol_version, uint .size 4]
 
 major_protocol_version = 0 .. 13
 
+; Note that every transaction_index must be strictly smaller than the length of transaction_bodies
+block_body = 
+  [ invalid_transactions : invalid_transactions/ nil
+  , transactions      : [* transaction]
+  , peras_certificate : peras_certificate  
+  ]
+
+
+invalid_transactions = nonempty_set<transaction_index>
+
+nonempty_set<a0> = #6.258([+ a0])/ [+ a0]
+
+transaction_index = uint .size 2
+
 transaction_body = 
   {   0  : set<transaction_input>         
   ,   1  : [* transaction_output]      
@@ -504,8 +506,6 @@ positive_int64 = 1 .. max_int64
 ; representation for empty redeemers.
 script_data_hash = hash32
 
-nonempty_set<a0> = #6.258([+ a0])/ [+ a0]
-
 guards = nonempty_set<addr_keyhash>/ nonempty_oset<credential>
 
 network_id = 0/ 1
@@ -783,5 +783,5 @@ auxiliary_data_map =
   )
 
 
-transaction_index = uint .size 2
+peras_certificate = bytes/ nil
 

eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs

@@ -34,9 +34,19 @@ module Cardano.Ledger.Dijkstra.HuddleSpec (
 
 import Cardano.Ledger.Conway.HuddleSpec hiding ()
 import Cardano.Ledger.Dijkstra (DijkstraEra)
+import Cardano.Ledger.Huddle.Gen (genArrayTerm)
+import Codec.CBOR.Cuddle.CBOR.Gen (generateFromName)
+import Codec.CBOR.Cuddle.CDDL.CBORGenerator (CBORGen, WrappedTerm (..), liftAntiGen, withAntiGen)
+import Codec.CBOR.Term (Term (..))
+import Control.Monad (zipWithM)
 import Data.Proxy (Proxy (..))
 import Data.Text ()
-import Data.Word (Word64)
+import Data.Text qualified as T
+import Data.Word (Word16, Word64)
+import Test.AntiGen (withAnnotation, (|!))
+import Test.QuickCheck (choose, shuffle)
+import Test.QuickCheck qualified as QC
+import Test.QuickCheck.GenT (liftGen)
 import Text.Heredoc
 import Prelude hiding ((/))
 
@@ -854,27 +864,62 @@ instance HuddleRule "header" DijkstraEra where
 
 instance HuddleRule "block" DijkstraEra where
   huddleRuleNamed pname p =
+    pname
+      =.= arr
+        [ a $ huddleRule @"header" p
+        , a $ huddleRule @"block_body" p
+        ]
+
+instance HuddleRule "peras_certificate" DijkstraEra where
+  huddleRuleNamed pname _era = pname =.= VBytes / VNil
+
+instance HuddleRule "invalid_transactions" DijkstraEra where
+  huddleRuleNamed pname era = pname =.= huddleRule1 @"nonempty_set" era (huddleRule @"transaction_index" era)
+
+instance HuddleRule "block_body" DijkstraEra where
+  huddleRuleNamed pname era =
     comment
-      [str|Valid blocks must also satisfy the following two constraints:
-          |  1) the length of transaction_bodies and transaction_witness_sets must be
-          |     the same
-          |  2) every transaction_index must be strictly smaller than the length of
-          |     transaction_bodies
+      [str|Note that every transaction_index must be strictly smaller than the length of transaction_bodies
           |]
+      $ withCBORGen blockBodyGen
       $ pname
         =.= arr
-          [ a $ huddleRule @"header" p
-          , "transaction_bodies" ==> arr [0 <+ a (huddleRule @"transaction_body" p)]
-          , "transaction_witness_sets" ==> arr [0 <+ a (huddleRule @"transaction_witness_set" p)]
-          , "auxiliary_data_set"
-              ==> mp
-                [ 0
-                    <+ asKey (huddleRule @"transaction_index" p)
-                    ==> huddleRule @"auxiliary_data" p
-                ]
-          , "invalid_transactions" ==> arr [0 <+ a (huddleRule @"transaction_index" p)]
+          [ "invalid_transactions" ==> huddleRule @"invalid_transactions" era / VNil
+          , "transactions" ==> arr [0 <+ a (huddleRule @"transaction" era)]
+          , "peras_certificate" ==> huddleRule @"peras_certificate" era
           ]
 
+blockBodyGen :: CBORGen WrappedTerm
+blockBodyGen = do
+  numTxs <- liftGen . QC.sized $ \s -> choose (0 :: Int, s)
+  txs <-
+    mapM
+      (\i -> withAntiGen (withAnnotation (T.pack $ show i)) $ generateFromName "transaction")
+      [0 .. numTxs - 1]
+  invalidIxIxs <-
+    if numTxs == 0
+      then pure []
+      else do
+        n <-
+          liftAntiGen $
+            choose (0, numTxs) |! choose (numTxs + 1, 2 * numTxs)
+        txIndices <- liftGen $ shuffle [0 .. toInteger numTxs - 1]
+        -- We need this so that a zapped `n` still produces indices
+        txIndicesOverflow <- liftGen $ shuffle txIndices
+        let
+          txIndicesWithOverflow = take n $ txIndices <> txIndicesOverflow
+          faultyIndex pos i =
+            withAnnotation (T.pack $ show pos) $
+              pure i
+                |! choose (toInteger numTxs + 1, toInteger $ maxBound @Word16)
+        liftAntiGen $
+          withAnnotation "invalid_transactions" $
+            zipWithM faultyIndex [0 :: Int ..] txIndicesWithOverflow
+  invalidTxIxsTerm <- genArrayTerm $ TInteger . toInteger <$> invalidIxIxs
+  txsTerm <- withAntiGen (withAnnotation "transactions") $ genArrayTerm txs
+  perasCertTerm <- generateFromName "peras_certificate"
+  S <$> liftGen (genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm])
+
 instance HuddleRule "auxiliary_scripts" DijkstraEra where
   huddleRuleNamed = auxiliaryScriptsRule