Skip to content

Commit b6b2feb

Browse files
ch1boclaude
ch1bo
and
claude
committed
Leios: add Maybe LeiosCert on DijkstraBody (Dijkstra-only)
Mirrors the existing Maybe PerasCert pattern: a StrictMaybe LeiosCert field on DijkstraBlockBodyRaw, a placeholder LeiosCert newtype (ByteArray with derived EncCBOR/DecCBOR + NoThunks + NFData), a lensMemoRawType-based leiosCertBlockBodyL accessor, the pattern synonym extended with a third StrictMaybe LeiosCert argument, and the CBOR codecs lengthened by one optional element each (EncCBOR raw list 3→4, DecCBOR record (const 3)→(const 4), EncCBORGroup inner list 2→3). Test-side: ToExpr LeiosCert, Arbitrary LeiosCert, and the constraints on the DijkstraBlockBody instances updated. Only the Dijkstra era is Leios-enabled — earlier eras are untouched. The original leios-prototype branch explored a richer shape on Conway (Body with BodyInline / BodyCertificate plus EB-announcement and certification flags on the Ledger Block) and then walked the flags back in its final commit; this commit lands the simpler end state directly on Dijkstra. Refs: snapshot-merge first-parent ancestry preserves the originals; the substantive ones were 0f98189 (introduce Body type), 0c0368e (remove EB-announcement / certification flags), 53517f2 (blockMayAnnouncedEb / blockCertifiesEb on Block). Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
1 parent 7762337 commit b6b2feb

5 files changed

Lines changed: 56 additions & 18 deletions

File tree

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module Cardano.Ledger.Dijkstra.BlockBody (
55
PerasCert (..),
66
PerasKey (..),
77
validatePerasCert,
8+
LeiosCert (..),
89
) where
910

1011
import Cardano.Ledger.Dijkstra.BlockBody.Internal

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

