Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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 ==
Expand Down
4 changes: 4 additions & 0 deletions eras/dijkstra/impl/cardano-ledger-dijkstra.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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},
Expand Down Expand Up @@ -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,
Expand Down
12 changes: 10 additions & 2 deletions eras/dijkstra/impl/cddl/data/dijkstra.cddl
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down Expand Up @@ -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
Comment thread
ch1bo marked this conversation as resolved.

Original file line number Diff line number Diff line change
Expand Up @@ -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 (
Expand All @@ -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 ((/))

Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Comment thread
ch1bo marked this conversation as resolved.
-- 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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
Expand Down Expand Up @@ -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 (..),
Expand All @@ -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)
Expand Down Expand Up @@ -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

Expand All @@ -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)
Expand All @@ -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 #-}

Expand All @@ -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
Expand All @@ -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 ->
Expand All @@ -214,7 +235,8 @@ instance
pure $
DijkstraBlockBodyRaw
<$> sequenceA (StrictSeq.forceToStrict txsWithIsValid)
<*> pure perasCert
<*> pure mbLeiosCert
<*> pure mbPerasCert

deriving via
Mem (DijkstraBlockBodyRaw era)
Expand All @@ -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

--------------------------------------------------------------------------------
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()

Expand All @@ -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
Expand Down
Loading