diff --git a/cabal.project b/cabal.project index 66401f165f0..0c978194598 100644 --- a/cabal.project +++ b/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 == diff --git a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal index 7f2e405cf16..bf9119959e8 100644 --- a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal +++ b/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, diff --git a/eras/dijkstra/impl/cddl/data/dijkstra.cddl b/eras/dijkstra/impl/cddl/data/dijkstra.cddl index d4c2b63b5af..9a44a456d41 100644 --- a/eras/dijkstra/impl/cddl/data/dijkstra.cddl +++ b/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 @@ -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 diff --git a/eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs b/eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs index 40967440823..753b756917c 100644 --- a/eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs +++ b/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,6 +55,7 @@ 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 (..)) @@ -61,6 +63,7 @@ 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 diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs index 945172694b0..4813913a601 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/BlockBody/Internal.hs +++ b/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 -------------------------------------------------------------------------------- diff --git a/eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/Binary/CddlSpec.hs b/eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/Binary/CddlSpec.hs index ff350cf3e24..29fe2437c3c 100644 --- a/eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/Binary/CddlSpec.hs +++ b/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 diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs index 8ddab23f929..f4740d0fbd3 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs @@ -14,14 +14,21 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Cardano.Ledger.Dijkstra.Arbitrary (genNonEmptyAccountBalanceIntervals, genSmallDijkstraBlockBody) where - +module Test.Cardano.Ledger.Dijkstra.Arbitrary ( + genNonEmptyAccountBalanceIntervals, + genSmallDijkstraTxsBlockBody, + genSmallDijkstraCertBlockBody, +) where + +import Cardano.Crypto.Leios ( + LeiosCert (..), + ) import Cardano.Ledger.Allegra.Scripts ( pattern RequireTimeExpire, pattern RequireTimeStart, ) import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) -import Cardano.Ledger.BaseTypes (StrictMaybe) +import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Dijkstra (ApplyTxError (DijkstraApplyTxError), DijkstraEra) import Cardano.Ledger.Dijkstra.BlockBody (PerasCert (..)) @@ -43,6 +50,7 @@ import qualified Data.OMap.Strict as OMap import qualified Data.Sequence.Strict as SSeq import Data.Typeable (Typeable) import Generic.Random (genericArbitraryU) +import Test.Cardano.Crypto.Leios.Gen (genLeiosCert) import Test.Cardano.Ledger.Allegra.Arbitrary (maxTimelockDepth) import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Arbitrary () @@ -294,6 +302,9 @@ instance instance Arbitrary PerasCert where arbitrary = PerasCert <$> arbitrary +instance Arbitrary LeiosCert where + arbitrary = genLeiosCert + instance ( EraBlockBody era , AlonzoEraTx era @@ -302,14 +313,25 @@ instance ) => Arbitrary (DijkstraBlockBody era) where - arbitrary = DijkstraBlockBody <$> arbitrary <*> arbitrary + arbitrary = + DijkstraBlockBody + <$> arbitrary + <*> arbitrary + <*> arbitrary -genSmallDijkstraBlockBody :: +-- | Generate the "TxsRB" form of a Dijkstra block body: a few transactions are +-- present and no Leios certificate is attached. Transaction count and per-tx +-- size are kept small so the round-trip is fast under shrinking. +genSmallDijkstraTxsBlockBody :: ( AlonzoEraTx era , Arbitrary (Tx TopTx era) ) => Gen (DijkstraBlockBody era) -genSmallDijkstraBlockBody = DijkstraBlockBody <$> genFewTxs <*> arbitrary +genSmallDijkstraTxsBlockBody = + DijkstraBlockBody + <$> genFewTxs + <*> pure SNothing + <*> arbitrary where genFewTxs = sized $ \sz -> do numTxs <- @@ -319,6 +341,18 @@ genSmallDijkstraBlockBody = DijkstraBlockBody <$> genFewTxs <*> arbitrary ] SSeq.fromList <$> vectorOf numTxs (scale (`div` numTxs) arbitrary) +-- | Generate the "CertRB" form of a Dijkstra block body: a Leios certificate is +-- present and the transaction sequence is empty (per CIP-164, a CertRB never +-- carries Dijkstra-era transactions). The Peras certificate is also omitted so +-- the wire form is minimal. +genSmallDijkstraCertBlockBody :: + AlonzoEraTx era => + Gen (DijkstraBlockBody era) +genSmallDijkstraCertBlockBody = + DijkstraBlockBody mempty + <$> (SJust <$> arbitrary) + <*> pure SNothing + deriving newtype instance Arbitrary (ApplyTxError DijkstraEra) instance Arbitrary (DijkstraMempoolPredFailure DijkstraEra) where diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs index 48558be1b56..4dcab699e7c 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs @@ -16,6 +16,7 @@ module Test.Cardano.Ledger.Dijkstra.Binary.Annotator ( ) where import Cardano.Base.Typeable (TypeName (TypeName)) +import Cardano.Crypto.Leios (decodeLeiosCert) import Cardano.Ledger.Allegra.Scripts (invalidBeforeL, invalidHereAfterL) import Cardano.Ledger.BaseTypes import Cardano.Ledger.Binary @@ -234,7 +235,7 @@ decodeDijkstraTopTx allowIsValid = pure (DijkstraTx body wits (IsValid True) aux, isValidFlagSupplied) instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where - decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 3) $ do + decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 4) $ do let decodeInvalidTxs = decodeNonEmptySetLikeEnforceNoDuplicates @@ -243,7 +244,8 @@ instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where (decCBOR @Word16) invalidTxs :: IntSet <- fold <$> decodeNullMaybe decodeInvalidTxs txs <- decodeSeq (decodeDijkstraTopTx @DijkstraEra False) - perasCert <- decodeNullStrictMaybe decCBOR + mbLeiosCert <- decodeNullStrictMaybe (fromPlainDecoder decodeLeiosCert) + mbPerasCert <- decodeNullStrictMaybe decCBOR let txsLength = Seq.length txs inRange x = 0 <= x && x <= txsLength - 1 @@ -253,7 +255,7 @@ instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where let validityFlags = alignedValidFlags txsLength invalidTxs txsWithIsValid = Seq.zipWith (set isValidTxL) validityFlags (coerce <$> txs) - pure $ DijkstraBlockBodyRaw (StrictSeq.forceToStrict txsWithIsValid) perasCert + pure $ DijkstraBlockBodyRaw (StrictSeq.forceToStrict txsWithIsValid) mbLeiosCert mbPerasCert instance DecCBOR (DijkstraBlockBody DijkstraEra) where decCBOR = MkDijkstraBlockBody <$> decodeMemoized decCBOR diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs index a7b114e709c..34b4926f5c5 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs @@ -5,6 +5,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -16,8 +17,11 @@ module Test.Cardano.Ledger.Dijkstra.TreeDiff ( module Test.Cardano.Ledger.Conway.TreeDiff, ) where +import Cardano.Crypto.DSIGN (rawSerialiseSigDSIGN) +import Cardano.Crypto.Leios (LeiosCert (..), encodeBitField) import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) import Cardano.Ledger.BaseTypes (StrictMaybe) +import Cardano.Ledger.Binary.Plain (serialize') import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Dijkstra (DijkstraEra) import Cardano.Ledger.Dijkstra.BlockBody (PerasCert) @@ -56,7 +60,7 @@ import Control.State.Transition (STS (..)) import Data.Functor.Identity (Identity) import qualified Data.TreeDiff.OMap as OMap import Test.Cardano.Ledger.Conway.TreeDiff (Expr (..), ToExpr) -import Test.Cardano.Ledger.TreeDiff (ToExpr (..)) +import Test.Cardano.Ledger.TreeDiff (HexBytes (..), ToExpr (..)) instance (forall a b. (ToExpr a, ToExpr b) => ToExpr (f a b)) => @@ -74,7 +78,7 @@ instance ToExpr (DijkstraPParams StrictMaybe DijkstraEra) instance ToExpr (DijkstraTxBodyRaw l DijkstraEra) where toExpr = \case - txBody@(DijkstraTxBodyRaw _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> + txBody@(DijkstraTxBodyRaw {}) -> let DijkstraTxBodyRaw {..} = txBody in Rec "DijkstraTxBodyRaw" $ OMap.fromList @@ -101,7 +105,7 @@ instance ToExpr (DijkstraTxBodyRaw l DijkstraEra) where , ("dtbrDirectDeposits", toExpr dtbrDirectDeposits) , ("dtbrAccountBalanceIntervals", toExpr dtbrAccountBalanceIntervals) ] - txBody@(DijkstraSubTxBodyRaw _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> + txBody@(DijkstraSubTxBodyRaw {}) -> let DijkstraSubTxBodyRaw {..} = txBody in Rec "DijkstraSubTxBodyRaw" $ OMap.fromList @@ -129,13 +133,25 @@ instance ToExpr (TxBody l DijkstraEra) instance ToExpr PerasCert +-- Manual ToExpr to avoid an orphan 'ToExpr (SigDSIGN BLS12381MinSigDSIGN)': +-- show the BLS signature as its raw byte representation, and the bitfield +-- as its CBOR encoding (since the wire-format bytes aren't separately +-- observable through the public API). +instance ToExpr LeiosCert where + toExpr LeiosCert {leiosCertSigners, leiosCertSignature} = + Rec "LeiosCert" $ + OMap.fromList + [ ("leiosCertSigners", toExpr . HexBytes . serialize' $ encodeBitField leiosCertSigners) + , ("leiosCertSignature", toExpr . HexBytes $ rawSerialiseSigDSIGN leiosCertSignature) + ] + instance ToExpr (Tx TopTx era) => ToExpr (DijkstraBlockBodyRaw era) instance (AlonzoEraTx era, ToExpr (Tx TopTx era), ToExpr PerasCert) => ToExpr (DijkstraBlockBody era) instance ToExpr (DijkstraTx l DijkstraEra) where toExpr = \case - txBody@(DijkstraTx _ _ _ _) -> + txBody@(DijkstraTx {}) -> let DijkstraTx {..} = txBody in Rec "DijkstraTx" $ OMap.fromList @@ -144,7 +160,7 @@ instance ToExpr (DijkstraTx l DijkstraEra) where , ("dtIsValid", toExpr dtIsValid) , ("dtAuxData", toExpr dtAuxData) ] - txBody@(DijkstraSubTx _ _ _) -> + txBody@(DijkstraSubTx {}) -> let DijkstraSubTx {..} = txBody in Rec "DijkstraSubTx" $ OMap.fromList diff --git a/flake.lock b/flake.lock index 7b4a3e816ae..cc66bb2e70a 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1779802675, - "narHash": "sha256-LQN0f9GBBmYMo9tQ/11EvU5tAEOhGtQnU2UP3S78cqg=", + "lastModified": 1782738553, + "narHash": "sha256-lwXCvNoquwMkPoFZPwtxEknlEEr207VYBnm6eVRWwbo=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "b8c7b848cdb6d08e414c37d026c300200f8c1b5b", + "rev": "99731455c206f5f013833e50c4879ae5c3ede2eb", "type": "github" }, "original": { diff --git a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal index b984a451330..28db332df80 100644 --- a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal +++ b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal @@ -58,6 +58,7 @@ library cardano-base >=0.1.2, cardano-binary >=1.7.3, cardano-crypto-class >=2.3 && <2.6, + cardano-crypto-leios >=0.1, cardano-crypto-praos >=2.2.2, cardano-slotting >=0.2, cardano-strict-containers >=0.1.2, diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs index 829eb6b9a93..737051a63bd 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs @@ -26,10 +26,15 @@ module Cardano.Ledger.Binary.Crypto ( decodeSignKeyVRF, encodeCertVRF, decodeCertVRF, + + -- * Leios + encodeLeiosCert, + decodeLeiosCert, ) where import qualified Cardano.Crypto.DSIGN.Class as C import qualified Cardano.Crypto.KES.Class as C +import qualified Cardano.Crypto.Leios as C import qualified Cardano.Crypto.VRF.Class as C import Cardano.Ledger.Binary.Decoding.Decoder (Decoder, fromPlainDecoder) import Cardano.Ledger.Binary.Encoding.Encoder (Encoding, fromPlainEncoding) @@ -125,3 +130,15 @@ encodeCertVRF = fromPlainEncoding . C.encodeCertVRF decodeCertVRF :: C.VRFAlgorithm v => Decoder s (C.CertVRF v) decodeCertVRF = fromPlainDecoder C.decodeCertVRF {-# INLINE decodeCertVRF #-} + +-------------------------------------------------------------------------------- +-- Leios +-------------------------------------------------------------------------------- + +encodeLeiosCert :: C.LeiosCert -> Encoding +encodeLeiosCert = fromPlainEncoding . C.encodeLeiosCert +{-# INLINE encodeLeiosCert #-} + +decodeLeiosCert :: Decoder s C.LeiosCert +decodeLeiosCert = fromPlainDecoder C.decodeLeiosCert +{-# INLINE decodeLeiosCert #-} diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 9d76232ce7a..e2d82c1bf19 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -117,7 +117,7 @@ library base64-bytestring, binary, bytestring >=0.10 && <0.11.3 || >=0.11.4, - cardano-base >=0.1.2, + cardano-base >=0.1.6, cardano-crypto, cardano-crypto-class >=2.4 && <2.6, cardano-crypto-wrapper, diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs index 0b80b39e6c3..b5961169e66 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs @@ -21,7 +21,7 @@ module Cardano.Ledger.Keys.Bootstrap ( verifyBootstrapWit, ) where -import Cardano.Base.Bytes (byteStringToByteArray) +import Cardano.Base.Bytes (byteArrayFromByteString) import qualified Cardano.Chain.Common as Byron import Cardano.Crypto.DSIGN (SignedDSIGN (..)) import qualified Cardano.Crypto.DSIGN as DSIGN @@ -156,7 +156,7 @@ unpackByronVKey -- is the correct one. (32 bytes). If the XPub was constructed correctly, -- we already know that it has this length. Nothing -> error "unpackByronVKey: impossible!" - Just vk -> (VKey vk, ChainCode $ byteStringToByteArray chainCodeBytes) + Just vk -> (VKey vk, ChainCode $ byteArrayFromByteString chainCodeBytes) verifyBootstrapWit :: Hash HASH EraIndependentTxBody -> @@ -179,7 +179,7 @@ makeBootstrapWitness :: Byron.Attributes Byron.AddrAttributes -> BootstrapWitness makeBootstrapWitness txBodyHash byronSigningKey addrAttributes = - BootstrapWitness vk signature cc $ byteStringToByteArray (serialize' addrAttributes) + BootstrapWitness vk signature cc $ byteArrayFromByteString (serialize' addrAttributes) where (vk, cc) = unpackByronVKey $ Byron.toVerification byronSigningKey signature = diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Tools.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Tools.hs index f54d52fbd96..134c8bac6d6 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Tools.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Tools.hs @@ -24,7 +24,7 @@ module Cardano.Ledger.Tools ( byteStringToNum, ) where -import Cardano.Base.Bytes (byteStringToByteArray) +import Cardano.Base.Bytes (byteArrayFromByteString) import qualified Cardano.Chain.Common as Byron import Cardano.Crypto.DSIGN.Class (sigSizeDSIGN, verKeySizeDSIGN) import Cardano.Ledger.Address (BootstrapAddress (..), bootstrapKeyHash) @@ -278,7 +278,7 @@ addDummyWitsTx pp tx numKeyWits byronAttrs = Byron.Attributes Byron.AddrAttributes -> BootstrapWitness mkDummyByronKeyWit key = - BootstrapWitness key dummySig chainCode . byteStringToByteArray . serialize' byronProtVer + BootstrapWitness key dummySig chainCode . byteArrayFromByteString . serialize' byronProtVer dummyByronKeyWits = Set.fromList $ zipWith mkDummyByronKeyWit dummyKeys byronAttrs diff --git a/libs/cardano-ledger-core/test/Test/Cardano/Ledger/AddressSpec.hs b/libs/cardano-ledger-core/test/Test/Cardano/Ledger/AddressSpec.hs index e38b54cf0e0..784a38bf03f 100644 --- a/libs/cardano-ledger-core/test/Test/Cardano/Ledger/AddressSpec.hs +++ b/libs/cardano-ledger-core/test/Test/Cardano/Ledger/AddressSpec.hs @@ -10,7 +10,7 @@ module Test.Cardano.Ledger.AddressSpec (spec) where -import Cardano.Base.Bytes (byteStringToByteArray) +import Cardano.Base.Bytes (byteArrayFromByteString) import qualified Cardano.Chain.Common as Byron import qualified Cardano.Crypto.Hash.Class as Hash import Cardano.Ledger.Address @@ -68,7 +68,7 @@ spec = , bwChainCode = chainCode , bwSignature = sig , bwAttributes = - byteStringToByteArray $ serialize' byronProtVer $ Byron.addrAttributes byronAddr + byteArrayFromByteString $ serialize' byronProtVer $ Byron.addrAttributes byronAddr } pure $ coerceKeyRole (bootstrapKeyHash addr) diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs index a05f479d8a5..394db8fda5d 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs @@ -19,7 +19,7 @@ module Test.Cardano.Protocol.Crypto.VRF.Fake ( WithResult (..), ) where -import Cardano.Base.Bytes (byteStringToByteArray, splitsAt) +import Cardano.Base.Bytes (byteArrayFromByteString, splitsAt) import Cardano.Crypto.Hash import Cardano.Crypto.Seed (runMonadRandomWithSeed) import Cardano.Crypto.Util @@ -79,7 +79,7 @@ instance EncCBOR a => SneakilyContainResult (WithResult a) where -- Fill in the word64 as the low 8 bytes of a 16 byte string OutputVRF (toByteArray (BS.word64BE 0 <> BS.word64BE nat)) where - toByteArray = byteStringToByteArray . LBS.toStrict . BS.toLazyByteString + toByteArray = byteArrayFromByteString . LBS.toStrict . BS.toLazyByteString unsneakilyExtractPayload (WithResult p _) = p @@ -153,7 +153,7 @@ instance VRFAlgorithm FakeVRF where | [kb, smb, xs] <- splitsAt [8, 2, 16] bs , let k = readBinaryWord64 kb , let s = readBinaryWord16 smb = - Just $! CertFakeVRF k s (OutputVRF $ byteStringToByteArray xs) + Just $! CertFakeVRF k s (OutputVRF $ byteArrayFromByteString xs) | otherwise = Nothing