Merge pull request #5872 from IntersectMBO/ch1bo/cardano-crypto-leios

Add LeiosCert to DijkstraBlockBody

Author: ch1bo

cabal.project

@@ -28,7 +28,7 @@ source-repository-package
 -- see CONTRIBUTING.md#to-update-the-referenced-agda-ledger-spec
 index-state:
   , hackage.haskell.org 2026-05-26T19:31:06Z
-  , cardano-haskell-packages 2026-05-26T09:41:58Z
+  , cardano-haskell-packages 2026-06-29T12:05:19Z
 
 packages:
   -- == Byron era ==

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

@@ -107,6 +107,7 @@ library
     bytestring,
     cardano-base >=0.1.4,
     cardano-crypto-class,
+    cardano-crypto-leios >=0.1,
     cardano-data ^>=1.3,
     cardano-ledger-allegra,
     cardano-ledger-alonzo ^>=1.16,
@@ -178,6 +179,8 @@ library testlib
     base,
     bytestring,
     cardano-base,
+    cardano-crypto-class,
+    cardano-crypto-leios:{cardano-crypto-leios, testlib},
     cardano-data,
     cardano-ledger-allegra:{cardano-ledger-allegra, testlib},
     cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
@@ -215,6 +218,7 @@ library cddl
   build-depends:
     antigen,
     base,
+    cardano-crypto-leios:{cardano-crypto-leios, testlib},
     cardano-ledger-conway:cddl,
     cardano-ledger-core:cddl,
     cardano-ledger-dijkstra,

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

@@ -97,7 +97,8 @@ major_protocol_version = 0 .. 13
 block_body =
   [ invalid_transactions : invalid_transactions/ nil
   , transactions      : [* transaction]
-  , peras_certificate : peras_certificate
+  , leios_certificate : leios_certificate/ nil
+  , peras_certificate : peras_certificate/ nil
   ]
 
 invalid_transactions = nonempty_set<transaction_index>
@@ -888,5 +889,12 @@ auxiliary_data_map =
     }
   )
 
-peras_certificate = bytes/ nil
+leios_certificate =
+  [ signers              : bytes           ;bitfield
+  , aggregated_signature : leios_signature
+  ]
+
+leios_signature = bytes .size 48
+
+peras_certificate = bytes
 

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

@@ -32,6 +32,7 @@ module Cardano.Ledger.Dijkstra.HuddleSpec (
   auxiliaryDataMapRule,
 ) where
 
+import Cardano.Crypto.Leios (leiosSignatureSize, leiosSignatureToBytes)
 import Cardano.Ledger.Conway.HuddleSpec hiding ()
 import Cardano.Ledger.Dijkstra (DijkstraEra)
 import Cardano.Ledger.Huddle.Gen (
@@ -54,13 +55,15 @@ import Cardano.Ledger.Huddle.Gen qualified as Gen
 import Codec.CBOR.Term (Term (..))
 import Control.Monad (unless, zipWithM)
 import Data.Foldable (traverse_)
+import Data.Function ((&))
 import Data.List (nub)
 import Data.Maybe (mapMaybe)
 import Data.Proxy (Proxy (..))
 import Data.Text ()
 import Data.Text qualified as T
 import Data.Word (Word16, Word64)
 import Test.AntiGen (withAnnotation, (|!))
+import Test.Cardano.Crypto.Leios.Gen (genLeiosSignature)
 import Text.Heredoc
 import Prelude hiding ((/))
 
@@ -956,7 +959,24 @@ instance HuddleRule "block" DijkstraEra where
         ]
 
 instance HuddleRule "peras_certificate" DijkstraEra where
-  huddleRuleNamed pname _era = pname =.= VBytes / VNil
+  huddleRuleNamed pname _era = pname =.= VBytes
+
+instance HuddleRule "leios_certificate" DijkstraEra where
+  huddleRuleNamed pname era =
+    pname
+      =.= arr
+        [ "signers" ==> VBytes & comment "bitfield"
+        , "aggregated_signature" ==> huddleRule @"leios_signature" era
+        ]
+
+instance HuddleRule "leios_signature" DijkstraEra where
+  huddleRuleNamed pname _era =
+    withCBORGen leiosSignatureGen $
+      pname =.= VBytes `sized` leiosSignatureSize
+    where
+      leiosSignatureGen = do
+        sig <- liftGen genLeiosSignature
+        pure $ SingleTerm $ TBytes (leiosSignatureToBytes sig)
 
 instance HuddleRule "invalid_transactions" DijkstraEra where
   huddleRuleNamed pname era = pname =.= huddleRule1 @"nonempty_set" era (huddleRule @"transaction_index" era)
@@ -971,7 +991,8 @@ instance HuddleRule "block_body" DijkstraEra where
         =.= arr
           [ "invalid_transactions" ==> huddleRule @"invalid_transactions" era / VNil
           , "transactions" ==> arr [0 <+ a (huddleRule @"transaction" era)]
-          , "peras_certificate" ==> huddleRule @"peras_certificate" era
+          , "leios_certificate" ==> huddleRule @"leios_certificate" era / VNil
+          , "peras_certificate" ==> huddleRule @"peras_certificate" era / VNil
           ]
 
 blockBodyGen :: CBORGen RuleTerm
