From 572974606423ab83c5bb0f54463a90f4c52d7f08 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 10:04:48 +0100 Subject: [PATCH 01/12] Bump Hackage and CHaP index states --- cabal.project | 4 ++-- flake.lock | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index e9df825162..66ba9016aa 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2025-12-02T22:23:29Z - , cardano-haskell-packages 2026-01-30T03:40:53Z + , hackage.haskell.org 2026-01-12T19:29:50Z + , cardano-haskell-packages 2026-01-27T13:37:12Z packages: cardano-cli diff --git a/flake.lock b/flake.lock index 8e285b5495..ddf0a18c62 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1769746903, - "narHash": "sha256-aP97gwy91CpecSSDa/BEsohQ7hv7kuovziuNikzRGTw=", + "lastModified": 1770336764, + "narHash": "sha256-Xi7bFFnUWl4azyiJ2e/xpqgvmVBIyYl28JjB8AYMQEA=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "13b004164316511afb0d50be4fd0764da40a7a84", + "rev": "405d656dd66fcc2a3169dda1c71b9473ecddc38c", "type": "github" }, "original": { @@ -226,11 +226,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1768311066, - "narHash": "sha256-g2WdhScDFQNkJs2GBjWIGG49upIQuBshgaeAxddujrE=", + "lastModified": 1770362075, + "narHash": "sha256-AeCcHktGShwmexhR0IDtdtyUqzdOC+kbz2NOZsgmU08=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "adbb09d536f3a2797f9bd0762a0577a30672b8b1", + "rev": "f4dc8bd94173897be2ad4889a5ef45e8f2820bc7", "type": "github" }, "original": { From 1b7c8dfd6b35ce4912aad9d23ca4b1db30073095 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 10:16:38 +0100 Subject: [PATCH 02/12] [wip] Add s-r-ps --- cabal.project | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/cabal.project b/cabal.project index 66ba9016aa..d65c40270e 100644 --- a/cabal.project +++ b/cabal.project @@ -67,3 +67,63 @@ if impl (ghc >= 9.12) -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger + tag: 324efe565237061615ec10e7f47e08699cace660 + --sha256: sha256-Tu5TlPwJgVpEfTui+zbaUJIOMoexCwFTQ5M/n2DP2/I= + subdir: + eras/allegra/impl + eras/alonzo/impl + eras/alonzo/test-suite + eras/babbage/impl + eras/byron/chain/executable-spec + eras/byron/crypto + eras/byron/ledger/executable-spec + eras/byron/ledger/impl + eras/conway/impl + eras/dijkstra/impl + eras/mary/impl + eras/shelley-ma/test-suite + eras/shelley/impl + eras/shelley/test-suite + libs/cardano-data + libs/cardano-ledger-api + libs/cardano-ledger-binary + libs/cardano-ledger-core + libs/cardano-protocol-tpraos + libs/non-integral + libs/plutus-preprocessor + libs/small-steps + libs/vector-map + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 0106df607184099af6770d0f49557e8f8ae93de4 + --sha256: sha256-NpyTScEwSUz2zr1DtxUVJSGT2LaDBD8wtRj6NObBOuc= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + strict-sop-core + sop-extras + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network + tag: 228bb2045784a9c180651dedeea9af9396140f47 + --sha256: sha256-q/93M6+TtnqWiguOiwuUSJljA7nrICOsu+5SLl6jiCc= + subdir: + ouroboros-network + cardano-diffusion + network-mux + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api + tag: 88149e968d0536ac2110abe32a69f221d4b1ea8c + --sha256: sha256-/0oaPmSjsN0H3O/bCLSpimIzT7+Kloof1LBcDOahu5Y= + subdir: + cardano-api From 9f3a80878a81f9715d6cf1f6ee8a95cb1d984eb7 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 5 Jan 2026 09:50:07 +0100 Subject: [PATCH 03/12] Align cardano-crypto-wrapper version with cardano-api --- cardano-cli/cardano-cli.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 4519c360de..b2d8b118e3 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -246,7 +246,7 @@ library cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.2.3.2, - cardano-crypto-wrapper ^>=1.6, + cardano-crypto-wrapper ^>=1.7, cardano-data >=1.1, cardano-git-rev ^>=0.2.2, cardano-ledger-api, From f381e592738aae15c16f0a1a6b66d94fc92be668 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 10:16:19 +0100 Subject: [PATCH 04/12] Bump cardano-ping --- cardano-cli/cardano-cli.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index b2d8b118e3..5ebad74be3 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -253,7 +253,7 @@ library cardano-ledger-conway, cardano-ledger-core, cardano-ledger-dijkstra, - cardano-ping ^>=0.9, + cardano-ping ^>=0.10, cardano-prelude, cardano-protocol-tpraos, cardano-slotting ^>=0.2.0.0, From 0152b40351ec18789890af6a901466557ecdc44e Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 12:59:29 +0100 Subject: [PATCH 05/12] [wip] add TODOs --- cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs | 3 ++- cardano-cli/src/Cardano/CLI/Read.hs | 5 +++-- cardano-cli/src/Cardano/CLI/Type/Common.hs | 5 +++-- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs index 0382ceab5a..19018c9acd 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs @@ -42,7 +42,8 @@ readFileSimpleScript file era = do -- In addition to the TextEnvelope format, we also try to -- deserialize the JSON representation of SimpleScripts.. script :: SimpleScript <- fromEitherCli $ Aeson.eitherDecodeStrict' bs - let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script + -- let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script + let s = undefined -- TODO(10.7) return $ obtainCommonConstraints (era :: Exp.Era era) $ Exp.SimpleScript s Right te -> do let scriptBs = teRawCBOR te diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index cd5d2a960c..cfd44bb2b2 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -211,8 +211,9 @@ readAnyScript anyScriptFp = do -- deserialize the JSON representation of SimpleScripts.. case Aeson.eitherDecodeStrict' bs :: Either String SimpleScript of Left err -> throwCliError err - Right script -> - let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints (Exp.useEra @era) $ toAllegraTimelock script + Right _script -> + -- let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints (Exp.useEra @era) $ toAllegraTimelock script + let s = undefined -- TODO(10.7) in return . Exp.AnySimpleScript $ obtainCommonConstraints (Exp.useEra :: Exp.Era era) $ Exp.SimpleScript s diff --git a/cardano-cli/src/Cardano/CLI/Type/Common.hs b/cardano-cli/src/Cardano/CLI/Type/Common.hs index 41bdcd84bf..ad68ea156b 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Common.hs @@ -381,11 +381,12 @@ mkPoolStates ) ) = (`Map.mapWithKey` qpsrStakePoolParams) $ \kh pp -> do let mDeposit = L.toCompact =<< Map.lookup kh qpsrDeposits + stakingCredentials = undefined -- TODO(10.7) PoolParams - { poolParameters = (`L.mkStakePoolState` pp) <$> mDeposit + { poolParameters = (\deposit -> L.mkStakePoolState deposit stakingCredentials pp) <$> mDeposit , futurePoolParameters = do futurePp <- Map.lookup kh qpsrFutureStakePoolParams - (`L.mkStakePoolState` futurePp) <$> mDeposit + (\deposit -> L.mkStakePoolState deposit stakingCredentials futurePp) <$> mDeposit , retiringEpoch = Map.lookup kh qpsrRetiring } From 8c77e852f8d360288ff0adc72593378d28db513d Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:01:01 +0100 Subject: [PATCH 06/12] Introduce transaction levels --- cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs | 8 ++++---- cardano-cli/src/Cardano/CLI/Read.hs | 3 ++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index f0be7ae646..03a3f7ba2a 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -284,7 +284,7 @@ getScriptWitnessDetails era tb = where aeo = convert era friendlyRedeemers - :: Ledger.Tx (ShelleyLedgerEra era) + :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyRedeemers tx = alonzoEraOnwardsConstraints aeo $ do @@ -293,7 +293,7 @@ getScriptWitnessDetails era tb = Aeson.Array $ Vector.fromList redeemerList friendlyRedeemerInfo - :: Ledger.Tx (ShelleyLedgerEra era) + :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) -> Aeson.Value @@ -373,7 +373,7 @@ getScriptWitnessDetails era tb = addLabelToPurpose Proposing pp = Aeson.object ["submitting a proposal following proposal policy" .= pp] addLabelToPurpose Guarding _ = error "TODO Dijkstra" - friendlyScriptData :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value + friendlyScriptData :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyScriptData tx = alonzoEraOnwardsConstraints aeo $ do Aeson.Array $ @@ -386,7 +386,7 @@ getScriptWitnessDetails era tb = | (scriptHash, scriptData) <- Map.toList $ tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL ] - friendlyDats :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value + friendlyDats :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyDats tx = alonzoEraOnwardsConstraints aeo $ let Ledger.TxDats dats = tx ^. Ledger.witsTxL . Ledger.datsTxWitsL diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index cfd44bb2b2..d163a49d66 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -116,6 +116,7 @@ import Cardano.CLI.Type.Governance import Cardano.CLI.Type.Key import Cardano.Crypto.Hash qualified as Crypto import Cardano.Ledger.Api qualified as L +import Cardano.Ledger.Core qualified as L import RIO (readFileBinary) import Prelude @@ -387,7 +388,7 @@ mkShelleyBootstrapWitness :: () => ShelleyBasedEra era -> Maybe NetworkId - -> L.TxBody (ShelleyLedgerEra era) + -> L.TxBody L.TopTx (ShelleyLedgerEra era) -> ShelleyBootstrapWitnessSigningKeyData -> Either BootstrapWitnessError (KeyWitness era) mkShelleyBootstrapWitness _ Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = From dc786b29b91ad38345649ad04e11585c20571ffa Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:01:17 +0100 Subject: [PATCH 07/12] Replace promoted constructors with types --- cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs | 2 +- .../Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs | 4 ++-- cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs | 6 +++--- cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index 03a3f7ba2a..faef8f3a74 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -633,7 +633,7 @@ renderCertificate sbe (Exp.Certificate c) = renderDrepCredential :: () - => L.Credential 'L.DRepRole + => L.Credential L.DRepRole -> Aeson.Value renderDrepCredential = object . \case diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs index 0e24d5c429..0447e68387 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs @@ -835,9 +835,9 @@ updateOutputTemplate -- ^ Total amount of lovelace -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash 'L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.PoolParams)] -- ^ Pool map - -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)] + -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map -> Maybe Lovelace -- ^ Amount of lovelace to delegate diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs index d633a32ff5..75113642ce 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs @@ -756,9 +756,9 @@ updateOutputTemplate -- ^ Number of UTxO addresses that are delegating -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash 'L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.PoolParams)] -- ^ Pool map - -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)] + -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map -> Maybe Lovelace -- ^ Amount of lovelace to delegate @@ -1080,7 +1080,7 @@ updateTemplate -- ^ Amount of lovelace not delegated -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> Map (L.KeyHash 'L.Staking) L.PoolParams + -> Map (L.KeyHash L.Staking) L.PoolParams -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec -> Lovelace -- ^ Number of UTxO Addresses for delegation diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 276743c9c5..3a51a44d48 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -1813,7 +1813,7 @@ runQuerySPOStakeDistribution PoolState poolStateResult <- fromEitherCli $ decodePoolState (convert eon) serialisedPoolState - let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential 'L.Staking) + let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential L.Staking) spoToRewardCred = Map.map (L.raCredential . L.ppRewardAccount) From 20533a4f3df5f772b023c1cffa910246301fcece Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:22:44 +0100 Subject: [PATCH 08/12] Introduce CoinPerByte --- .../src/Cardano/CLI/EraBased/Common/Option.hs | 15 +++++++++++---- .../CLI/EraBased/Governance/Actions/Option.hs | 2 +- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs index 3565bfb01b..2f8b81836a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs @@ -373,6 +373,13 @@ parseLovelace = do then fail $ show i <> " lovelace exceeds the Word64 upper bound" else return $ L.Coin i +parseCoinPerByte :: P.Parser L.CoinPerByte +parseCoinPerByte = do + i <- P.parseDecimal + case L.toCompact (Coin i) of + Nothing -> fail $ show i <> " lovelace exceeds the Word64 upper bound" + Just c -> pure . L.CoinPerByte $ c + -- | The first argument is the optional prefix. pStakePoolVerificationKeyOrFile :: Maybe String @@ -2702,9 +2709,9 @@ pCostModels = , Opt.completer (Opt.bashCompleter "file") ] -pMinFeePerByteFactor :: Parser Lovelace +pMinFeePerByteFactor :: Parser L.CoinPerByte pMinFeePerByteFactor = - Opt.option (readerFromParsecParser parseLovelace) $ + Opt.option (readerFromParsecParser parseCoinPerByte) $ mconcat [ Opt.long "min-fee-linear" , Opt.metavar "LOVELACE" @@ -2925,9 +2932,9 @@ pExtraEntropy = . BSC.pack =<< some P.hexDigit -pUTxOCostPerByte :: Parser Lovelace +pUTxOCostPerByte :: Parser L.CoinPerByte pUTxOCostPerByte = - Opt.option (readerFromParsecParser parseLovelace) $ + Opt.option (readerFromParsecParser parseCoinPerByte) $ mconcat [ Opt.long "utxo-cost-per-byte" , Opt.metavar "LOVELACE" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs index 74d087c85f..2b70dfe8e8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs @@ -287,7 +287,7 @@ pAlonzoOnwardsPParams = pIntroducedInBabbagePParams :: Parser (IntroducedInBabbagePParams ledgerera) pIntroducedInBabbagePParams = IntroducedInBabbagePParams - <$> convertToLedger L.CoinPerByte (optional pUTxOCostPerByte) + <$> convertToLedger id (optional pUTxOCostPerByte) pIntroducedInConwayPParams :: Parser (IntroducedInConwayPParams ledgerera) pIntroducedInConwayPParams = From cc0b4e02b83e9e0780cf3c994a13f9cd2bd5650a Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:23:58 +0100 Subject: [PATCH 09/12] Use StrictMaybe where necessary --- cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs | 8 ++++---- cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs | 3 ++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs index 2f8b81836a..ada3b6de3d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs @@ -2253,14 +2253,14 @@ pInvalidHereafter pInvalidHereafter eon = fmap (TxValidityUpperBound $ convert eon) $ asum - [ fmap (Just . SlotNo) $ + [ fmap (L.SJust . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat [ Opt.long "invalid-hereafter" , Opt.metavar "SLOT" , Opt.help "Time that transaction is valid until (in slots)." ] - , fmap (Just . SlotNo) $ + , fmap (L.SJust . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat [ Opt.long "upper-bound" @@ -2272,7 +2272,7 @@ pInvalidHereafter eon = ] , Opt.internal ] - , fmap (Just . SlotNo) $ + , fmap (L.SJust . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat [ Opt.long "ttl" @@ -2280,7 +2280,7 @@ pInvalidHereafter eon = , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)." , Opt.internal ] - , pure Nothing + , pure L.SNothing ] pTxFee :: Parser Lovelace diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 7f219056b8..faa8f55599 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -88,6 +88,7 @@ import Data.Data ((:~:) (..)) import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.Map.Strict qualified as Map +import Data.Maybe.Strict (strictMaybe) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.IO qualified as Text @@ -887,7 +888,7 @@ constructTxBodyContent & maybe id Exp.setTxTotalCollateral txTotCollateral & Exp.setTxFee fee & maybe id Exp.setTxValidityLowerBound mLowerBound - & maybe id Exp.setTxValidityUpperBound mUpperBound + & strictMaybe id Exp.setTxValidityUpperBound mUpperBound & Exp.setTxMetadata expTxMetadata & Exp.setTxAuxScripts auxScripts & Exp.setTxWithdrawals validatedWithdrawals From e9616dc09c1541ed927027ecec4198fa962e0c68 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:46:12 +0100 Subject: [PATCH 10/12] `PoolParams` -> `StakePoolParams` --- .../EraBased/Genesis/CreateTestnetData/Run.hs | 30 ++++++++--------- .../src/Cardano/CLI/EraBased/Genesis/Run.hs | 32 +++++++++---------- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs index 0447e68387..b2cc36884e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs @@ -447,7 +447,7 @@ runGenesisCreateTestNetDataCmd mkPoolDir idx = poolsDir ("pool" <> show idx) mkDelegationMapEntry - :: Delegation -> (L.KeyHash L.Staking, L.PoolParams) + :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) addCommitteeToConwayGenesis @@ -751,7 +751,7 @@ createPoolCredentials fmt dir = do data Delegation = Delegation { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) , dDelegStaking :: !(L.KeyHash L.Staking) - , dPoolParams :: !L.PoolParams + , dPoolParams :: !L.StakePoolParams } deriving (Generic, NFData) @@ -763,7 +763,7 @@ buildPoolParams -- ^ The index of the pool being built. Starts at 0. -> Map Word [L.StakePoolRelay] -- ^ User submitted stake pool relay map. Starts at 0 - -> ExceptT GenesisCmdError IO L.PoolParams + -> ExceptT GenesisCmdError IO L.StakePoolParams buildPoolParams nw dir index specifiedRelays = do StakePoolVerificationKey poolColdVK <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) @@ -780,17 +780,17 @@ buildPoolParams nw dir index specifiedRelays = do $ readFileTextEnvelope poolRewardVKF pure - L.PoolParams - { L.ppId = L.hashKey poolColdVK - , L.ppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK - , L.ppPledge = L.Coin 0 - , L.ppCost = L.Coin 0 - , L.ppMargin = minBound - , L.ppRewardAccount = + L.StakePoolParams + { L.sppId = L.hashKey poolColdVK + , L.sppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK + , L.sppPledge = L.Coin 0 + , L.sppCost = L.Coin 0 + , L.sppMargin = minBound + , L.sppAccountAddress = toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) - , L.ppOwners = mempty - , L.ppRelays = lookupPoolRelay specifiedRelays - , L.ppMetadata = L.SNothing + , L.sppOwners = mempty + , L.sppRelays = lookupPoolRelay specifiedRelays + , L.sppMetadata = L.SNothing } where lookupPoolRelay :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay @@ -812,7 +812,7 @@ computeInsecureStakeKeyAddr g0 = do computeDelegation :: NetworkId -> (VerificationKey PaymentKey, VerificationKey StakeKey) - -> L.PoolParams + -> L.StakePoolParams -> Delegation computeDelegation nw (paymentVK, stakeVK) dPoolParams = do let paymentCredential = PaymentCredentialByKey (verificationKeyHash paymentVK) @@ -835,7 +835,7 @@ updateOutputTemplate -- ^ Total amount of lovelace -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.StakePoolParams)] -- ^ Pool map -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs index 75113642ce..dc6e18176c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs @@ -740,7 +740,7 @@ runGenesisCreateStakedCmd where adjustTemplate t = t{sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId)} mkDelegationMapEntry - :: Delegation -> (L.KeyHash L.Staking, L.PoolParams) + :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) -- ------------------------------------------------------------------------------------------------- @@ -756,7 +756,7 @@ updateOutputTemplate -- ^ Number of UTxO addresses that are delegating -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.StakePoolParams)] -- ^ Pool map -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map @@ -939,7 +939,7 @@ createPoolCredentials fmt dir index = do data Delegation = Delegation { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) , dDelegStaking :: !(L.KeyHash L.Staking) - , dPoolParams :: !L.PoolParams + , dPoolParams :: !L.StakePoolParams } deriving (Generic, NFData) @@ -950,7 +950,7 @@ buildPoolParams -> Maybe Word -> Map Word [L.StakePoolRelay] -- ^ User submitted stake pool relay map - -> ExceptT GenesisCmdError IO L.PoolParams + -> ExceptT GenesisCmdError IO L.StakePoolParams buildPoolParams nw dir index specifiedRelays = do StakePoolVerificationKey poolColdVK <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) @@ -967,17 +967,17 @@ buildPoolParams nw dir index specifiedRelays = do $ readFileTextEnvelope @(VerificationKey StakeKey) poolRewardVKF pure - L.PoolParams - { L.ppId = L.hashKey poolColdVK - , L.ppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK - , L.ppPledge = L.Coin 0 - , L.ppCost = L.Coin 0 - , L.ppMargin = minBound - , L.ppRewardAccount = + L.StakePoolParams + { L.sppId = L.hashKey poolColdVK + , L.sppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK + , L.sppPledge = L.Coin 0 + , L.sppCost = L.Coin 0 + , L.sppMargin = minBound + , L.sppAccountAddress = toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) - , L.ppOwners = mempty - , L.ppRelays = lookupPoolRelay specifiedRelays - , L.ppMetadata = L.SNothing + , L.sppOwners = mempty + , L.sppRelays = lookupPoolRelay specifiedRelays + , L.sppMetadata = L.SNothing } where lookupPoolRelay @@ -1030,7 +1030,7 @@ writeBulkPoolCredentials dir bulkIx poolIxs = do computeInsecureDelegation :: StdGen -> NetworkId - -> L.PoolParams + -> L.StakePoolParams -> IO (StdGen, Delegation) computeInsecureDelegation g0 nw pool = do (paymentVK, g1) <- first getVerificationKey <$> generateInsecureSigningKey g0 AsPaymentKey @@ -1080,7 +1080,7 @@ updateTemplate -- ^ Amount of lovelace not delegated -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> Map (L.KeyHash L.Staking) L.PoolParams + -> Map (L.KeyHash L.Staking) L.StakePoolParams -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec -> Lovelace -- ^ Number of UTxO Addresses for delegation From 11abfd2b109428d54e09561233b2f0a7bca2414a Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 13:58:53 +0100 Subject: [PATCH 11/12] [wip] integrate ledger peer snapshot query change --- .../src/Cardano/CLI/EraBased/Query/Run.hs | 34 +++++++++++-------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 3a51a44d48..0442f740f7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -44,6 +44,7 @@ import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Ledger (strictMaybeToMaybe) import Cardano.Api.Ledger qualified as L +import Cardano.Ledger.Address qualified as L import Cardano.Api.Network qualified as Consensus import Cardano.Binary qualified as CBOR @@ -890,30 +891,33 @@ runQueryLedgerPeerSnapshot era <- hoist liftIO $ supportedEra cEra let sbe = convert era - result <- easyRunQuery (queryLedgerPeerSnapshot sbe) + let ledgerPeerKind = undefined -- TODO(10.7) + result <- easyRunQuery (queryLedgerPeerSnapshot sbe ledgerPeerKind) shelleyNtcVersion <- hoistEither $ getShelleyNodeToClientVersion era globalNtcVersion hoist liftIO $ obtainCommonConstraints era $ - case decodeBigLedgerPeerSnapshot shelleyNtcVersion result of - Left (bs, _decoderError) -> pure $ Left bs - Right snapshot -> pure $ Right snapshot + case decodeLedgerPeerSnapshot shelleyNtcVersion result of + Left (bs, _decoderError) -> undefined -- pure $ Left bs -- TODO(10.7) + Right snapshot -> undefined -- pure $ Right snapshot -- TODO(10.7) ) & fromEitherCIOCli case result of Left (bs :: LBS.ByteString) -> do fromExceptTCli $ pPrintCBOR bs - Right (snapshot :: LedgerPeerSnapshot) -> do - let output = - outputFormat - & ( id - . Vary.on (\FormatJson -> Json.encodeJson) - . Vary.on (\FormatYaml -> Json.encodeYaml) - $ Vary.exhaustiveCase - ) - $ snapshot + -- Right (snapshot :: LedgerPeerSnapshot) -> do + Right _ -> do + let snapshot = undefined -- TODO(10.7) + let output = undefined -- TODO(10.7) + -- outputFormat + -- & ( id + -- . Vary.on (\FormatJson -> Json.encodeJson) + -- . Vary.on (\FormatYaml -> Json.encodeYaml) + -- $ Vary.exhaustiveCase + -- ) + -- $ snapshot fromEitherIOCli @(FileError ()) $ writeLazyByteStringOutput mOutFile output @@ -1051,7 +1055,7 @@ getQueryStakeAddressInfo | gas <- toList govActionStates , let proc = L.gasProposalProcedure gas , let rewardAccount = L.pProcReturnAddr proc - stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential $ L.raCredential rewardAccount + stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential ( rewardAccount ^. L.accountAddressCredentialL) , stakeCredential == fromShelleyStakeCredential addr ] @@ -1816,7 +1820,7 @@ runQuerySPOStakeDistribution let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential L.Staking) spoToRewardCred = Map.map - (L.raCredential . L.ppRewardAccount) + (\params -> L.sppAccountAddress params ^. L.accountAddressCredentialL) (L.qpsrStakePoolParams poolStateResult) allRewardCreds :: Set StakeCredential From 5301d7ad9965eb662db8654c15f24e67fee2a68f Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 14:14:58 +0100 Subject: [PATCH 12/12] [wip] Update AlonzoGenesis --- .../cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs index 44797a1715..3427929651 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs @@ -58,7 +58,8 @@ hprop_golden_alonzo_genesis_v2_cost_model_has_175_parameters = -- Read generated alonzo genesis file alonzoGenesisFp <- H.note $ outDir "genesis.alonzo.json" - AlonzoGenesis _ costModels _ _ _ _ _ _ <- H.readJsonFileOk alonzoGenesisFp + AlonzoGenesis _ costModel _ _ _ _ _ _ _extraConfig <- H.readJsonFileOk alonzoGenesisFp + let costModels = undefined -- TODO(10.7) let v2CostModel = costModelsValid costModels mV2Params = Map.lookup PlutusV2 v2CostModel v2Params <- getCostModelParams <$> H.evalMaybe mV2Params