From 91bbb15211c9adc59e9c4b898122260d8bd40d9f Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 17 Sep 2026 12:02:55 -0400 Subject: [PATCH 1/6] chore: ignore local dev scripts Everything under scripts/ except the tracked patch-nix-deps.sh. --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index fed013a..933cf2d 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,7 @@ dist-newstyle ## Claude Code (symlink created by the devShell shellHook) /.claude + +## Local dev scripts (patch-nix-deps.sh stays tracked) +/scripts/* +!/scripts/patch-nix-deps.sh From aa9f42c0cf3073c13535423294d3afbcef2a482e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 17 Sep 2026 12:02:55 -0400 Subject: [PATCH 2/6] bump: dependencies for cardano-node 11.1 ouroboros-consensus 4.2.1, ouroboros-network 1.2, cardano-ledger-conway 1.23 (core 1.21, dijkstra 0.3) and the matching CHaP index-state. Drops the `validation < 1.2` pin. contra-tracers (with fast-bech32) comes from the IntersectMBO/ogmios fork until a release with the contra-tracer 0.2 fix from https://github.com/IntersectMBO/ogmios/pull/13 is published. --- cabal.project | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/cabal.project b/cabal.project index f581912..18fa691 100644 --- a/cabal.project +++ b/cabal.project @@ -10,8 +10,8 @@ repository cardano-haskell-packages d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee index-state: - , hackage.haskell.org 2026-05-08T22:40:19Z - , cardano-haskell-packages 2026-05-08T13:26:45Z + , hackage.haskell.org 2026-08-14T13:38:07Z + , cardano-haskell-packages 2026-09-16T23:53:07Z packages: ./ @@ -46,16 +46,15 @@ package direct-sqlite flags: +nomutex constraints: - , any.cardano-node == 11.0.1 + , any.cardano-node == 11.1.1 - , any.cardano-ledger-conway >= 1.22.1.0 + , any.cardano-ledger-conway >= 1.23 - , any.ouroboros-consensus ^>= 3.0.1 - , any.ouroboros-network ^>= 1.1 + , any.ouroboros-consensus ^>= 4.2.1 + , any.ouroboros-network ^>= 1.2 , any.io-classes ^>= 1.8 , any.formatting == 7.2.0 - , any.validation < 1.2 , any.text source -- Use serial block IO instead of io_uring to avoid requiring liburing @@ -71,14 +70,16 @@ allow-newer: , io-classes:time -- NOTE update hash using --- nix-prefetch-git https://github.com/CardanoSolutions/ogmios.git --rev --fetch-submodules --quiet | jq '.hash' | tail -c +9 | head -c -2 +-- nix-prefetch-git https://github.com/IntersectMBO/ogmios.git --rev --fetch-submodules --quiet | jq '.hash' | tail -c +9 | head -c -2 +-- source-repository-package type: git - location: https://github.com/CardanoSolutions/ogmios - --sha256: xkOfOdX6Dxi7+VW78Tk3n3MoguIg39pKdxiNVfdeEwE= - tag: ae876badb138f42dcd6d2389734b0c15502684ed + location: https://github.com/IntersectMBO/ogmios + --sha256: sha256-1VptE6HSuT2U+NMw7HLb5X1PqqrYpsOkl4tWHk5ygG4= + tag: ed9efbad7b06193b00c13fb8102dcd0d8ff63647 subdir: server/modules/fast-bech32 + server/modules/contra-tracers source-repository-package type: git From e1c986bbc4bc05f73ae51a0e856086a86185413f Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 17 Sep 2026 12:02:56 -0400 Subject: [PATCH 3/6] port to cardano-node 11.1 APIs - contra-tracer 0.2: build the log sink with `mkTracer`. - consensus 4.x: `fromRawHash`/`fromShortRawHash` return `Maybe`. - ledger-core 1.21: `Metadatum.B` holds a `ByteArray`. - alonzo 1.16: `IsValid`/`isValidTxL` -> `IsPhase2Valid`/`isPhase2ValidTxL`. --- src/Kupo/Control/MonadLog.hs | 3 ++- src/Kupo/Data/Cardano.hs | 36 ++++++++++++++--------------- src/Kupo/Data/Cardano/HeaderHash.hs | 2 +- src/Kupo/Data/Cardano/Metadata.hs | 21 +++++++++++++++-- src/Kupo/Data/Database.hs | 2 +- test/Test/Kupo/App/HttpSpec.hs | 8 +++---- test/Test/Kupo/Data/Generators.hs | 6 ++++- test/Test/KupoSpec.hs | 6 ++--- 8 files changed, 53 insertions(+), 31 deletions(-) diff --git a/src/Kupo/Control/MonadLog.hs b/src/Kupo/Control/MonadLog.hs index d89f4bb..a21efd9 100644 --- a/src/Kupo/Control/MonadLog.hs +++ b/src/Kupo/Control/MonadLog.hs @@ -41,6 +41,7 @@ import Control.Monad.Class.MonadTime ) import Control.Tracer ( Tracer (..) + , mkTracer , natTracer , nullTracer , traceWith @@ -135,7 +136,7 @@ withTracers h version tracers action = do :: Writer -> TMVar IO () -> Tracer IO SomeMsg - tracer say lock = Tracer $ \someMsg@(SomeMsg minSeverity _ msg) -> do + tracer say lock = mkTracer $ \someMsg@(SomeMsg minSeverity _ msg) -> do let severity = getSeverityAnnotation msg when (severity >= minSeverity) $ liftIO $ withTMVar lock $ \() -> do threadId <- myThreadId diff --git a/src/Kupo/Data/Cardano.hs b/src/Kupo/Data/Cardano.hs index 010b632..c9c83ac 100644 --- a/src/Kupo/Data/Cardano.hs +++ b/src/Kupo/Data/Cardano.hs @@ -211,22 +211,22 @@ instance IsBlock Block where TransactionMary tx -> tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL TransactionAlonzo tx -> - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL - Ledger.IsValid False -> + Ledger.Phase2Invalid -> tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL TransactionBabbage tx -> - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL - Ledger.IsValid False -> + Ledger.Phase2Invalid -> tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL TransactionConway tx -> - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL - Ledger.IsValid False -> + Ledger.Phase2Invalid -> tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL where transformByron (Ledger.Byron.TxInUtxo txId ix) = @@ -276,10 +276,10 @@ instance IsBlock Block where outs = body ^. Ledger.outputsTxBodyL meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromAlonzoMetadata in - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> traverseAndTransform fromAlonzoOutput txId meta 0 outs - Ledger.IsValid False -> + Ledger.Phase2Invalid -> [] TransactionBabbage tx -> let @@ -288,10 +288,10 @@ instance IsBlock Block where outs = body ^. Ledger.outputsTxBodyL meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromBabbageMetadata in - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> traverseAndTransform fromBabbageOutput txId meta 0 outs - Ledger.IsValid False -> + Ledger.Phase2Invalid -> -- From Babbage's formal specification: -- -- Note that the new collOuts function generates a single output @@ -309,10 +309,10 @@ instance IsBlock Block where outs = body ^. Ledger.outputsTxBodyL meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata fromConwayMetadata in - case tx ^. Ledger.isValidTxL of - Ledger.IsValid True -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> traverseAndTransform identity txId meta 0 outs - Ledger.IsValid False -> + Ledger.Phase2Invalid -> -- From Conway formal specification: -- -- Note that the new collOuts function generates a single output diff --git a/src/Kupo/Data/Cardano/HeaderHash.hs b/src/Kupo/Data/Cardano/HeaderHash.hs index d2fa347..25dd689 100644 --- a/src/Kupo/Data/Cardano/HeaderHash.hs +++ b/src/Kupo/Data/Cardano/HeaderHash.hs @@ -62,5 +62,5 @@ unsafeHeaderHashFromBytes :: ByteString -> HeaderHash Block unsafeHeaderHashFromBytes = - fromRawHash (Proxy @Block) + unsafeFromRawHash (Proxy @Block) {-# INLINABLE unsafeHeaderHashFromBytes #-} diff --git a/src/Kupo/Data/Cardano/Metadata.hs b/src/Kupo/Data/Cardano/Metadata.hs index 0a94a9a..ef34b67 100644 --- a/src/Kupo/Data/Cardano/Metadata.hs +++ b/src/Kupo/Data/Cardano/Metadata.hs @@ -5,6 +5,10 @@ module Kupo.Data.Cardano.Metadata import Kupo.Prelude +import Data.Array.Byte + ( ByteArray + ) + import Cardano.Ledger.Allegra.TxAuxData ( AllegraTxAuxData (..) ) @@ -35,6 +39,7 @@ import qualified Data.Aeson.Encoding as Json import qualified Data.Aeson.Key as Json.Key import qualified Data.Aeson.KeyMap as Json.KeyMap import qualified Data.Aeson.Types as Json +import qualified Data.ByteString.Short.Internal as SBS import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Read as T @@ -81,7 +86,7 @@ metadataToJson (AlonzoTxAuxData labels _ _) = Ledger.S txt -> encodeObject [("string", Json.text txt)] Ledger.B bytes -> - encodeObject [("bytes", Json.text $ encodeBase16 bytes)] + encodeObject [("bytes", Json.text $ encodeBase16 (byteArrayToByteString bytes))] Ledger.List xs -> encodeObject [("list", Json.list encodeMetadatum xs)] Ledger.Map xs -> @@ -134,7 +139,7 @@ metadataFromJson = fmap mkMetadata . Json.withObject "Metadata" metadatumBytesFromJson o = do b <- (o .: "bytes") >>= either (fail . toString) pure . decodeBase16 . encodeUtf8 @Text - pure (Ledger.B b) + pure (Ledger.B (byteStringToByteArray b)) metadatumListFromJson :: Json.Object -> Json.Parser Metadatum metadatumListFromJson o = do @@ -188,3 +193,15 @@ fromConwayMetadata :: AlonzoTxAuxData ConwayEra -> Metadata fromConwayMetadata = identity {-# INLINABLE fromConwayMetadata #-} + +-- +-- Helpers +-- + +-- | Converting between 'ByteArray' (unpinned) and 'ByteString' (pinned) copies the +-- bytes. Harmless: the ledger caps metadata byte strings at 64 bytes. +byteArrayToByteString :: ByteArray -> ByteString +byteArrayToByteString = fromShort . SBS.ShortByteString + +byteStringToByteArray :: ByteString -> ByteArray +byteStringToByteArray = SBS.unShortByteString . toShort diff --git a/src/Kupo/Data/Database.hs b/src/Kupo/Data/Database.hs index 7a326ce..53d3608 100644 --- a/src/Kupo/Data/Database.hs +++ b/src/Kupo/Data/Database.hs @@ -119,7 +119,7 @@ pointFromRow -> App.Point pointFromRow row = App.BlockPoint (App.SlotNo (checkpointSlotNo row)) - (fromShortRawHash (Proxy @App.Block) $ toShort $ checkpointHeaderHash row) + (unsafeFromShortRawHash (Proxy @App.Block) $ toShort $ checkpointHeaderHash row) {-# INLINABLE pointFromRow #-} pointToRow diff --git a/test/Test/Kupo/App/HttpSpec.hs b/test/Test/Kupo/App/HttpSpec.hs index e68b4b1..06f2968 100644 --- a/test/Test/Kupo/App/HttpSpec.hs +++ b/test/Test/Kupo/App/HttpSpec.hs @@ -8,10 +8,6 @@ module Test.Kupo.App.HttpSpec ( spec ) where -import Kupo.Prelude hiding - ( get - , put - ) import Data.Aeson ( (.!=) , (.:) @@ -78,6 +74,10 @@ import Kupo.Data.Pattern ( Pattern , patternToText ) +import Kupo.Prelude hiding + ( get + , put + ) import Network.HTTP.Media.MediaType ( MediaType , (//) diff --git a/test/Test/Kupo/Data/Generators.hs b/test/Test/Kupo/Data/Generators.hs index 06db85f..267d8b5 100644 --- a/test/Test/Kupo/Data/Generators.hs +++ b/test/Test/Kupo/Data/Generators.hs @@ -8,6 +8,10 @@ module Test.Kupo.Data.Generators where import Kupo.Prelude +import Kupo.Data.Cardano.Metadata + ( byteStringToByteArray + ) + import Data.Bits ( shiftL ) @@ -352,7 +356,7 @@ genMetadata = do genMetadatum = sized $ \case 0 -> oneof [ I <$> arbitrary - , B <$> (choose (0, 16) >>= genBytes) + , B . byteStringToByteArray <$> (choose (0, 16) >>= genBytes) , S . T.pack <$> (chooseVector (0, 24) (elements ['a'..'z'])) ] ((truncate @Double . log . fromIntegral) -> n) -> oneof diff --git a/test/Test/KupoSpec.hs b/test/Test/KupoSpec.hs index 901f32d..517e2c7 100644 --- a/test/Test/KupoSpec.hs +++ b/test/Test/KupoSpec.hs @@ -194,13 +194,13 @@ import Kupo.Data.Health ( ConnectionStatus (..) , Health (..) ) +import System.Environment + ( getEnvironment + ) import System.IO ( hClose , hGetLine ) -import System.Environment - ( getEnvironment - ) import qualified Data.Aeson as Json import qualified Data.Text as T From bbeae4df2e68abbde1c48f8ad08c3a86f963a781 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 21 Sep 2026 12:19:33 -0400 Subject: [PATCH 4/6] promote canonical era to Dijkstra and index top-level Dijkstra transactions Output, Script, NativeScript, Metadata and BinaryData are pegged to DijkstraEra; Conway now upgrades up like every older era. Conway aux data is rebuilt with `upgradeTimelock` since ledger-dijkstra 0.3 has no `upgradeTxAuxData` for Dijkstra. Adds `TransactionDijkstra` with arms in every `IsBlock Block` method, replacing the `BlockDijkstra` error stub. Based on upstream CardanoSolutions/kupo b6108fa, 00b332b, af68a61 and 22c0060, adapted to the node 11.1 ledger API. --- kupo.cabal | 13 ++++++-- package.yaml | 1 + src/Kupo/Data/Cardano.hs | 47 ++++++++++++++++++++++++--- src/Kupo/Data/Cardano/BinaryData.hs | 12 +++++-- src/Kupo/Data/Cardano/Datum.hs | 23 ++++++------- src/Kupo/Data/Cardano/Metadata.hs | 17 +++++----- src/Kupo/Data/Cardano/NativeScript.hs | 3 +- src/Kupo/Data/Cardano/Output.hs | 19 +++++++---- src/Kupo/Data/Cardano/Redeemers.hs | 6 ++++ src/Kupo/Data/Cardano/Script.hs | 17 +++++----- src/Kupo/Data/Cardano/Transaction.hs | 4 +++ src/Kupo/Data/Hydra.hs | 9 ++--- src/Kupo/Prelude.hs | 4 +++ 13 files changed, 128 insertions(+), 47 deletions(-) diff --git a/kupo.cabal b/kupo.cabal index 5b70708..cee0ea9 100644 --- a/kupo.cabal +++ b/kupo.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 --- This file has been generated from package.yaml by hpack version 0.38.2. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack @@ -131,6 +131,8 @@ library Kupo.Version.TH other-modules: Paths_kupo + autogen-modules: + Paths_kupo hs-source-dirs: src default-extensions: @@ -184,6 +186,7 @@ library , bytestring , cardano-crypto-class , cardano-crypto-wrapper + , cardano-diffusion , cardano-ledger-allegra , cardano-ledger-alonzo , cardano-ledger-api @@ -192,6 +195,7 @@ library , cardano-ledger-byron , cardano-ledger-conway , cardano-ledger-core + , cardano-ledger-dijkstra , cardano-ledger-mary , cardano-ledger-shelley , cardano-slotting @@ -215,7 +219,6 @@ library , network , network-mux , optparse-applicative - , cardano-diffusion , ouroboros-consensus , ouroboros-consensus:cardano , ouroboros-consensus:diffusion @@ -256,6 +259,8 @@ executable kupo main-is: Main.hs other-modules: Paths_kupo + autogen-modules: + Paths_kupo hs-source-dirs: app default-extensions: @@ -333,6 +338,8 @@ test-suite unit Test.Kupo.OptionsSpec Test.KupoSpec Paths_kupo + autogen-modules: + Paths_kupo hs-source-dirs: test default-extensions: @@ -389,6 +396,7 @@ test-suite unit , http-media , http-types , io-classes + , io-classes:si-timers , io-sim , kupo , lens-aeson @@ -396,7 +404,6 @@ test-suite unit , process , quickcheck-state-machine , relude - , io-classes:si-timers , sqlite-simple , stm , temporary diff --git a/package.yaml b/package.yaml index 307c932..fae6acf 100644 --- a/package.yaml +++ b/package.yaml @@ -71,6 +71,7 @@ library: - cardano-ledger-byron - cardano-ledger-conway - cardano-ledger-core + - cardano-ledger-dijkstra - cardano-ledger-mary - cardano-ledger-shelley - cardano-slotting diff --git a/src/Kupo/Data/Cardano.hs b/src/Kupo/Data/Cardano.hs index c9c83ac..3cd5f28 100644 --- a/src/Kupo/Data/Cardano.hs +++ b/src/Kupo/Data/Cardano.hs @@ -194,9 +194,8 @@ instance IsBlock Block where foldrWithIndex (\ix -> fn ix . TransactionBabbage) result (txs ^. Ledger.txSeqBlockBodyL) BlockConway (ShelleyBlock (Ledger.Block _ txs) _) -> foldrWithIndex (\ix -> fn ix . TransactionConway) result (txs ^. Ledger.txSeqBlockBodyL) - BlockDijkstra _ -> - -- We don't support Dijkstra blocks. - error "kupo: Dijkstra blocks are not supported." + BlockDijkstra (ShelleyBlock (Ledger.Block _ txs) _) -> + foldrWithIndex (\ix -> fn ix . TransactionDijkstra) result (txs ^. Ledger.txSeqBlockBodyL) spentInputs :: Transaction @@ -228,6 +227,12 @@ instance IsBlock Block where tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL Ledger.Phase2Invalid -> tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL + TransactionDijkstra tx -> + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> + tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL + Ledger.Phase2Invalid -> + tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL where transformByron (Ledger.Byron.TxInUtxo txId ix) = mkOutputReference @@ -311,12 +316,29 @@ instance IsBlock Block where in case tx ^. Ledger.isPhase2ValidTxL of Ledger.Phase2Valid -> - traverseAndTransform identity txId meta 0 outs + traverseAndTransform fromConwayOutput txId meta 0 outs Ledger.Phase2Invalid -> -- From Conway formal specification: -- -- Note that the new collOuts function generates a single output -- with an index |txouts{txb}|. + let start = fromIntegral (length outs) in + case body ^. Ledger.collateralReturnTxBodyL of + SNothing -> + [] + SJust r -> + traverseAndTransform fromConwayOutput txId meta start (r :<| mempty) + TransactionDijkstra tx -> + let + body = tx ^. Ledger.bodyTxL + txId = Ledger.txIdTxBody @DijkstraEra body + outs = body ^. Ledger.outputsTxBodyL + meta = tx ^. Ledger.auxDataTxL & strictMaybe emptyMetadata identity + in + case tx ^. Ledger.isPhase2ValidTxL of + Ledger.Phase2Valid -> + traverseAndTransform identity txId meta 0 outs + Ledger.Phase2Invalid -> let start = fromIntegral (length outs) in case body ^. Ledger.collateralReturnTxBodyL of SNothing -> @@ -383,6 +405,8 @@ instance IsBlock Block where fromBabbageData <$> Ledger.unTxDats (tx ^. Ledger.witsTxL . Ledger.datsTxWitsL) TransactionConway tx -> fromConwayData <$> Ledger.unTxDats (tx ^. Ledger.witsTxL . Ledger.datsTxWitsL) + TransactionDijkstra tx -> + fromDijkstraData <$> Ledger.unTxDats (tx ^. Ledger.witsTxL . Ledger.datsTxWitsL) witnessedScripts :: Transaction @@ -415,6 +439,13 @@ instance IsBlock Block where & scriptsFromOutputs (fromBabbageOutput <$> tx ^. Ledger.bodyTxL . Ledger.outputsTxBodyL) TransactionConway tx -> + ( fromConwayScript <$> tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL + ) & strictMaybe identity + (scriptFromAlonzoAuxiliaryData fromConwayScript) + (tx ^. Ledger.auxDataTxL) + & scriptsFromOutputs + (fromConwayOutput <$> tx ^. Ledger.bodyTxL . Ledger.outputsTxBodyL) + TransactionDijkstra tx -> ( tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL ) & strictMaybe identity (scriptFromAlonzoAuxiliaryData identity) @@ -470,6 +501,12 @@ instance IsBlock Block where SJust auxData -> let meta = fromConwayMetadata auxData in Just (hashMetadata meta, meta) + TransactionDijkstra tx -> + case tx ^. Ledger.auxDataTxL of + SNothing -> + Nothing + SJust auxData -> + Just (hashMetadata auxData, auxData) spendRedeemer :: Transaction @@ -491,3 +528,5 @@ instance IsBlock Block where Just (RedeemersBabbage (tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL)) TransactionConway tx -> Just (RedeemersConway (tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL)) + TransactionDijkstra tx -> + Just (RedeemersDisjkstra (tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL)) diff --git a/src/Kupo/Data/Cardano/BinaryData.hs b/src/Kupo/Data/Cardano/BinaryData.hs index fae48be..b500b3c 100644 --- a/src/Kupo/Data/Cardano/BinaryData.hs +++ b/src/Kupo/Data/Cardano/BinaryData.hs @@ -12,7 +12,7 @@ import qualified Data.Aeson as Json import qualified Data.Aeson.Encoding as Json type BinaryData = - Ledger.BinaryData ConwayEra + Ledger.BinaryData DijkstraEra type BinaryDataHash = DatumHash @@ -66,6 +66,7 @@ fromBabbageData -> BinaryData fromBabbageData = Ledger.dataToBinaryData + . (Ledger.upgradeData :: Ledger.Data ConwayEra -> Ledger.Data DijkstraEra) . Ledger.upgradeData {-# INLINEABLE fromBabbageData #-} @@ -73,5 +74,12 @@ fromConwayData :: Ledger.Data ConwayEra -> BinaryData fromConwayData = - Ledger.dataToBinaryData + Ledger.dataToBinaryData . Ledger.upgradeData {-# INLINEABLE fromConwayData #-} + +fromDijkstraData + :: Ledger.Data DijkstraEra + -> BinaryData +fromDijkstraData = + Ledger.dataToBinaryData +{-# INLINEABLE fromDijkstraData #-} diff --git a/src/Kupo/Data/Cardano/Datum.hs b/src/Kupo/Data/Cardano/Datum.hs index d4de93a..db9788d 100644 --- a/src/Kupo/Data/Cardano/Datum.hs +++ b/src/Kupo/Data/Cardano/Datum.hs @@ -18,24 +18,25 @@ data Datum | Inline !(Either DatumHash BinaryData) deriving (Generic, Show, Eq, Ord) -toConwayDatum + +fromDijkstraDatum + :: Ledger.Datum DijkstraEra + -> Datum +fromDijkstraDatum = \case + Ledger.NoDatum -> NoDatum + Ledger.DatumHash ref -> Reference (Left ref) + Ledger.Datum bin -> Inline (Right bin) + +toDijkstraDatum :: Datum - -> Ledger.Datum ConwayEra -toConwayDatum = \case + -> Ledger.Datum DijkstraEra +toDijkstraDatum = \case NoDatum -> Ledger.NoDatum Reference (Left ref) -> Ledger.DatumHash ref Reference (Right bin) -> Ledger.Datum bin Inline (Left ref) -> Ledger.DatumHash ref Inline (Right bin) -> Ledger.Datum bin -fromConwayDatum - :: Ledger.Datum ConwayEra - -> Datum -fromConwayDatum = \case - Ledger.NoDatum -> NoDatum - Ledger.DatumHash ref -> Reference (Left ref) - Ledger.Datum bin -> Inline (Right bin) - getBinaryData :: Datum -> Maybe BinaryData diff --git a/src/Kupo/Data/Cardano/Metadata.hs b/src/Kupo/Data/Cardano/Metadata.hs index ef34b67..95be51b 100644 --- a/src/Kupo/Data/Cardano/Metadata.hs +++ b/src/Kupo/Data/Cardano/Metadata.hs @@ -33,6 +33,7 @@ import Ouroboros.Consensus.Util import qualified Cardano.Ledger.Allegra.Scripts as Ledger.Allegra import qualified Cardano.Ledger.Api.Era as Ledger import qualified Cardano.Ledger.Core as Ledger +import qualified Cardano.Ledger.Dijkstra.Scripts as Ledger.Dijkstra import qualified Cardano.Ledger.Shelley.TxAuxData as Ledger import qualified Data.Aeson as Json import qualified Data.Aeson.Encoding as Json @@ -45,7 +46,7 @@ import qualified Data.Text as T import qualified Data.Text.Read as T type Metadata = - AlonzoTxAuxData ConwayEra + AlonzoTxAuxData DijkstraEra emptyMetadata :: Metadata emptyMetadata = @@ -73,7 +74,7 @@ metadataToText = metadataFromText :: Text -> Maybe Metadata metadataFromText txt = do bytes <- eitherToMaybe $ decodeBase16 (encodeUtf8 txt) - eitherToMaybe $ decodeCborAnn @ConwayEra "Metadata" decCBOR (toLazy bytes) + eitherToMaybe $ decodeCborAnn @DijkstraEra "Metadata" decCBOR (toLazy bytes) metadataToJson :: Metadata -> Json.Encoding metadataToJson (AlonzoTxAuxData labels _ _) = @@ -171,27 +172,27 @@ fromShelleyMetadata (ShelleyTxAuxData labels) = fromAllegraMetadata :: AllegraTxAuxData AllegraEra -> Metadata fromAllegraMetadata (AllegraTxAuxData labels timelocks) = - AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) mempty + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock <$> timelocks) mempty {-# INLINABLE fromAllegraMetadata #-} fromMaryMetadata :: AllegraTxAuxData MaryEra -> Metadata fromMaryMetadata (AllegraTxAuxData labels timelocks) = - AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) mempty + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock <$> timelocks) mempty {-# INLINABLE fromMaryMetadata #-} fromAlonzoMetadata :: AlonzoTxAuxData AlonzoEra -> Metadata fromAlonzoMetadata = - Ledger.upgradeTxAuxData . Ledger.upgradeTxAuxData + fromConwayMetadata . Ledger.upgradeTxAuxData . Ledger.upgradeTxAuxData {-# INLINABLE fromAlonzoMetadata #-} fromBabbageMetadata :: AlonzoTxAuxData BabbageEra -> Metadata fromBabbageMetadata = - Ledger.upgradeTxAuxData + fromConwayMetadata . Ledger.upgradeTxAuxData {-# INLINABLE fromBabbageMetadata #-} fromConwayMetadata :: AlonzoTxAuxData ConwayEra -> Metadata -fromConwayMetadata = - identity +fromConwayMetadata (AlonzoTxAuxData labels timelocks plutus) = + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock <$> timelocks) plutus {-# INLINABLE fromConwayMetadata #-} -- diff --git a/src/Kupo/Data/Cardano/NativeScript.hs b/src/Kupo/Data/Cardano/NativeScript.hs index 76d9dca..3283f8b 100644 --- a/src/Kupo/Data/Cardano/NativeScript.hs +++ b/src/Kupo/Data/Cardano/NativeScript.hs @@ -18,6 +18,7 @@ import Cardano.Ledger.Keys ) import qualified Cardano.Ledger.Allegra.Scripts as Ledger.Allegra +import qualified Cardano.Ledger.Dijkstra.Scripts as Ledger.Dijkstra import qualified Cardano.Ledger.Shelley.Scripts as Ledger.Shelley -type NativeScript = Ledger.Allegra.Timelock ConwayEra +type NativeScript = Ledger.Dijkstra.DijkstraNativeScript DijkstraEra diff --git a/src/Kupo/Data/Cardano/Output.hs b/src/Kupo/Data/Cardano/Output.hs index c51bf07..af34b6a 100644 --- a/src/Kupo/Data/Cardano/Output.hs +++ b/src/Kupo/Data/Cardano/Output.hs @@ -17,8 +17,8 @@ import Kupo.Data.Cardano.Address ) import Kupo.Data.Cardano.Datum ( Datum - , fromConwayDatum - , toConwayDatum + , fromDijkstraDatum + , toDijkstraDatum ) import Kupo.Data.Cardano.Script ( ComparableScript @@ -53,7 +53,7 @@ import qualified Data.Map as Map -- Output type Output = - Ledger.Babbage.BabbageTxOut ConwayEra + Ledger.Babbage.BabbageTxOut DijkstraEra mkOutput :: Address @@ -65,7 +65,7 @@ mkOutput address value datum script = Ledger.Babbage.BabbageTxOut address value - (toConwayDatum datum) + (toDijkstraDatum datum) (maybeToStrictMaybe script) {-# INLINABLE mkOutput #-} @@ -116,9 +116,16 @@ fromBabbageOutput :: Ledger.Core.TxOut BabbageEra -> Output fromBabbageOutput = - Ledger.Core.upgradeTxOut + Ledger.Core.upgradeTxOut . Ledger.Core.upgradeTxOut {-# INLINABLE fromBabbageOutput #-} +fromConwayOutput + :: Ledger.Core.TxOut ConwayEra + -> Output +fromConwayOutput = + Ledger.Core.upgradeTxOut +{-# INLINABLE fromConwayOutput #-} + getAddress :: Output -> Address @@ -137,7 +144,7 @@ getDatum :: Output -> Datum getDatum (Ledger.Babbage.BabbageTxOut _address _value datum _refScript) = - fromConwayDatum datum + fromDijkstraDatum datum {-# INLINABLE getDatum #-} getScript diff --git a/src/Kupo/Data/Cardano/Redeemers.hs b/src/Kupo/Data/Cardano/Redeemers.hs index 55d7080..fc985c7 100644 --- a/src/Kupo/Data/Cardano/Redeemers.hs +++ b/src/Kupo/Data/Cardano/Redeemers.hs @@ -7,6 +7,7 @@ import Kupo.Data.Cardano.BinaryData , fromAlonzoData , fromBabbageData , fromConwayData + , fromDijkstraData ) import Kupo.Data.Cardano.OutputIndex ( InputIndex @@ -15,12 +16,14 @@ import Kupo.Data.Cardano.OutputIndex import qualified Cardano.Ledger.Alonzo.Scripts as Ledger import qualified Cardano.Ledger.Alonzo.TxWits as Ledger import qualified Cardano.Ledger.Conway.Scripts as Ledger +import qualified Cardano.Ledger.Dijkstra.Scripts as Ledger import qualified Data.Map as Map data Redeemers = RedeemersAlonzo (Ledger.Redeemers AlonzoEra) | RedeemersBabbage (Ledger.Redeemers BabbageEra) | RedeemersConway (Ledger.Redeemers ConwayEra) + | RedeemersDisjkstra (Ledger.Redeemers DijkstraEra) lookupSpendRedeemer :: InputIndex @@ -36,3 +39,6 @@ lookupSpendRedeemer ix = \case RedeemersConway (Ledger.Redeemers redeemers) -> let purpose = Ledger.ConwaySpending (Ledger.AsIx (fromIntegral ix)) in fromConwayData . fst <$> Map.lookup purpose redeemers + RedeemersDisjkstra (Ledger.Redeemers redeemers) -> + let purpose = Ledger.DijkstraSpending (Ledger.AsIx (fromIntegral ix)) + in fromDijkstraData . fst <$> Map.lookup purpose redeemers diff --git a/src/Kupo/Data/Cardano/Script.hs b/src/Kupo/Data/Cardano/Script.hs index 8b04a94..bf7ddd0 100644 --- a/src/Kupo/Data/Cardano/Script.hs +++ b/src/Kupo/Data/Cardano/Script.hs @@ -27,6 +27,7 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Ledger.Alonzo import qualified Cardano.Ledger.Alonzo.TxAuxData as Ledger.Alonzo import qualified Cardano.Ledger.Binary.Plain as Ledger import qualified Cardano.Ledger.Core as Ledger.Core +import qualified Cardano.Ledger.Dijkstra.Scripts as Ledger.Dijkstra import qualified Cardano.Ledger.Plutus.Language as Ledger import qualified Codec.CBOR.Decoding as Cbor @@ -37,7 +38,7 @@ import qualified Data.ByteString as BS import qualified Data.Map as Map type Script = - Ledger.Alonzo.Script ConwayEra + Ledger.Alonzo.Script DijkstraEra scriptFromAllegraAuxiliaryData :: forall era. @@ -75,14 +76,14 @@ fromAllegraScript :: Ledger.Allegra.Timelock AllegraEra -> Script fromAllegraScript = - Ledger.Alonzo.NativeScript . Ledger.Allegra.translateTimelock + Ledger.Alonzo.NativeScript . Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock {-# INLINABLE fromAllegraScript #-} fromMaryScript :: Ledger.Allegra.Timelock MaryEra -> Script fromMaryScript = - Ledger.Alonzo.NativeScript . Ledger.Allegra.translateTimelock + Ledger.Alonzo.NativeScript . Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock {-# INLINABLE fromMaryScript #-} fromAlonzoScript @@ -96,14 +97,14 @@ fromBabbageScript :: Ledger.Alonzo.Script BabbageEra -> Script fromBabbageScript = - Ledger.Core.upgradeScript + Ledger.Core.upgradeScript . Ledger.Core.upgradeScript {-# INLINABLE fromBabbageScript #-} fromConwayScript :: Ledger.Alonzo.Script ConwayEra -> Script fromConwayScript = - identity + Ledger.Core.upgradeScript {-# INLINABLE fromConwayScript #-} scriptToJson @@ -154,7 +155,7 @@ scriptFromBytes (toLazy -> bytes) = (script, tag) <- left (DecoderErrorDeserialiseFailure "Script") $ Cbor.deserialiseFromBytes Cbor.decodeWord8 bytes case tag of - 0 -> Ledger.Alonzo.NativeScript <$> decodeCborAnn @BabbageEra "Timelock" decCBOR script + 0 -> Ledger.Alonzo.NativeScript <$> decodeCborAnn @DijkstraEra "DijkstraNativeScript" decCBOR script 1 -> plutusScript Ledger.PlutusV1 script 2 -> plutusScript Ledger.PlutusV2 script 3 -> plutusScript Ledger.PlutusV3 script @@ -168,7 +169,7 @@ scriptFromBytes (toLazy -> bytes) = script = maybeToRight (Ledger.DecoderErrorCustom "Incompatible language and era" $ show (lang, uplc)) - (Ledger.Alonzo.mkBinaryPlutusScript @Maybe @ConwayEra lang uplc) + (Ledger.Alonzo.mkBinaryPlutusScript @Maybe @DijkstraEra lang uplc) in Ledger.Alonzo.PlutusScript <$> script @@ -183,7 +184,7 @@ hashScript :: Script -> ScriptHash hashScript = - Ledger.Core.hashScript @ConwayEra + Ledger.Core.hashScript @DijkstraEra {-# INLINABLE hashScript #-} newtype ComparableScript = ComparableScript { unComparableScript :: Script } diff --git a/src/Kupo/Data/Cardano/Transaction.hs b/src/Kupo/Data/Cardano/Transaction.hs index 9b91efa..87fc759 100644 --- a/src/Kupo/Data/Cardano/Transaction.hs +++ b/src/Kupo/Data/Cardano/Transaction.hs @@ -34,6 +34,8 @@ data Transaction !(Ledger.Tx Ledger.TopTx BabbageEra) | TransactionConway !(Ledger.Tx Ledger.TopTx ConwayEra) + | TransactionDijkstra + !(Ledger.Tx Ledger.TopTx DijkstraEra) instance HasTransactionId Transaction where getTransactionId = \case @@ -51,3 +53,5 @@ instance HasTransactionId Transaction where Ledger.txIdTx @BabbageEra tx TransactionConway tx -> Ledger.txIdTx @ConwayEra tx + TransactionDijkstra tx -> + Ledger.txIdTx @DijkstraEra tx diff --git a/src/Kupo/Data/Hydra.hs b/src/Kupo/Data/Hydra.hs index b9b9cc3..dfa54ef 100644 --- a/src/Kupo/Data/Hydra.hs +++ b/src/Kupo/Data/Hydra.hs @@ -12,9 +12,6 @@ import Cardano.Crypto.Hash import Cardano.Ledger.Alonzo.Scripts ( AsIx (..) ) -import Cardano.Ledger.Conway.Scripts - ( ConwayPlutusPurpose (..) - ) import Cardano.Ledger.Alonzo.TxWits ( unRedeemers , unTxDats @@ -28,6 +25,9 @@ import Cardano.Ledger.Api , scriptTxWitsL , witsTxL ) +import Cardano.Ledger.Conway.Scripts + ( ConwayPlutusPurpose (..) + ) import Cardano.Ledger.Core ( TopTx ) @@ -53,6 +53,7 @@ import Kupo.Data.Cardano , Value , binaryDataFromBytes , fromConwayData + , fromConwayOutput , fromConwayScript , getOutputIndex , getTransactionId @@ -202,7 +203,7 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do let body' = tx ^. bodyTxL let id = Ledger.txIdTxBody body' let wits' = tx ^. witsTxL - let outputs' = toList (body' ^. outputsTxBodyL) + let outputs' = toList (fromConwayOutput <$> body' ^. outputsTxBodyL) pure PartialTransaction { id diff --git a/src/Kupo/Prelude.hs b/src/Kupo/Prelude.hs index 2cf2165..36e956c 100644 --- a/src/Kupo/Prelude.hs +++ b/src/Kupo/Prelude.hs @@ -75,6 +75,7 @@ module Kupo.Prelude , AlonzoEra , BabbageEra , ConwayEra + , DijkstraEra , MostRecentEra -- * System @@ -111,6 +112,9 @@ import Cardano.Ledger.Core , Era , eraProtVerLow ) +import Cardano.Ledger.Dijkstra + ( DijkstraEra + ) import Cardano.Ledger.Mary ( MaryEra ) From 7f0d7399e68b3e9963efc10457982d23c591cb9d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 21 Sep 2026 12:21:35 -0400 Subject: [PATCH 5/6] reject Dijkstra transactions carrying sub-transactions Sub-transactions have their own ids, inputs and outputs but no phase-2 validity flag; how they are indexed is left to a follow-up. Until then a transaction with a non-empty `subTransactionsTxBodyL` fails loudly rather than silently dropping them. Adds cardano-data for `OMap.null`. --- kupo.cabal | 1 + package.yaml | 1 + src/Kupo/Data/Cardano.hs | 22 +++++++++++++++++++++- 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/kupo.cabal b/kupo.cabal index cee0ea9..39f9adc 100644 --- a/kupo.cabal +++ b/kupo.cabal @@ -186,6 +186,7 @@ library , bytestring , cardano-crypto-class , cardano-crypto-wrapper + , cardano-data , cardano-diffusion , cardano-ledger-allegra , cardano-ledger-alonzo diff --git a/package.yaml b/package.yaml index fae6acf..9868d9d 100644 --- a/package.yaml +++ b/package.yaml @@ -63,6 +63,7 @@ library: - bytestring - cardano-crypto-class - cardano-crypto-wrapper + - cardano-data - cardano-ledger-allegra - cardano-ledger-alonzo - cardano-ledger-api diff --git a/src/Kupo/Data/Cardano.hs b/src/Kupo/Data/Cardano.hs index 3cd5f28..59bcbd7 100644 --- a/src/Kupo/Data/Cardano.hs +++ b/src/Kupo/Data/Cardano.hs @@ -102,6 +102,8 @@ import qualified Cardano.Ledger.Alonzo.Core as Ledger import qualified Cardano.Ledger.Alonzo.TxWits as Ledger import qualified Cardano.Ledger.Babbage.Core as Ledger import qualified Cardano.Ledger.Block as Ledger +import qualified Cardano.Ledger.Dijkstra.Core as Ledger +import qualified Data.OMap.Strict as OMap import qualified Data.Set as Set -- IsBlock @@ -195,7 +197,25 @@ instance IsBlock Block where BlockConway (ShelleyBlock (Ledger.Block _ txs) _) -> foldrWithIndex (\ix -> fn ix . TransactionConway) result (txs ^. Ledger.txSeqBlockBodyL) BlockDijkstra (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionDijkstra) result (txs ^. Ledger.txSeqBlockBodyL) + foldrWithIndex (\ix -> fn ix . TransactionDijkstra . rejectSubTransactions) result (txs ^. Ledger.txSeqBlockBodyL) + where + -- Dijkstra introduces nested transactions: a top-level transaction may + -- carry sub-transactions, each with its own id, inputs and outputs but + -- no phase-2 validity flag or collateral of its own. Kupo folds one flat + -- sequence of transactions per block and stores the resulting index on + -- every output reference, so how sub-transactions are numbered (and how + -- a phase-2 invalid parent affects them) is a design decision that has + -- not been made yet. Until it is, fail loudly rather than silently + -- dropping their inputs and outputs from the index. + rejectSubTransactions + :: Ledger.Tx Ledger.TopTx DijkstraEra + -> Ledger.Tx Ledger.TopTx DijkstraEra + rejectSubTransactions tx + | OMap.null (tx ^. Ledger.bodyTxL . Ledger.subTransactionsTxBodyL) = + tx + | otherwise = + error $ "kupo: Dijkstra transaction " <> show (Ledger.txIdTx @DijkstraEra tx) + <> " carries sub-transactions, which kupo does not index yet." spentInputs :: Transaction From bfe2dad01c5bfcbe3cd753da9311b1d47b7ffd9c Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 25 Sep 2026 11:59:59 -0400 Subject: [PATCH 6/6] nix: bump hackageNix and CHaP inputs to cover new index-states --- flake.lock | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/flake.lock b/flake.lock index b2d430a..cd1994e 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1778248807, - "narHash": "sha256-LI4R+Yl7cy9uO/jWXpo93mUyVMR/UhOoDFVbHV7/abw=", + "lastModified": 1790211900, + "narHash": "sha256-o/e7qqnyMNMEht+0yZiGQQ6EhE9opeiSSvvxa8CYUy4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "61c9835abcfc3a6c9b6279226d4502fa877bb6a7", + "rev": "315bf143ebaaaefdb3917131d6cb08e8d35a8178", "type": "github" }, "original": { @@ -171,11 +171,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1779824738, - "narHash": "sha256-o4W05VYZ0hlIA/BXxL6hYsQ9HL6JsawxepFnCh429R8=", + "lastModified": 1790350404, + "narHash": "sha256-gAkFrvMBN1Zbj5LzBkqaTpmi4q4CjSFsx8MZk4SPlk0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "decbe184cfce30ea802ea95c874511f776a4b48a", + "rev": "7ccc0d13ae4744e9795964070eabc0a50da7e4bd", "type": "github" }, "original": {