@@ -1008,8 +1029,11 @@ blockBodyGen = do
       then pure TNull
       else genArrayTerm $ TInteger . toInteger <$> invalidIxIxs
   txsTerm <- withAntiGen (withAnnotation "transactions") $ genArrayTerm txs
+  -- NOTE: This would not be a valid block because txs are not allowed when a
+  -- leios cert is also included
+  leiosCertTerm <- generateFromName "leios_certificate"
   perasCertTerm <- generateFromName "peras_certificate"
-  SingleTerm <$> genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm]
+  SingleTerm <$> genArrayTerm [invalidTxIxsTerm, txsTerm, leiosCertTerm, perasCertTerm]
 
 instance HuddleRule "auxiliary_scripts" DijkstraEra where
   huddleRuleNamed = auxiliaryScriptsRule

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -38,8 +37,9 @@ module Cardano.Ledger.Dijkstra.BlockBody.Internal (
   validatePerasCert,
 ) where
 
+import Cardano.Crypto.Leios (LeiosCert)
 import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
-import Cardano.Ledger.BaseTypes (Nonce, ProtVer (..), maybeToStrictMaybe)
+import Cardano.Ledger.BaseTypes (Nonce, ProtVer (..))
 import Cardano.Ledger.Binary (
   Annotator (..),
   DecCBOR (..),
@@ -52,9 +52,11 @@ import Cardano.Ledger.Binary (
   decodeSeq,
   encCBOR,
   encodeListLen,
+  encodeNullMaybe,
   encodeNullStrictMaybe,
   serialize',
  )
+import Cardano.Ledger.Binary.Crypto (decodeLeiosCert, encodeLeiosCert)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra.Era
 import Cardano.Ledger.Dijkstra.Tx (DijkstraTx, Tx (..), decodeDijkstraTopTx)
@@ -100,12 +102,16 @@ import NoThunks.Class (NoThunks)
 
 data DijkstraBlockBodyRaw era = DijkstraBlockBodyRaw
   { dbbrTxs :: !(StrictSeq (Tx TopTx era))
+  , dbbrLeiosCert :: !(StrictMaybe LeiosCert)
+  -- ^ Optional Leios certificate
   , dbbrPerasCert :: !(StrictMaybe PerasCert)
   -- ^ Optional Peras certificate
   }
   deriving (Generic)
 
-instance (NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBodyRaw era)
+instance
+  (NFData (Tx TopTx era), NFData LeiosCert, NFData PerasCert) =>
+  NFData (DijkstraBlockBodyRaw era)
 
 type instance MemoHashIndex (DijkstraBlockBodyRaw era) = EraIndependentBlockBody
 
@@ -118,15 +124,22 @@ instance EraBlockBody DijkstraEra where
   blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBOR
 
 mkBasicBlockBodyDijkstra :: forall era. AlonzoEraTx era => DijkstraBlockBody era
-mkBasicBlockBodyDijkstra = mkMemoized (eraProtVerLow @era) $ DijkstraBlockBodyRaw mempty SNothing
+mkBasicBlockBodyDijkstra =
+  mkMemoized (eraProtVerLow @era) $
+    DijkstraBlockBodyRaw mempty SNothing SNothing
 {-# INLINEABLE mkBasicBlockBodyDijkstra #-}
 
 -- | Dijkstra-specific extensions to 'EraBlockBody'
 class EraBlockBody era => DijkstraEraBlockBody era where
+  leiosCertBlockBodyL :: Lens' (BlockBody era) (StrictMaybe LeiosCert)
+  -- ^ Lens to access the optional Leios certificate in the block body
+
   perasCertBlockBodyL :: Lens' (BlockBody era) (StrictMaybe PerasCert)
   -- ^ Lens to access the optional Peras certificate in the block body
 
 instance DijkstraEraBlockBody DijkstraEra where
+  leiosCertBlockBodyL = lensMemoRawType @DijkstraEra dbbrLeiosCert (\bb c -> bb {dbbrLeiosCert = c})
+
   perasCertBlockBodyL = lensMemoRawType @DijkstraEra dbbrPerasCert (\bb c -> bb {dbbrPerasCert = c})
 
 deriving instance (Typeable era, NoThunks (Tx TopTx era)) => NoThunks (DijkstraBlockBodyRaw era)
@@ -153,13 +166,17 @@ instance Memoized (DijkstraBlockBody era) where
 pattern DijkstraBlockBody ::
   AlonzoEraTx era =>
   StrictSeq (Tx TopTx era) ->
+  StrictMaybe LeiosCert ->
   StrictMaybe PerasCert ->
   DijkstraBlockBody era
-pattern DijkstraBlockBody txs perasCert <- (getMemoRawType -> DijkstraBlockBodyRaw txs perasCert)
+pattern DijkstraBlockBody txs mbLeiosCert mbPerasCert <-
+  ( getMemoRawType ->
+      DijkstraBlockBodyRaw txs mbLeiosCert mbPerasCert
+    )
   where
-    DijkstraBlockBody txs perasCert =
+    DijkstraBlockBody txs leiosCert perasCert =
       mkMemoizedEra @DijkstraEra $
-        DijkstraBlockBodyRaw txs perasCert
+        DijkstraBlockBodyRaw txs leiosCert perasCert
 
 {-# COMPLETE DijkstraBlockBody #-}
 
@@ -173,14 +190,15 @@ instance
   ) =>
   EncCBOR (DijkstraBlockBodyRaw era)
   where
-  encCBOR (DijkstraBlockBodyRaw txs perasCert) =
-    encodeListLen 3
-      <> encodeNullStrictMaybe encCBOR invalidIndices
+  encCBOR (DijkstraBlockBodyRaw txs mbLeiosCert mbPerasCert) =
+    encodeListLen 4
+      <> encodeNullMaybe encCBOR invalidIndices
       <> encCBOR txs
-      <> encodeNullStrictMaybe encCBOR perasCert
+      <> encodeNullStrictMaybe encodeLeiosCert mbLeiosCert
+      <> encodeNullStrictMaybe encCBOR mbPerasCert
     where
       invalidIndices =
-        maybeToStrictMaybe . NonEmptySet.fromFoldable $
+        NonEmptySet.fromFoldable $
           StrictSeq.findIndicesL (\tx -> tx ^. isValidTxL == IsValid False) txs
 
 instance
@@ -192,16 +210,19 @@ instance
   ) =>
   DecCBOR (Annotator (DijkstraBlockBodyRaw era))
   where
-  decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 3) $ do
+  decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 4) $ do
     let
       decodeInvalidTxs =
         decodeNonEmptySetLikeEnforceNoDuplicates
           (IntSet.insert . fromIntegral @Word16 @Int)
           (\x -> (IntSet.size x, x))
           (decCBOR @Word16)