Lines changed: 41 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@
77
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
88
{-# LANGUAGE OverloadedStrings #-}
99
{-# LANGUAGE PatternSynonyms #-}
10-
{-# LANGUAGE RecordWildCards #-}
1110
{-# LANGUAGE ScopedTypeVariables #-}
1211
{-# LANGUAGE StandaloneDeriving #-}
1312
{-# LANGUAGE TypeApplications #-}
@@ -36,6 +35,7 @@ module Cardano.Ledger.Dijkstra.BlockBody.Internal (
3635
PerasCert (..),
3736
PerasKey (..),
3837
validatePerasCert,
38+
LeiosCert (..),
3939
) where
4040

4141
import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
@@ -100,12 +100,17 @@ import NoThunks.Class (NoThunks)
100100

101101
data DijkstraBlockBodyRaw era = DijkstraBlockBodyRaw
102102
{ dbbrTxs :: !(StrictSeq (Tx TopTx era))
103+
, dbbrLeiosCert :: !(StrictMaybe LeiosCert)
104+
-- ^ Leios certificate if this is a ranking block.
105+
-- FIXME: Invariant to check in BBODY ledger rule: if LeiosCert isJust, txs must be empty
103106
, dbbrPerasCert :: !(StrictMaybe PerasCert)
104107
-- ^ Optional Peras certificate
105108
}
106109
deriving (Generic)
107110

108-
instance (NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBodyRaw era)
111+
instance
112+
(NFData (Tx TopTx era), NFData LeiosCert, NFData PerasCert) =>
113+
NFData (DijkstraBlockBodyRaw era)
109114

110115
type instance MemoHashIndex (DijkstraBlockBodyRaw era) = EraIndependentBlockBody
111116

@@ -118,15 +123,20 @@ instance EraBlockBody DijkstraEra where
118123
blockBodySize (ProtVer v _) = BS.length . serialize' v . encCBOR
119124

120125
mkBasicBlockBodyDijkstra :: forall era. AlonzoEraTx era => DijkstraBlockBody era
121-
mkBasicBlockBodyDijkstra = mkMemoized (eraProtVerLow @era) $ DijkstraBlockBodyRaw mempty SNothing
126+
mkBasicBlockBodyDijkstra =
127+
mkMemoized (eraProtVerLow @era) $ DijkstraBlockBodyRaw mempty SNothing SNothing
122128
{-# INLINEABLE mkBasicBlockBodyDijkstra #-}
123129

124130
-- | Dijkstra-specific extensions to 'EraBlockBody'
125131
class EraBlockBody era => DijkstraEraBlockBody era where
132+
leiosCertBlockBodyL :: Lens' (BlockBody era) (StrictMaybe LeiosCert)
133+
-- ^ Lens to access the optional Leios certificate in the block body
134+
126135
perasCertBlockBodyL :: Lens' (BlockBody era) (StrictMaybe PerasCert)
127136
-- ^ Lens to access the optional Peras certificate in the block body
128137

129138
instance DijkstraEraBlockBody DijkstraEra where
139+
leiosCertBlockBodyL = lensMemoRawType @DijkstraEra dbbrLeiosCert (\bb c -> bb {dbbrLeiosCert = c})
130140
perasCertBlockBodyL = lensMemoRawType @DijkstraEra dbbrPerasCert (\bb c -> bb {dbbrPerasCert = c})
131141

132142
deriving instance (Typeable era, NoThunks (Tx TopTx era)) => NoThunks (DijkstraBlockBodyRaw era)
@@ -143,7 +153,7 @@ deriving instance Eq (Tx TopTx era) => Eq (DijkstraBlockBody era)
143153
deriving instance Show (Tx TopTx era) => Show (DijkstraBlockBody era)
144154

145155
deriving newtype instance
146-
(NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBody era)
156+
(NFData (Tx TopTx era), NFData LeiosCert, NFData PerasCert) => NFData (DijkstraBlockBody era)
147157

148158
deriving newtype instance EncCBOR (DijkstraBlockBody era)
149159

@@ -153,13 +163,15 @@ instance Memoized (DijkstraBlockBody era) where
153163
pattern DijkstraBlockBody ::
154164
AlonzoEraTx era =>
155165
StrictSeq (Tx TopTx era) ->
166+
StrictMaybe LeiosCert ->
156167
StrictMaybe PerasCert ->
157168
DijkstraBlockBody era
158-
pattern DijkstraBlockBody txs perasCert <- (getMemoRawType -> DijkstraBlockBodyRaw txs perasCert)
169+
pattern DijkstraBlockBody txs leiosCert perasCert <-
170+
(getMemoRawType -> DijkstraBlockBodyRaw txs leiosCert perasCert)
159171
where
160-
DijkstraBlockBody txs perasCert =
172+
DijkstraBlockBody txs leiosCert perasCert =
161173
mkMemoizedEra @DijkstraEra $
162-
DijkstraBlockBodyRaw txs perasCert
174+
DijkstraBlockBodyRaw txs leiosCert perasCert
163175

164176
{-# COMPLETE DijkstraBlockBody #-}
165177

@@ -173,10 +185,11 @@ instance
173185
) =>
174186
EncCBOR (DijkstraBlockBodyRaw era)
175187
where
176-
encCBOR (DijkstraBlockBodyRaw txs perasCert) =
177-
encodeListLen 3
188+
encCBOR (DijkstraBlockBodyRaw txs leiosCert perasCert) =
189+
encodeListLen 4
178190
<> encodeNullStrictMaybe encCBOR invalidIndices
179191
<> encCBOR txs
192+
<> encodeNullStrictMaybe encCBOR leiosCert
180193
<> encodeNullStrictMaybe encCBOR perasCert
181194
where
182195
invalidIndices =
@@ -192,7 +205,7 @@ instance
192205
) =>
193206
DecCBOR (Annotator (DijkstraBlockBodyRaw era))
194207
where
195-
decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 3) $ do
208+
decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 4) $ do
196209
let
197210
decodeInvalidTxs =
198211
decodeNonEmptySetLikeEnforceNoDuplicates
@@ -201,6 +214,7 @@ instance
201214
(decCBOR @Word16)
202215
invalidTxs :: IntSet <- fold <$> decodeNullMaybe decodeInvalidTxs
203216
txs <- decodeSeq (decodeDijkstraTopTx @era False)
217+
leiosCert <- decodeNullStrictMaybe decCBOR
204218
perasCert <- decodeNullStrictMaybe decCBOR
205219
let txsLength = Seq.length txs
206220
inRange x = 0 <= x && x < txsLength
@@ -214,6 +228,7 @@ instance
214228
pure $
215229
DijkstraBlockBodyRaw
216230
<$> sequenceA (StrictSeq.forceToStrict txsWithIsValid)
231+
<*> pure leiosCert
217232
<*> pure perasCert
218233

219234
deriving via
@@ -228,8 +243,11 @@ deriving via
228243
DecCBOR (Annotator (DijkstraBlockBody era))
229244

230245
instance (AlonzoEraTx era, EncCBOR (Tx TopTx era)) => EncCBORGroup (DijkstraBlockBody era) where
231-
encCBORGroup (DijkstraBlockBody txs perasCert) = do
232-
encodeListLen 2 <> encCBOR txs <> encCBOR perasCert
246+
encCBORGroup (DijkstraBlockBody txs leiosCert perasCert) = do
247+
encodeListLen 3
248+
<> encCBOR txs
249+
<> encCBOR leiosCert
250+
<> encCBOR perasCert
233251
listLen _ = 1
234252

235253
--------------------------------------------------------------------------------
@@ -266,3 +284,14 @@ data PerasKey = PerasKey
266284
-- 'cardano-base' once it's ready.
267285
validatePerasCert :: Nonce -> PerasKey -> PerasCert -> Bool
268286
validatePerasCert _ _ _ = True
287+
288+
-- | Placeholder for Leios certificates
289+
--
290+
-- NOTE: The real type will be defined alongside the Leios voting machinery.
291+
newtype LeiosCert = LeiosCert ByteArray
292+
deriving (Eq, Show, Generic)
293+
deriving newtype (EncCBOR, DecCBOR)
294+
295+
instance NoThunks LeiosCert
296+
297+
instance NFData LeiosCert

‎eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
2424
import Cardano.Ledger.BaseTypes (StrictMaybe)
2525
import qualified Cardano.Ledger.Conway.Rules as Conway
2626
import Cardano.Ledger.Dijkstra (ApplyTxError (DijkstraApplyTxError), DijkstraEra)
27-
import Cardano.Ledger.Dijkstra.BlockBody (PerasCert (..))
27+
import Cardano.Ledger.Dijkstra.BlockBody (LeiosCert (..), PerasCert (..))
2828
import Cardano.Ledger.Dijkstra.Core
2929
import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis (..))
3030
import Cardano.Ledger.Dijkstra.PParams (DijkstraPParams, UpgradeDijkstraPParams)
@@ -290,6 +290,9 @@ instance
290290
where
291291
arbitrary = genericArbitraryU
292292

293+
instance Arbitrary LeiosCert where
294+
arbitrary = LeiosCert <$> arbitrary
295+
293296
instance Arbitrary PerasCert where
294297
arbitrary = PerasCert <$> arbitrary
295298

@@ -301,7 +304,7 @@ instance
301304
) =>
302305
Arbitrary (DijkstraBlockBody era)
303306
where
304-
arbitrary = DijkstraBlockBody <$> arbitrary <*> arbitrary
307+
arbitrary = DijkstraBlockBody <$> arbitrary <*> arbitrary <*> arbitrary
305308

306309
deriving newtype instance Arbitrary (ApplyTxError DijkstraEra)
307310

‎eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -223,7 +223,7 @@ decodeDijkstraTopTx allowIsValid =
223223
pure (DijkstraTx body wits (IsValid True) aux, isValidFlagSupplied)
224224

225225
instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where
226-
decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 3) $ do
226+
decCBOR = decodeRecordNamed "DijkstraBlockBodyRaw" (const 4) $ do
227227
let
228228
decodeInvalidTxs =
229229
decodeNonEmptySetLikeEnforceNoDuplicates
@@ -232,6 +232,7 @@ instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where
232232
(decCBOR @Word16)
233233
invalidTxs :: IntSet <- fold <$> decodeNullMaybe decodeInvalidTxs
234234
txs <- decodeSeq (decodeDijkstraTopTx @DijkstraEra False)
235+
leiosCert <- decodeNullStrictMaybe decCBOR
235236
perasCert <- decodeNullStrictMaybe decCBOR
236237

237238
let txsLength = Seq.length txs
@@ -242,7 +243,7 @@ instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where
242243
let
243244
validityFlags = alignedValidFlags txsLength invalidTxs
244245
txsWithIsValid = Seq.zipWith (set isValidTxL) validityFlags (coerce <$> txs)
245-
pure $ DijkstraBlockBodyRaw (StrictSeq.forceToStrict txsWithIsValid) perasCert
246+
pure $ DijkstraBlockBodyRaw (StrictSeq.forceToStrict txsWithIsValid) leiosCert perasCert
246247

247248
instance DecCBOR (DijkstraBlockBody DijkstraEra) where
248249
decCBOR = MkDijkstraBlockBody <$> decodeMemoized decCBOR

‎eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TreeDiff.hs‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
2020
import Cardano.Ledger.BaseTypes (StrictMaybe)
2121
import qualified Cardano.Ledger.Conway.Rules as Conway
2222
import Cardano.Ledger.Dijkstra (DijkstraEra)
23-
import Cardano.Ledger.Dijkstra.BlockBody (PerasCert)
23+
import Cardano.Ledger.Dijkstra.BlockBody (LeiosCert, PerasCert)
2424
import Cardano.Ledger.Dijkstra.BlockBody.Internal (DijkstraBlockBodyRaw)
2525
import Cardano.Ledger.Dijkstra.Core (
2626
AlonzoEraScript (..),
@@ -129,9 +129,13 @@ instance ToExpr (TxBody l DijkstraEra)
129129

130130
instance ToExpr PerasCert
131131

132+
instance ToExpr LeiosCert
133+
132134
instance ToExpr (Tx TopTx era) => ToExpr (DijkstraBlockBodyRaw era)
133135

134-
instance (AlonzoEraTx era, ToExpr (Tx TopTx era), ToExpr PerasCert) => ToExpr (DijkstraBlockBody era)
136+
instance
137+
(AlonzoEraTx era, ToExpr (Tx TopTx era), ToExpr LeiosCert, ToExpr PerasCert) =>
138+
ToExpr (DijkstraBlockBody era)
135139

136140
instance ToExpr (DijkstraTx l DijkstraEra) where
137141
toExpr = \case

0 commit comments

Comments
 (0)