+
     invalidTxs :: IntSet <- fold <$> decodeNullMaybe decodeInvalidTxs
     txs <- decodeSeq (decodeDijkstraTopTx @era False)
-    perasCert <- decodeNullStrictMaybe decCBOR
+    mbLeiosCert <- decodeNullStrictMaybe decodeLeiosCert
+    mbPerasCert <- decodeNullStrictMaybe decCBOR
+
     let txsLength = Seq.length txs
         inRange x = 0 <= x && x < txsLength
     forM_ (IntSet.toList invalidTxs) $ \i ->
@@ -214,7 +235,8 @@ instance
     pure $
       DijkstraBlockBodyRaw
         <$> sequenceA (StrictSeq.forceToStrict txsWithIsValid)
-        <*> pure perasCert
+        <*> pure mbLeiosCert
+        <*> pure mbPerasCert
 
 deriving via
   Mem (DijkstraBlockBodyRaw era)
@@ -228,8 +250,16 @@ deriving via
     DecCBOR (Annotator (DijkstraBlockBody era))
 
 instance (AlonzoEraTx era, EncCBOR (Tx TopTx era)) => EncCBORGroup (DijkstraBlockBody era) where
-  encCBORGroup (DijkstraBlockBody txs perasCert) = do
-    encodeListLen 2 <> encCBOR txs <> encCBOR perasCert
+  encCBORGroup (DijkstraBlockBody txs mbLeiosCert mbPerasCert) = do
+    encodeListLen 4
+      <> encodeNullMaybe encCBOR invalidIndices
+      <> encCBOR txs
+      <> encodeNullStrictMaybe encodeLeiosCert mbLeiosCert
+      <> encodeNullStrictMaybe encCBOR mbPerasCert
+    where
+      invalidIndices =
+        NonEmptySet.fromFoldable $
+          StrictSeq.findIndicesL (\tx -> tx ^. isValidTxL == IsValid False) txs
   listLen _ = 1
 
 --------------------------------------------------------------------------------

eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/Binary/CddlSpec.hs

@@ -37,7 +37,8 @@ import Test.Cardano.Ledger.Core.Binary (
  )
 import Test.Cardano.Ledger.Dijkstra.Arbitrary (
   genNonEmptyAccountBalanceIntervals,
-  genSmallDijkstraBlockBody,
+  genSmallDijkstraCertBlockBody,
+  genSmallDijkstraTxsBlockBody,
  )
 import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
 
@@ -46,7 +47,10 @@ spec = do
   describe "CDDL" $ do
     let v = eraProtVerHigh @DijkstraEra
     describe "Huddle" $ specWithHuddle dijkstraCDDL . noTwiddle $ do
-      fullAnnGenCddlSpec @(BlockBody DijkstraEra) genSmallDijkstraBlockBody v "block_body"
+      describe "TxsRB" $
+        fullAnnGenCddlSpec @(BlockBody DijkstraEra) genSmallDijkstraTxsBlockBody v "block_body"
+      describe "CertRB" $
+        fullAnnGenCddlSpec @(BlockBody DijkstraEra) genSmallDijkstraCertBlockBody v "block_body"
       fullCddlSpec @(AccountBalanceInterval DijkstraEra) v "account_balance_interval"
       fullGenCddlSpec @(AccountBalanceIntervals DijkstraEra)
         genNonEmptyAccountBalanceIntervals