From e108079d5f7890438259297839292d2c3a1e1530 Mon Sep 17 00:00:00 2001 From: John Lotoski Date: Tue, 12 May 2026 19:17:06 -0500 Subject: [PATCH 01/11] bump: dependencies for cardano-node 11.0 Update cabal.project constraints and index-state for cardano-node 11.0.1 (ouroboros-consensus 3.0.1, cardano-ledger-conway >= 1.22.1). Pin validation < 1.2 to avoid breaking API change. Update ogmios source-repository-package to rebased node-11.0 branch. Bump dependency bounds in package.yaml. Co-Authored-By: Claude --- cabal.project | 31 +++++++++++++++++-------------- kupo.cabal | 16 ++++++++-------- package.yaml | 14 +++++++------- 3 files changed, 32 insertions(+), 29 deletions(-) diff --git a/cabal.project b/cabal.project index bab3c3d2..b5ad4714 100644 --- a/cabal.project +++ b/cabal.project @@ -10,8 +10,8 @@ repository cardano-haskell-packages d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee index-state: - , hackage.haskell.org 2025-09-11T07:59:00Z - , cardano-haskell-packages 2025-09-11T08:36:14Z + , hackage.haskell.org 2026-05-08T22:40:19Z + , cardano-haskell-packages 2026-05-08T13:26:45Z packages: ./ @@ -46,34 +46,37 @@ package direct-sqlite flags: +nomutex constraints: - , any.cardano-node == 10.5.1 + , any.cardano-node == 11.0.1 - , any.cardano-ledger-core == 1.17.0.0 - , any.cardano-ledger-shelley == 1.16.0.0 - , any.cardano-ledger-conway == 1.19.0.0 + , any.cardano-ledger-conway >= 1.22.1.0 - , any.ouroboros-consensus == 0.27.0.0 - , any.ouroboros-consensus-cardano == 0.25.1.0 - , any.ouroboros-network == 0.21.3.0 + , any.ouroboros-consensus ^>= 3.0.1 + , any.ouroboros-network ^>= 1.1 - , any.io-classes == 1.5.0.0 - , any.io-classes-mtl == 0.1.2.0 + , 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 + , any.blockio +serialblockio + , direct-sqlite == 2.3.29.1 , sqlite-simple == 0.4.19.0.1 allow-newer: *:formatting + , katip:Win32 + , io-sim:time + , 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 source-repository-package type: git - location: https://github.com/CardanoSolutions/ogmios - tag: ae876badb138f42dcd6d2389734b0c15502684ed - --sha256: xkOfOdX6Dxi7+VW78Tk3n3MoguIg39pKdxiNVfdeEwE= + location: https://github.com/johnalotoski/ogmios + --sha256: sha256-OjABxe/ICHIkb+5jQI7chCrwnQ2W1oVO02Zxu9yLUKU= + tag: ea80df1204f830050436facdae4287cf674892e5 subdir: server/modules/fast-bech32 diff --git a/kupo.cabal b/kupo.cabal index 3192190a..130f18ff 100644 --- a/kupo.cabal +++ b/kupo.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 3.0 -- This file has been generated from package.yaml by hpack version 0.38.2. -- @@ -214,13 +214,13 @@ library , modern-uri , network-mux , optparse-applicative + , cardano-diffusion , ouroboros-consensus - , ouroboros-consensus-cardano - , ouroboros-consensus-diffusion - , ouroboros-network - , ouroboros-network-api - , ouroboros-network-framework - , ouroboros-network-protocols + , ouroboros-consensus:cardano + , ouroboros-consensus:diffusion + , ouroboros-network:api + , ouroboros-network:framework + , ouroboros-network:protocols , prometheus , relude , resource-pool @@ -395,7 +395,7 @@ test-suite unit , process , quickcheck-state-machine , relude - , si-timers + , io-classes:si-timers , sqlite-simple , stm , temporary diff --git a/package.yaml b/package.yaml index fb57ab51..307c932d 100644 --- a/package.yaml +++ b/package.yaml @@ -93,13 +93,13 @@ library: - modern-uri - network-mux - optparse-applicative + - cardano-diffusion - ouroboros-consensus - - ouroboros-consensus-cardano - - ouroboros-consensus-diffusion - - ouroboros-network - - ouroboros-network-api - - ouroboros-network-framework - - ouroboros-network-protocols + - ouroboros-consensus:cardano + - ouroboros-consensus:diffusion + - ouroboros-network:api + - ouroboros-network:framework + - ouroboros-network:protocols - prometheus - relude - resource-pool @@ -146,7 +146,7 @@ tests: - QuickCheck - quickcheck-state-machine - relude - - si-timers + - io-classes:si-timers - sqlite-simple - stm - temporary From 57a2da989cf773ebc91836fe5c99763a10ecac3b Mon Sep 17 00:00:00 2001 From: John Lotoski Date: Tue, 12 May 2026 19:22:08 -0500 Subject: [PATCH 02/11] update: add Dijkstra era support for cardano-node 11.0 Add BlockDijkstra and DijkstraEra pattern matches across block processing, scripts, transactions, and Hydra/Ogmios modules. Dijkstra transactions are coerced to Conway at the block-processing boundary since the types are representationally identical. Replace unsafeCoerce in Metadata era translation with explicit pattern match and translateTimelock. Update Prelude era list and codec config. Co-Authored-By: Claude --- src/Kupo/Control/MonadOuroboros.hs | 8 ++++--- src/Kupo/Data/Cardano.hs | 24 +++++++++++++++------ src/Kupo/Data/Cardano/AssetName.hs | 4 ---- src/Kupo/Data/Cardano/Metadata.hs | 17 +++++++-------- src/Kupo/Data/Cardano/Point.hs | 2 +- src/Kupo/Data/Cardano/Script.hs | 29 ++++++++++++------------- src/Kupo/Data/Cardano/Transaction.hs | 32 +++++++++++----------------- src/Kupo/Data/Hydra.hs | 24 +++++++++++---------- src/Kupo/Data/Ogmios.hs | 1 + src/Kupo/Prelude.hs | 13 ++++++++--- 10 files changed, 81 insertions(+), 73 deletions(-) diff --git a/src/Kupo/Control/MonadOuroboros.hs b/src/Kupo/Control/MonadOuroboros.hs index 7583f437..61bec00c 100644 --- a/src/Kupo/Control/MonadOuroboros.hs +++ b/src/Kupo/Control/MonadOuroboros.hs @@ -35,6 +35,7 @@ import Kupo.Control.MonadThrow import Network.Mux ( StartOnDemandOrEagerly (..) ) +import qualified Network.Mux import Ouroboros.Consensus.Byron.Ledger.Config ( CodecConfig (..) ) @@ -74,7 +75,7 @@ import Ouroboros.Network.Mux , OuroborosApplication (..) , RunMiniProtocol (..) ) -import Ouroboros.Network.NodeToClient +import Cardano.Network.NodeToClient ( NetworkConnectTracers (..) , NodeToClientVersion (..) , NodeToClientVersionData (..) @@ -119,7 +120,7 @@ instance MonadOuroboros IO where connectTo (mkLocalSnocket iocp) tracers versions socket >>= either throwIO return where tracers = NetworkConnectTracers - { nctMuxTracer = nullTracer + { nctMuxTracers = Network.Mux.nullTracers , nctHandshakeTracer = nullTracer } @@ -167,7 +168,7 @@ codecs epochSlots nodeToClientV = supportedVersions = supportedNodeToClientVersions (Proxy @(BlockT IO)) cfg = - CardanoCodecConfig byron shelley allegra mary alonzo babbage conway + CardanoCodecConfig byron shelley allegra mary alonzo babbage conway dijkstra where byron = ByronCodecConfig epochSlots shelley = ShelleyCodecConfig @@ -176,3 +177,4 @@ codecs epochSlots nodeToClientV = alonzo = ShelleyCodecConfig babbage = ShelleyCodecConfig conway = ShelleyCodecConfig + dijkstra = ShelleyCodecConfig diff --git a/src/Kupo/Data/Cardano.hs b/src/Kupo/Data/Cardano.hs index 59e9ed16..635cff7e 100644 --- a/src/Kupo/Data/Cardano.hs +++ b/src/Kupo/Data/Cardano.hs @@ -97,9 +97,12 @@ import Kupo.Data.Cardano.TransactionId import Kupo.Data.Cardano.TransactionIndex import Kupo.Data.Cardano.Value +import Unsafe.Coerce + ( unsafeCoerce + ) + import qualified Cardano.Chain.UTxO as Ledger.Byron import qualified Cardano.Ledger.Alonzo.Core as Ledger -import qualified Cardano.Ledger.Alonzo.Tx 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 @@ -184,17 +187,24 @@ instance IsBlock Block where in foldrWithIndex ignoreProtocolTxs result (extractTxs blk) BlockShelley (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionShelley) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionShelley) result (txs ^. Ledger.txSeqBlockBodyL) BlockAllegra (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionAllegra) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionAllegra) result (txs ^. Ledger.txSeqBlockBodyL) BlockMary (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionMary) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionMary) result (txs ^. Ledger.txSeqBlockBodyL) BlockAlonzo (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionAlonzo) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionAlonzo) result (txs ^. Ledger.txSeqBlockBodyL) BlockBabbage (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionBabbage) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionBabbage) result (txs ^. Ledger.txSeqBlockBodyL) BlockConway (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionConway) result (Ledger.fromTxSeq txs) + foldrWithIndex (\ix -> fn ix . TransactionConway) result (txs ^. Ledger.txSeqBlockBodyL) + -- NOTE: DijkstraEra transactions are representationally identical to + -- ConwayEra but use nominally distinct data family instances, so coerce + -- is not available. We unsafeCoerce to reuse TransactionConway rather + -- than adding a TransactionDijkstra constructor that would duplicate + -- all Conway handling throughout the codebase. + BlockDijkstra (ShelleyBlock (Ledger.Block _ txs) _) -> + foldrWithIndex (\ix -> fn ix . TransactionConway . unsafeCoerce) result (txs ^. Ledger.txSeqBlockBodyL) spentInputs :: Transaction diff --git a/src/Kupo/Data/Cardano/AssetName.hs b/src/Kupo/Data/Cardano/AssetName.hs index ccb3f5ac..e0c6927c 100644 --- a/src/Kupo/Data/Cardano/AssetName.hs +++ b/src/Kupo/Data/Cardano/AssetName.hs @@ -2,10 +2,6 @@ module Kupo.Data.Cardano.AssetName where import Kupo.Prelude -import Ouroboros.Consensus.Util - ( eitherToMaybe - ) - import qualified Cardano.Ledger.Mary.Value as Ledger import qualified Data.ByteString as BS diff --git a/src/Kupo/Data/Cardano/Metadata.hs b/src/Kupo/Data/Cardano/Metadata.hs index 9abf0456..bcc2561a 100644 --- a/src/Kupo/Data/Cardano/Metadata.hs +++ b/src/Kupo/Data/Cardano/Metadata.hs @@ -22,12 +22,7 @@ import Kupo.Data.Cardano.MetadataHash ( MetadataHash , metadataHashToJson ) -import Ouroboros.Consensus.Util - ( eitherToMaybe - ) - import qualified Cardano.Ledger.Allegra.Scripts as Ledger.Allegra -import qualified Cardano.Ledger.Alonzo.TxAuxData as Ledger.Alonzo import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Shelley.TxAuxData as Ledger import qualified Data.Aeson as Json @@ -39,6 +34,10 @@ import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Read as T +-- NOTE: Kept as ConwayEra rather than DijkstraEra because Dijkstra +-- transactions are coerced to Conway at the block-processing boundary +-- (see Kupo.Data.Cardano). The two eras share identical representations +-- for AlonzoTxAuxData, so the choice is cosmetic. type Metadata = AlonzoTxAuxData ConwayEra @@ -175,13 +174,13 @@ fromMaryMetadata (AllegraTxAuxData labels timelocks) = {-# INLINABLE fromMaryMetadata #-} fromAlonzoMetadata :: AlonzoTxAuxData AlonzoEra -> Metadata -fromAlonzoMetadata = - Ledger.Alonzo.translateAlonzoTxAuxData +fromAlonzoMetadata (AlonzoTxAuxData labels timelocks scripts) = + AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) scripts {-# INLINABLE fromAlonzoMetadata #-} fromBabbageMetadata :: AlonzoTxAuxData BabbageEra -> Metadata -fromBabbageMetadata = - Ledger.upgradeTxAuxData +fromBabbageMetadata (AlonzoTxAuxData labels timelocks scripts) = + AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) scripts {-# INLINABLE fromBabbageMetadata #-} fromConwayMetadata :: AlonzoTxAuxData ConwayEra -> Metadata diff --git a/src/Kupo/Data/Cardano/Point.hs b/src/Kupo/Data/Cardano/Point.hs index 6c1ab358..2a14f9e0 100644 --- a/src/Kupo/Data/Cardano/Point.hs +++ b/src/Kupo/Data/Cardano/Point.hs @@ -45,7 +45,7 @@ import qualified Ouroboros.Network.Block as Ouroboros type Point = Ouroboros.Point Block -instance ToJSON Point where +instance {-# OVERLAPPING #-} ToJSON Point where toJSON = error "ToJSON Point called instead of 'toEncoding'." toEncoding = pointToJson diff --git a/src/Kupo/Data/Cardano/Script.hs b/src/Kupo/Data/Cardano/Script.hs index 6e18f464..95930b47 100644 --- a/src/Kupo/Data/Cardano/Script.hs +++ b/src/Kupo/Data/Cardano/Script.hs @@ -16,10 +16,6 @@ import Kupo.Data.Cardano.NativeScript import Kupo.Data.Cardano.ScriptHash ( ScriptHash ) -import Ouroboros.Consensus.Util - ( eitherToMaybe - ) - import qualified Cardano.Ledger.Allegra.Scripts as Ledger.Allegra import qualified Cardano.Ledger.Allegra.TxAuxData as Ledger.Allegra import qualified Cardano.Ledger.Alonzo as Ledger.Alonzo @@ -42,9 +38,9 @@ type Script = scriptFromAllegraAuxiliaryData :: forall era. ( Ledger.Core.Era era - , Ledger.Core.Script era ~ Ledger.Allegra.Timelock era + , Ledger.Core.NativeScript era ~ Ledger.Allegra.Timelock era ) - => (Ledger.Core.Script era -> Script) + => (Ledger.Allegra.Timelock era -> Script) -> Ledger.Allegra.AllegraTxAuxData era -> Map ScriptHash Script -> Map ScriptHash Script @@ -66,7 +62,7 @@ scriptFromAlonzoAuxiliaryData -> Map ScriptHash Script scriptFromAlonzoAuxiliaryData liftScript (Ledger.Alonzo.AlonzoTxAuxData _ scripts _) m0 = foldr - (\((liftScript . Ledger.Alonzo.TimelockScript) -> s) -> Map.insert (hashScript s) s) + (\((liftScript . Ledger.Alonzo.NativeScript) -> s) -> Map.insert (hashScript s) s) m0 scripts {-# INLINABLE scriptFromAlonzoAuxiliaryData #-} @@ -75,14 +71,14 @@ fromAllegraScript :: Ledger.Allegra.Timelock AllegraEra -> Script fromAllegraScript = - Ledger.Alonzo.TimelockScript . Ledger.Allegra.translateTimelock + Ledger.Alonzo.NativeScript . Ledger.Allegra.translateTimelock {-# INLINABLE fromAllegraScript #-} fromMaryScript :: Ledger.Allegra.Timelock MaryEra -> Script fromMaryScript = - Ledger.Alonzo.TimelockScript . Ledger.Allegra.translateTimelock + Ledger.Alonzo.NativeScript . Ledger.Allegra.translateTimelock {-# INLINABLE fromMaryScript #-} fromAlonzoScript @@ -112,13 +108,14 @@ scriptToJson scriptToJson script = encodeObject [ ("script", encodeBytes (Ledger.Core.originalBytes script)) , ("language", case script of - Ledger.Alonzo.TimelockScript _ -> + Ledger.Alonzo.NativeScript _ -> Json.text "native" Ledger.Alonzo.PlutusScript ps -> case Ledger.Alonzo.plutusScriptLanguage ps of Ledger.PlutusV1 -> Json.text "plutus:v1" Ledger.PlutusV2 -> Json.text "plutus:v2" Ledger.PlutusV3 -> Json.text "plutus:v3" + Ledger.PlutusV4 -> Json.text "plutus:v4" ) ] @@ -128,13 +125,14 @@ scriptToBytes scriptToBytes = let withTag n s = BS.singleton n <> Ledger.Core.originalBytes s in \case - Ledger.Alonzo.TimelockScript script -> + Ledger.Alonzo.NativeScript script -> withTag 0 script Ledger.Alonzo.PlutusScript script -> case Ledger.Alonzo.plutusScriptLanguage script of Ledger.PlutusV1 -> withTag 1 script Ledger.PlutusV2 -> withTag 2 script Ledger.PlutusV3 -> withTag 3 script + Ledger.PlutusV4 -> withTag 4 script unsafeScriptFromBytes :: HasCallStack @@ -150,12 +148,13 @@ scriptFromBytes scriptFromBytes (toLazy -> bytes) = eitherToMaybe $ do (script, tag) <- left (DecoderErrorDeserialiseFailure "Script") $ - Cbor.deserialiseFromBytes Cbor.decodeWord8 bytes + Cbor.deserialiseFromBytes Cbor.decodeWord bytes case tag of - 0 -> Ledger.Alonzo.TimelockScript <$> decodeCborAnn @BabbageEra "Timelock" decCBOR script + 0 -> Ledger.Alonzo.NativeScript <$> decodeCborAnn @BabbageEra "Timelock" decCBOR script 1 -> plutusScript Ledger.PlutusV1 script 2 -> plutusScript Ledger.PlutusV2 script 3 -> plutusScript Ledger.PlutusV3 script + 4 -> plutusScript Ledger.PlutusV4 script t -> Left (DecoderErrorUnknownTag "Script" t) where plutusScript lang s = @@ -165,7 +164,7 @@ scriptFromBytes (toLazy -> bytes) = script = maybeToRight (Ledger.DecoderErrorCustom "Incompatible language and era" $ show (lang, uplc)) - (Ledger.Alonzo.mkBinaryPlutusScript @ConwayEra lang uplc) + (Ledger.Alonzo.mkBinaryPlutusScript lang uplc) in Ledger.Alonzo.PlutusScript <$> script @@ -173,7 +172,7 @@ fromNativeScript :: NativeScript -> Script fromNativeScript = - Ledger.Alonzo.TimelockScript + Ledger.Alonzo.NativeScript {-# INLINABLE fromNativeScript #-} hashScript diff --git a/src/Kupo/Data/Cardano/Transaction.hs b/src/Kupo/Data/Cardano/Transaction.hs index 134a3f4e..19c1ee96 100644 --- a/src/Kupo/Data/Cardano/Transaction.hs +++ b/src/Kupo/Data/Cardano/Transaction.hs @@ -8,9 +8,7 @@ import Kupo.Data.Cardano.TransactionId ) import qualified Cardano.Chain.UTxO as Ledger.Byron -import qualified Cardano.Ledger.Alonzo.Tx as Ledger.Alonzo import qualified Cardano.Ledger.Core as Ledger -import qualified Cardano.Ledger.Shelley.Tx as Ledger.Shelley -- Transaction @@ -20,37 +18,31 @@ data Transaction !Ledger.Byron.Tx !Ledger.Byron.TxId | TransactionShelley - !(Ledger.Shelley.ShelleyTx ShelleyEra) + !(Ledger.Tx Ledger.TopTx ShelleyEra) | TransactionAllegra - !(Ledger.Shelley.ShelleyTx AllegraEra) + !(Ledger.Tx Ledger.TopTx AllegraEra) | TransactionMary - !(Ledger.Shelley.ShelleyTx MaryEra) + !(Ledger.Tx Ledger.TopTx MaryEra) | TransactionAlonzo - !(Ledger.Alonzo.AlonzoTx AlonzoEra) + !(Ledger.Tx Ledger.TopTx AlonzoEra) | TransactionBabbage - !(Ledger.Alonzo.AlonzoTx BabbageEra) + !(Ledger.Tx Ledger.TopTx BabbageEra) | TransactionConway - !(Ledger.Alonzo.AlonzoTx ConwayEra) + !(Ledger.Tx Ledger.TopTx ConwayEra) instance HasTransactionId Transaction where getTransactionId = \case TransactionByron _ i -> transactionIdFromByron i TransactionShelley tx -> - let body = Ledger.Shelley.body tx - in Ledger.txIdTxBody @ShelleyEra body + Ledger.txIdTx @ShelleyEra tx TransactionAllegra tx -> - let body = Ledger.Shelley.body tx - in Ledger.txIdTxBody @AllegraEra body + Ledger.txIdTx @AllegraEra tx TransactionMary tx -> - let body = Ledger.Shelley.body tx - in Ledger.txIdTxBody @MaryEra body + Ledger.txIdTx @MaryEra tx TransactionAlonzo tx -> - let body = Ledger.Alonzo.body tx - in Ledger.txIdTxBody @AlonzoEra body + Ledger.txIdTx @AlonzoEra tx TransactionBabbage tx -> - let body = Ledger.Alonzo.body tx - in Ledger.txIdTxBody @BabbageEra body + Ledger.txIdTx @BabbageEra tx TransactionConway tx -> - let body = Ledger.Alonzo.body tx - in Ledger.txIdTxBody @ConwayEra body + Ledger.txIdTx @ConwayEra tx diff --git a/src/Kupo/Data/Hydra.hs b/src/Kupo/Data/Hydra.hs index 01f0401b..c7aa9a0a 100644 --- a/src/Kupo/Data/Hydra.hs +++ b/src/Kupo/Data/Hydra.hs @@ -10,8 +10,10 @@ import Cardano.Crypto.Hash , hashWith ) import Cardano.Ledger.Alonzo.Scripts - ( AlonzoPlutusPurpose (..) - , AsIx (..) + ( AsIx (..) + ) +import Cardano.Ledger.Conway.Scripts + ( ConwayPlutusPurpose (..) ) import Cardano.Ledger.Alonzo.TxWits ( unRedeemers @@ -26,6 +28,7 @@ import Cardano.Ledger.Api , scriptTxWitsL , witsTxL ) +import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.Hashes ( unsafeMakeSafeHash ) @@ -47,9 +50,7 @@ import Kupo.Data.Cardano , TransactionId , Value , binaryDataFromBytes - , fromBabbageData - , fromBabbageOutput - , fromBabbageScript + , fromConwayData , getOutputIndex , getTransactionId , mkOutput @@ -73,7 +74,6 @@ import Kupo.Data.PartialBlock , PartialTransaction (..) ) -import qualified Cardano.Ledger.Api as Ledger import qualified Codec.CBOR.Decoding as Cbor import qualified Codec.CBOR.Read as Cbor import qualified Data.Aeson.Key as Key @@ -181,7 +181,7 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do bytes <- decodeBase16' hexText - tx <- case decodeCborAnn @ConwayEra "PartialTransaction" decCBOR (fromStrict bytes) of + (tx :: Ledger.Tx Ledger.TopTx ConwayEra) <- case decodeCborAnn @ConwayEra "PartialTransaction" decCBOR (fromStrict bytes) of Left e -> fail $ show e Right tx -> pure tx @@ -198,23 +198,23 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do let body' = tx ^. bodyTxL let id = Ledger.txIdTxBody body' let wits' = tx ^. witsTxL - let outputs' = map fromBabbageOutput $ toList (body' ^. outputsTxBodyL) + let outputs' = toList (body' ^. outputsTxBodyL) pure PartialTransaction { id , inputs = toList (body' ^. inputsTxBodyL) , outputs = withReferences 0 id outputs' - , datums = Map.map fromBabbageData $ unTxDats (wits' ^. datsTxWitsL) + , datums = Map.map fromConwayData $ unTxDats (wits' ^. datsTxWitsL) , spendRedeemers = Map.foldrWithKey (\purpose (redeemer, _) -> case purpose of - AlonzoSpending (AsIx ix) -> Map.insert (fromIntegral ix) (fromBabbageData redeemer) + ConwaySpending (AsIx ix) -> Map.insert (fromIntegral ix) (fromConwayData redeemer) _ -> identity ) mempty (unRedeemers $ wits' ^. rdmrsTxWitsL) - , scripts = Map.map fromBabbageScript (wits' ^. scriptTxWitsL) + , scripts = wits' ^. scriptTxWitsL , metadata = Nothing } @@ -305,6 +305,8 @@ decodeScriptInEnvelope = Json.withObject "ScriptInEnvelope" $ \o -> do scriptFromBytes' (BS.pack [2] <> nestedBytes) "PlutusScriptLanguage PlutusScriptV3" -> scriptFromBytes' (BS.pack [3] <> nestedBytes) + "PlutusScriptLanguage PlutusScriptV4" -> + scriptFromBytes' (BS.pack [4] <> nestedBytes) (_ :: Text) -> fail "unrecognized script language" where diff --git a/src/Kupo/Data/Ogmios.hs b/src/Kupo/Data/Ogmios.hs index 0b24ee28..5f172e40 100644 --- a/src/Kupo/Data/Ogmios.hs +++ b/src/Kupo/Data/Ogmios.hs @@ -325,6 +325,7 @@ decodeScript = Json.withObject "Script" $ \o -> do "plutus:v1" -> decodePlutus "01" =<< o .: "cbor" "plutus:v2" -> decodePlutus "02" =<< o .: "cbor" "plutus:v3" -> decodePlutus "03" =<< o .: "cbor" + "plutus:v4" -> decodePlutus "04" =<< o .: "cbor" (_ :: Text) -> fail "unrecognized script language" where decodeNative = diff --git a/src/Kupo/Prelude.hs b/src/Kupo/Prelude.hs index 6bd04ac6..fc4f858f 100644 --- a/src/Kupo/Prelude.hs +++ b/src/Kupo/Prelude.hs @@ -40,6 +40,7 @@ module Kupo.Prelude , at -- * Extras + , eitherToMaybe , foldrWithIndex , next , nubOn @@ -75,6 +76,7 @@ module Kupo.Prelude , AlonzoEra , BabbageEra , ConwayEra + , DijkstraEra , MostRecentEra -- * System @@ -92,7 +94,7 @@ import Cardano.Crypto.Hash , Hash (..) , HashAlgorithm (..) , hashFromBytes - , sizeHash + , hashSize ) import Cardano.Ledger.Allegra ( AllegraEra @@ -169,7 +171,8 @@ import Ouroboros.Consensus.Cardano.Block ( CardanoEras ) import Ouroboros.Consensus.Shelley.Eras - ( StandardCrypto + ( DijkstraEra + , StandardCrypto ) import Ouroboros.Consensus.Shelley.Ledger ( ShelleyBlock @@ -358,6 +361,10 @@ unsafeDecodeCbor lbl decoder = -- Extras -- +-- | Convert an 'Either' to a 'Maybe', discarding the error. +eitherToMaybe :: Either e a -> Maybe a +eitherToMaybe = either (const Nothing) Just + -- | Remove duplicates from a list based on information extracted from the -- elements. nubOn :: Eq b => (a -> b) -> [a] -> [a] @@ -419,7 +426,7 @@ unsafeHashFromBytes bytes digestSize :: forall alg. HashAlgorithm alg => Int digestSize = - fromIntegral (sizeHash (Proxy @alg)) + fromIntegral (hashSize (Proxy @alg)) {-# INLINABLE digestSize #-} hashToJson :: HashAlgorithm alg => Hash alg a -> Json.Encoding From b6108fa3715fc1bf485b3804546cd36d5dd42cc8 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 13 May 2026 22:42:03 -0500 Subject: [PATCH 03/11] fix: properly support DijkstraEra instead of unsafeCoerce through ConwayEra Replace the unsafeCoerce-based approach to Dijkstra era handling with proper TransactionDijkstra constructors and explicit era conversion functions. Change the Metadata, Output, Script, and BinaryData type aliases from ConwayEra to DijkstraEra and add the necessary upgrade paths through all era conversion functions using Ledger.Dijkstra.upgradeTimelock. Add cardano-ledger-dijkstra as an explicit dependency. Co-Authored-By: Claude --- kupo.cabal | 13 +++++-- package.yaml | 1 + src/Kupo/Data/Cardano.hs | 54 ++++++++++++++++++++++------ src/Kupo/Data/Cardano/BinaryData.hs | 23 ++++++++++++ src/Kupo/Data/Cardano/Datum.hs | 20 +++++++++++ src/Kupo/Data/Cardano/Metadata.hs | 30 ++++++++-------- src/Kupo/Data/Cardano/Output.hs | 26 ++++++++++---- src/Kupo/Data/Cardano/Redeemers.hs | 6 ++++ src/Kupo/Data/Cardano/Script.hs | 24 ++++++++----- src/Kupo/Data/Cardano/Transaction.hs | 4 +++ src/Kupo/Data/Hydra.hs | 6 ++-- 11 files changed, 163 insertions(+), 44 deletions(-) diff --git a/kupo.cabal b/kupo.cabal index 130f18ff..9beb2672 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 @@ -214,7 +218,6 @@ library , modern-uri , network-mux , optparse-applicative - , cardano-diffusion , ouroboros-consensus , ouroboros-consensus:cardano , ouroboros-consensus:diffusion @@ -255,6 +258,8 @@ executable kupo main-is: Main.hs other-modules: Paths_kupo + autogen-modules: + Paths_kupo hs-source-dirs: app default-extensions: @@ -332,6 +337,8 @@ test-suite unit Test.Kupo.OptionsSpec Test.KupoSpec Paths_kupo + autogen-modules: + Paths_kupo hs-source-dirs: test default-extensions: @@ -388,6 +395,7 @@ test-suite unit , http-media , http-types , io-classes + , io-classes:si-timers , io-sim , kupo , lens-aeson @@ -395,7 +403,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 307c932d..fae6acf4 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 635cff7e..64d49adb 100644 --- a/src/Kupo/Data/Cardano.hs +++ b/src/Kupo/Data/Cardano.hs @@ -97,10 +97,6 @@ import Kupo.Data.Cardano.TransactionId import Kupo.Data.Cardano.TransactionIndex import Kupo.Data.Cardano.Value -import Unsafe.Coerce - ( unsafeCoerce - ) - import qualified Cardano.Chain.UTxO as Ledger.Byron import qualified Cardano.Ledger.Alonzo.Core as Ledger import qualified Cardano.Ledger.Alonzo.TxWits as Ledger @@ -198,13 +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) - -- NOTE: DijkstraEra transactions are representationally identical to - -- ConwayEra but use nominally distinct data family instances, so coerce - -- is not available. We unsafeCoerce to reuse TransactionConway rather - -- than adding a TransactionDijkstra constructor that would duplicate - -- all Conway handling throughout the codebase. BlockDijkstra (ShelleyBlock (Ledger.Block _ txs) _) -> - foldrWithIndex (\ix -> fn ix . TransactionConway . unsafeCoerce) result (txs ^. Ledger.txSeqBlockBodyL) + foldrWithIndex (\ix -> fn ix . TransactionDijkstra) result (txs ^. Ledger.txSeqBlockBodyL) spentInputs :: Transaction @@ -236,6 +227,12 @@ instance IsBlock Block where tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL Ledger.IsValid False -> tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL + TransactionDijkstra tx -> + case tx ^. Ledger.isValidTxL of + Ledger.IsValid True -> + tx ^. Ledger.bodyTxL . Ledger.inputsTxBodyL + Ledger.IsValid False -> + tx ^. Ledger.bodyTxL . Ledger.collateralInputsTxBodyL where transformByron (Ledger.Byron.TxInUtxo txId ix) = mkOutputReference @@ -319,12 +316,29 @@ instance IsBlock Block where in case tx ^. Ledger.isValidTxL of Ledger.IsValid True -> - traverseAndTransform identity txId meta 0 outs + traverseAndTransform fromConwayOutput txId meta 0 outs Ledger.IsValid False -> -- 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 fromDijkstraMetadata + in + case tx ^. Ledger.isValidTxL of + Ledger.IsValid True -> + traverseAndTransform identity txId meta 0 outs + Ledger.IsValid False -> let start = fromIntegral (length outs) in case body ^. Ledger.collateralReturnTxBodyL of SNothing -> @@ -391,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 @@ -423,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) @@ -478,6 +501,13 @@ 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 -> + let meta = fromDijkstraMetadata auxData + in Just (hashMetadata meta, meta) spendRedeemer :: Transaction @@ -499,3 +529,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 fae48be1..096d6c67 100644 --- a/src/Kupo/Data/Cardano/BinaryData.hs +++ b/src/Kupo/Data/Cardano/BinaryData.hs @@ -75,3 +75,26 @@ fromConwayData fromConwayData = Ledger.dataToBinaryData {-# INLINEABLE fromConwayData #-} + +fromDijkstraData + :: Ledger.Data DijkstraEra + -> BinaryData +fromDijkstraData = + unsafeBinaryDataFromBytes . Ledger.originalBytes +{-# INLINEABLE fromDijkstraData #-} + +fromDijkstraBinaryData + :: Ledger.BinaryData DijkstraEra + -> BinaryData +fromDijkstraBinaryData = + unsafeBinaryDataFromBytes . Ledger.originalBytes . Ledger.binaryDataToData +{-# INLINEABLE fromDijkstraBinaryData #-} + +toDijkstraBinaryData + :: BinaryData + -> Ledger.BinaryData DijkstraEra +toDijkstraBinaryData bd = + case Ledger.makeBinaryData (toShort (binaryDataToBytes bd)) of + Right b -> b + Left _ -> error "toDijkstraBinaryData: impossible" +{-# INLINEABLE toDijkstraBinaryData #-} diff --git a/src/Kupo/Data/Cardano/Datum.hs b/src/Kupo/Data/Cardano/Datum.hs index d4de93a3..fc2c9dd8 100644 --- a/src/Kupo/Data/Cardano/Datum.hs +++ b/src/Kupo/Data/Cardano/Datum.hs @@ -4,7 +4,9 @@ import Kupo.Prelude import Kupo.Data.Cardano.BinaryData ( BinaryData + , fromDijkstraBinaryData , hashBinaryData + , toDijkstraBinaryData ) import Kupo.Data.Cardano.DatumHash ( DatumHash @@ -36,6 +38,24 @@ fromConwayDatum = \case Ledger.DatumHash ref -> Reference (Left ref) Ledger.Datum bin -> Inline (Right bin) +fromDijkstraDatum + :: Ledger.Datum DijkstraEra + -> Datum +fromDijkstraDatum = \case + Ledger.NoDatum -> NoDatum + Ledger.DatumHash ref -> Reference (Left ref) + Ledger.Datum bin -> Inline (Right (fromDijkstraBinaryData bin)) + +toDijkstraDatum + :: Datum + -> Ledger.Datum DijkstraEra +toDijkstraDatum = \case + NoDatum -> Ledger.NoDatum + Reference (Left ref) -> Ledger.DatumHash ref + Reference (Right bin) -> Ledger.Datum (toDijkstraBinaryData bin) + Inline (Left ref) -> Ledger.DatumHash ref + Inline (Right bin) -> Ledger.Datum (toDijkstraBinaryData bin) + getBinaryData :: Datum -> Maybe BinaryData diff --git a/src/Kupo/Data/Cardano/Metadata.hs b/src/Kupo/Data/Cardano/Metadata.hs index bcc2561a..bd56e892 100644 --- a/src/Kupo/Data/Cardano/Metadata.hs +++ b/src/Kupo/Data/Cardano/Metadata.hs @@ -24,6 +24,7 @@ import Kupo.Data.Cardano.MetadataHash ) import qualified Cardano.Ledger.Allegra.Scripts as Ledger.Allegra 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 @@ -34,12 +35,8 @@ import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Read as T --- NOTE: Kept as ConwayEra rather than DijkstraEra because Dijkstra --- transactions are coerced to Conway at the block-processing boundary --- (see Kupo.Data.Cardano). The two eras share identical representations --- for AlonzoTxAuxData, so the choice is cosmetic. type Metadata = - AlonzoTxAuxData ConwayEra + AlonzoTxAuxData DijkstraEra emptyMetadata :: Metadata emptyMetadata = @@ -67,7 +64,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 _ _) = @@ -165,25 +162,30 @@ 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 (AlonzoTxAuxData labels timelocks scripts) = - AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) scripts +fromAlonzoMetadata (AlonzoTxAuxData labels timelocks plutus) = + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock <$> timelocks) plutus {-# INLINABLE fromAlonzoMetadata #-} fromBabbageMetadata :: AlonzoTxAuxData BabbageEra -> Metadata -fromBabbageMetadata (AlonzoTxAuxData labels timelocks scripts) = - AlonzoTxAuxData labels (Ledger.Allegra.translateTimelock <$> timelocks) scripts +fromBabbageMetadata (AlonzoTxAuxData labels timelocks plutus) = + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock . Ledger.Allegra.translateTimelock <$> timelocks) plutus {-# INLINABLE fromBabbageMetadata #-} fromConwayMetadata :: AlonzoTxAuxData ConwayEra -> Metadata -fromConwayMetadata = - identity +fromConwayMetadata (AlonzoTxAuxData labels timelocks plutus) = + AlonzoTxAuxData labels (Ledger.Dijkstra.upgradeTimelock <$> timelocks) plutus {-# INLINABLE fromConwayMetadata #-} + +fromDijkstraMetadata :: AlonzoTxAuxData DijkstraEra -> Metadata +fromDijkstraMetadata = + identity +{-# INLINABLE fromDijkstraMetadata #-} diff --git a/src/Kupo/Data/Cardano/Output.hs b/src/Kupo/Data/Cardano/Output.hs index c51bf076..ff92bea2 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,23 @@ 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 #-} + +fromDijkstraOutput + :: Ledger.Core.TxOut DijkstraEra + -> Output +fromDijkstraOutput = + identity +{-# INLINABLE fromDijkstraOutput #-} + getAddress :: Output -> Address @@ -137,7 +151,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 55d70806..fc985c76 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 95930b47..100932bf 100644 --- a/src/Kupo/Data/Cardano/Script.hs +++ b/src/Kupo/Data/Cardano/Script.hs @@ -23,6 +23,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 @@ -33,7 +34,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. @@ -71,14 +72,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 @@ -92,16 +93,23 @@ 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 #-} +fromDijkstraScript + :: Ledger.Alonzo.Script DijkstraEra + -> Script +fromDijkstraScript = + identity +{-# INLINABLE fromDijkstraScript #-} + scriptToJson :: Script -> Json.Encoding @@ -150,7 +158,7 @@ scriptFromBytes (toLazy -> bytes) = (script, tag) <- left (DecoderErrorDeserialiseFailure "Script") $ Cbor.deserialiseFromBytes Cbor.decodeWord bytes case tag of - 0 -> Ledger.Alonzo.NativeScript <$> decodeCborAnn @BabbageEra "Timelock" decCBOR script + 0 -> (Ledger.Alonzo.NativeScript . Ledger.Dijkstra.upgradeTimelock) <$> decodeCborAnn @ConwayEra "Timelock" decCBOR script 1 -> plutusScript Ledger.PlutusV1 script 2 -> plutusScript Ledger.PlutusV2 script 3 -> plutusScript Ledger.PlutusV3 script @@ -172,14 +180,14 @@ fromNativeScript :: NativeScript -> Script fromNativeScript = - Ledger.Alonzo.NativeScript + fromConwayScript . Ledger.Alonzo.NativeScript {-# INLINABLE fromNativeScript #-} 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 19c1ee96..cf88421e 100644 --- a/src/Kupo/Data/Cardano/Transaction.hs +++ b/src/Kupo/Data/Cardano/Transaction.hs @@ -29,6 +29,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 @@ -46,3 +48,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 c7aa9a0a..13dcdc5f 100644 --- a/src/Kupo/Data/Hydra.hs +++ b/src/Kupo/Data/Hydra.hs @@ -51,6 +51,8 @@ import Kupo.Data.Cardano , Value , binaryDataFromBytes , fromConwayData + , fromConwayOutput + , fromConwayScript , getOutputIndex , getTransactionId , mkOutput @@ -198,7 +200,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 @@ -214,7 +216,7 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do ) mempty (unRedeemers $ wits' ^. rdmrsTxWitsL) - , scripts = wits' ^. scriptTxWitsL + , scripts = fromConwayScript <$> wits' ^. scriptTxWitsL , metadata = Nothing } From 00b332b9226aa36522ed2ca44f1fedcf69ebe96e Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 12:30:35 +1000 Subject: [PATCH 04/11] fix: use proper type-safe conversions for DijkstraEra BinaryData Replace unsafeBinaryDataFromBytes with Ledger.dataToBinaryData and Ledger.upgradeData for era conversions. With BinaryData now aliased to DijkstraEra, fromDijkstraBinaryData and toDijkstraBinaryData simplify to identity. Uses coerce for the phantom era parameter in Conway datum conversions. Co-Authored-By: Claude --- src/Kupo/Data/Cardano/BinaryData.hs | 15 +++++++-------- src/Kupo/Data/Cardano/Datum.hs | 16 ++++++++-------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/Kupo/Data/Cardano/BinaryData.hs b/src/Kupo/Data/Cardano/BinaryData.hs index 096d6c67..f77a2a56 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,28 +74,26 @@ fromConwayData :: Ledger.Data ConwayEra -> BinaryData fromConwayData = - Ledger.dataToBinaryData + Ledger.dataToBinaryData . Ledger.upgradeData {-# INLINEABLE fromConwayData #-} fromDijkstraData :: Ledger.Data DijkstraEra -> BinaryData fromDijkstraData = - unsafeBinaryDataFromBytes . Ledger.originalBytes + Ledger.dataToBinaryData {-# INLINEABLE fromDijkstraData #-} fromDijkstraBinaryData :: Ledger.BinaryData DijkstraEra -> BinaryData fromDijkstraBinaryData = - unsafeBinaryDataFromBytes . Ledger.originalBytes . Ledger.binaryDataToData + identity {-# INLINEABLE fromDijkstraBinaryData #-} toDijkstraBinaryData :: BinaryData -> Ledger.BinaryData DijkstraEra -toDijkstraBinaryData bd = - case Ledger.makeBinaryData (toShort (binaryDataToBytes bd)) of - Right b -> b - Left _ -> error "toDijkstraBinaryData: impossible" +toDijkstraBinaryData = + identity {-# INLINEABLE toDijkstraBinaryData #-} diff --git a/src/Kupo/Data/Cardano/Datum.hs b/src/Kupo/Data/Cardano/Datum.hs index fc2c9dd8..bd6572ff 100644 --- a/src/Kupo/Data/Cardano/Datum.hs +++ b/src/Kupo/Data/Cardano/Datum.hs @@ -4,9 +4,7 @@ import Kupo.Prelude import Kupo.Data.Cardano.BinaryData ( BinaryData - , fromDijkstraBinaryData , hashBinaryData - , toDijkstraBinaryData ) import Kupo.Data.Cardano.DatumHash ( DatumHash @@ -20,15 +18,17 @@ data Datum | Inline !(Either DatumHash BinaryData) deriving (Generic, Show, Eq, Ord) +-- NOTE: The era parameter of BinaryData is phantom, so coerce between +-- BinaryData ConwayEra and BinaryData DijkstraEra is safe. toConwayDatum :: Datum -> Ledger.Datum ConwayEra toConwayDatum = \case NoDatum -> Ledger.NoDatum Reference (Left ref) -> Ledger.DatumHash ref - Reference (Right bin) -> Ledger.Datum bin + Reference (Right bin) -> Ledger.Datum (coerce bin) Inline (Left ref) -> Ledger.DatumHash ref - Inline (Right bin) -> Ledger.Datum bin + Inline (Right bin) -> Ledger.Datum (coerce bin) fromConwayDatum :: Ledger.Datum ConwayEra @@ -36,7 +36,7 @@ fromConwayDatum fromConwayDatum = \case Ledger.NoDatum -> NoDatum Ledger.DatumHash ref -> Reference (Left ref) - Ledger.Datum bin -> Inline (Right bin) + Ledger.Datum bin -> Inline (Right (Ledger.dataToBinaryData (Ledger.upgradeData (Ledger.binaryDataToData bin)))) fromDijkstraDatum :: Ledger.Datum DijkstraEra @@ -44,7 +44,7 @@ fromDijkstraDatum fromDijkstraDatum = \case Ledger.NoDatum -> NoDatum Ledger.DatumHash ref -> Reference (Left ref) - Ledger.Datum bin -> Inline (Right (fromDijkstraBinaryData bin)) + Ledger.Datum bin -> Inline (Right bin) toDijkstraDatum :: Datum @@ -52,9 +52,9 @@ toDijkstraDatum toDijkstraDatum = \case NoDatum -> Ledger.NoDatum Reference (Left ref) -> Ledger.DatumHash ref - Reference (Right bin) -> Ledger.Datum (toDijkstraBinaryData bin) + Reference (Right bin) -> Ledger.Datum bin Inline (Left ref) -> Ledger.DatumHash ref - Inline (Right bin) -> Ledger.Datum (toDijkstraBinaryData bin) + Inline (Right bin) -> Ledger.Datum bin getBinaryData :: Datum From af68a61bbb52f621ebde26c17285e6cd19edba5b Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 12:44:44 +1000 Subject: [PATCH 05/11] fix: use DijkstraNativeScript for NativeScript type alias Replace Timelock ConwayEra with DijkstraNativeScript DijkstraEra and simplify scriptFromBytes to decode directly at DijkstraEra instead of decoding at ConwayEra and upgrading. Removes the extra upgradeTimelock and fromConwayScript steps from fromNativeScript. Co-Authored-By: Claude --- src/Kupo/Data/Cardano/NativeScript.hs | 3 ++- src/Kupo/Data/Cardano/Script.hs | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Kupo/Data/Cardano/NativeScript.hs b/src/Kupo/Data/Cardano/NativeScript.hs index 76d9dca6..3283f8b1 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/Script.hs b/src/Kupo/Data/Cardano/Script.hs index 100932bf..e1580f3e 100644 --- a/src/Kupo/Data/Cardano/Script.hs +++ b/src/Kupo/Data/Cardano/Script.hs @@ -158,7 +158,7 @@ scriptFromBytes (toLazy -> bytes) = (script, tag) <- left (DecoderErrorDeserialiseFailure "Script") $ Cbor.deserialiseFromBytes Cbor.decodeWord bytes case tag of - 0 -> (Ledger.Alonzo.NativeScript . Ledger.Dijkstra.upgradeTimelock) <$> decodeCborAnn @ConwayEra "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 @@ -180,7 +180,7 @@ fromNativeScript :: NativeScript -> Script fromNativeScript = - fromConwayScript . Ledger.Alonzo.NativeScript + Ledger.Alonzo.NativeScript {-# INLINABLE fromNativeScript #-} hashScript From 3a15c93a5bb7a126ebf48c34495e14ea01161763 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 13:13:14 +1000 Subject: [PATCH 06/11] docs: explain OVERLAPPING pragma on ToJSON Point instance Add comment noting that ouroboros-network provides a general ToJSON (Point block) instance that conflicts with this one. Co-Authored-By: Claude --- src/Kupo/Data/Cardano/Point.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Kupo/Data/Cardano/Point.hs b/src/Kupo/Data/Cardano/Point.hs index 2a14f9e0..599233a7 100644 --- a/src/Kupo/Data/Cardano/Point.hs +++ b/src/Kupo/Data/Cardano/Point.hs @@ -45,6 +45,8 @@ import qualified Ouroboros.Network.Block as Ouroboros type Point = Ouroboros.Point Block +-- ouroboros-network provides a general 'ToJSON (Ouroboros.Point block)' instance +-- that conflicts with this one, so we need OVERLAPPING to prefer this definition. instance {-# OVERLAPPING #-} ToJSON Point where toJSON = error "ToJSON Point called instead of 'toEncoding'." toEncoding = pointToJson From 8f32e3b85d2221479252b073c38c90f098656dea Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 13:40:39 +1000 Subject: [PATCH 07/11] fix: replace remaining unsafeBinaryDataFromBytes calls in BinaryData Use Ledger.dataToBinaryData with Ledger.upgradeData for Alonzo and Babbage era data conversions, removing the HasCallStack constraint from fromAlonzoData and the intermediate type annotation from fromBabbageData. Co-Authored-By: Claude --- src/Kupo/Data/Cardano/BinaryData.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/Kupo/Data/Cardano/BinaryData.hs b/src/Kupo/Data/Cardano/BinaryData.hs index f77a2a56..d84f1edd 100644 --- a/src/Kupo/Data/Cardano/BinaryData.hs +++ b/src/Kupo/Data/Cardano/BinaryData.hs @@ -54,20 +54,17 @@ unsafeBinaryDataFromBytes = {-# INLINABLE unsafeBinaryDataFromBytes #-} fromAlonzoData - :: HasCallStack - => Ledger.Data AlonzoEra + :: Ledger.Data AlonzoEra -> BinaryData fromAlonzoData = - unsafeBinaryDataFromBytes . Ledger.originalBytes + Ledger.dataToBinaryData . Ledger.upgradeData {-# INLINEABLE fromAlonzoData #-} fromBabbageData :: Ledger.Data BabbageEra -> BinaryData fromBabbageData = - Ledger.dataToBinaryData - . (Ledger.upgradeData :: Ledger.Data ConwayEra -> Ledger.Data DijkstraEra) - . Ledger.upgradeData + Ledger.dataToBinaryData . Ledger.upgradeData {-# INLINEABLE fromBabbageData #-} fromConwayData From 22c0060108573b35ad02f9e7563a07f34ffc3d7c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 14:24:56 +1000 Subject: [PATCH 08/11] refactor: remove unused toConwayDatum and fromConwayDatum These Conway-era datum conversions are dead code now that the Datum, BinaryData, and Output types are all aliased to DijkstraEra. Co-Authored-By: Claude --- src/Kupo/Data/Cardano/Datum.hs | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/src/Kupo/Data/Cardano/Datum.hs b/src/Kupo/Data/Cardano/Datum.hs index bd6572ff..db9788db 100644 --- a/src/Kupo/Data/Cardano/Datum.hs +++ b/src/Kupo/Data/Cardano/Datum.hs @@ -18,25 +18,6 @@ data Datum | Inline !(Either DatumHash BinaryData) deriving (Generic, Show, Eq, Ord) --- NOTE: The era parameter of BinaryData is phantom, so coerce between --- BinaryData ConwayEra and BinaryData DijkstraEra is safe. -toConwayDatum - :: Datum - -> Ledger.Datum ConwayEra -toConwayDatum = \case - NoDatum -> Ledger.NoDatum - Reference (Left ref) -> Ledger.DatumHash ref - Reference (Right bin) -> Ledger.Datum (coerce bin) - Inline (Left ref) -> Ledger.DatumHash ref - Inline (Right bin) -> Ledger.Datum (coerce bin) - -fromConwayDatum - :: Ledger.Datum ConwayEra - -> Datum -fromConwayDatum = \case - Ledger.NoDatum -> NoDatum - Ledger.DatumHash ref -> Reference (Left ref) - Ledger.Datum bin -> Inline (Right (Ledger.dataToBinaryData (Ledger.upgradeData (Ledger.binaryDataToData bin)))) fromDijkstraDatum :: Ledger.Datum DijkstraEra From 4cfbb6cbd5de57266b348bc0076735daf97dac0b Mon Sep 17 00:00:00 2001 From: John Lotoski Date: Wed, 13 May 2026 22:33:12 -0500 Subject: [PATCH 09/11] fix: use OS-assigned ports in state-machine test The previous genServerPort (1024 + size + arbitrary) could generate privileged ports below 1024 and duplicate ports across iterations, causing bind failures. Replace with OS-assigned ephemeral ports via bind-to-zero on localhost. Also use newEnvironmentWith throwIO so test failures surface the real exception instead of opaque ExitFailure 1. Co-Authored-By: Claude --- kupo.cabal | 1 + package.yaml | 1 + test/Test/Kupo/AppSpec.hs | 29 ++++++++++++++++------------- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/kupo.cabal b/kupo.cabal index 9beb2672..37c6415a 100644 --- a/kupo.cabal +++ b/kupo.cabal @@ -399,6 +399,7 @@ test-suite unit , io-sim , kupo , lens-aeson + , network , openapi3 , process , quickcheck-state-machine diff --git a/package.yaml b/package.yaml index fae6acf4..229eed2c 100644 --- a/package.yaml +++ b/package.yaml @@ -140,6 +140,7 @@ tests: - http-types - io-classes - io-sim + - network - kupo - lens-aeson - openapi3 diff --git a/test/Test/Kupo/AppSpec.hs b/test/Test/Kupo/AppSpec.hs index 4e0bd353..7d645bd3 100644 --- a/test/Test/Kupo/AppSpec.hs +++ b/test/Test/Kupo/AppSpec.hs @@ -37,7 +37,7 @@ import GHC.Generics ) import Kupo ( kupoWith - , newEnvironment + , newEnvironmentWith , runWith ) import Kupo.App @@ -146,6 +146,7 @@ import Network.HTTP.Client ( defaultManagerSettings , newManager ) +import qualified Network.Socket import Network.WebSockets ( ConnectionException (..) ) @@ -176,7 +177,6 @@ import Test.Kupo.Data.Generators ) import Test.QuickCheck ( Gen - , arbitrary , choose , counterexample , elements @@ -184,7 +184,6 @@ import Test.QuickCheck , frequency , label , oneof - , sized ) import Test.QuickCheck.Monadic ( assert @@ -193,7 +192,8 @@ import Test.QuickCheck.Monadic , run ) import Test.QuickCheck.Property - ( withMaxSuccess + ( ioProperty + , withMaxSuccess ) import Test.StateMachine ( CommandNames @@ -243,10 +243,10 @@ spec = do <$> runIO (lookupEnv varStateMachineIterations) prop "State-Machine" $ withMaxSuccess maxSuccess $ - forAll genInputManagement $ \inputManagement -> do - forAll genServerPort $ \serverPort -> do - let httpClient = newHttpClientWith manager (serverHost, serverPort) (\_ -> pure ()) - let stateMachine = StateMachine + forAll genInputManagement $ \inputManagement -> ioProperty $ do + serverPort <- getFreePort + let httpClient = newHttpClientWith manager (serverHost, serverPort) (\_ -> pure ()) + stateMachine = StateMachine initModel transition (precondition longestRollback) @@ -257,7 +257,7 @@ spec = do (semantics garbageCollectionInterval httpClient chan) mock (cleanup chan) - forAllCommands stateMachine Nothing $ \cmds -> monadicIO $ do + pure $ forAllCommands stateMachine Nothing $ \cmds -> monadicIO $ do let config = Configuration { chainProducer = CardanoNode -- NOTE: unused, but must be different than ReadOnlyReplica { nodeSocket = "/dev/null" @@ -275,7 +275,7 @@ spec = do , garbageCollectionInterval , deferIndexes } - env <- run (newEnvironment config) + env <- run (newEnvironmentWith throwIO config) producer <- run (newMockProducer httpClient <$> atomically (dupTChan chan)) fetchBlock <- run (newMockFetchBlock <$> atomically (dupTChan chan)) let fetchTip = throwIO UnusedFetchTipClient @@ -309,9 +309,12 @@ spec = do garbageCollectionInterval = 0.4 deferIndexes = InstallIndexesIfNotExist tracers = configureTracers (defaultTracers Nothing) nullTracer - genServerPort = sized $ \n -> do - i <- arbitrary - pure (1024 + n + i) + getFreePort = do + sock <- Network.Socket.socket Network.Socket.AF_INET Network.Socket.Stream 0 + Network.Socket.bind sock (Network.Socket.SockAddrInet 0 (Network.Socket.tupleToHostAddress (127,0,0,1))) + port <- Network.Socket.socketPort sock + Network.Socket.close sock + pure (fromIntegral port) -------------------------------------------------------------------------------- ---- Events / Respone From d7c50de7a944e3ac092b934b7008940c23ad8584 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 14 May 2026 14:42:21 +1000 Subject: [PATCH 10/11] Comment about Hydra and its transaction encoding Co-Authored-By: Claude --- src/Kupo/Data/Hydra.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Kupo/Data/Hydra.hs b/src/Kupo/Data/Hydra.hs index 13dcdc5f..1bd18e21 100644 --- a/src/Kupo/Data/Hydra.hs +++ b/src/Kupo/Data/Hydra.hs @@ -183,6 +183,9 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do bytes <- decodeBase16' hexText + -- NOTE: Hydra currently serialises transactions as Conway-era CBOR. When Hydra upgrades its + -- internal transaction encoding to Dijkstra, this line and the fromConway* calls below will + -- need to change. (tx :: Ledger.Tx Ledger.TopTx ConwayEra) <- case decodeCborAnn @ConwayEra "PartialTransaction" decCBOR (fromStrict bytes) of Left e -> fail $ show e Right tx -> pure tx From fc3797649cf9f962de7e7c0590a3e1930c66430a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 26 May 2026 10:28:15 +0200 Subject: [PATCH 11/11] restore previous Ogmios revision in cabal.project This is only used to pull in the fast-bech32 module, which is not impacted by the hard fork at all. --- cabal.project | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index b5ad4714..fb53b03f 100644 --- a/cabal.project +++ b/cabal.project @@ -74,9 +74,9 @@ allow-newer: -- nix-prefetch-git https://github.com/CardanoSolutions/ogmios.git --rev --fetch-submodules --quiet | jq '.hash' | tail -c +9 | head -c -2 source-repository-package type: git - location: https://github.com/johnalotoski/ogmios - --sha256: sha256-OjABxe/ICHIkb+5jQI7chCrwnQ2W1oVO02Zxu9yLUKU= - tag: ea80df1204f830050436facdae4287cf674892e5 + location: https://github.com/CardanoSolutions/ogmios + tag: ae876badb138f42dcd6d2389734b0c15502684ed + --sha256: xkOfOdX6Dxi7+VW78Tk3n3MoguIg39pKdxiNVfdeEwE= subdir: server/modules/fast-bech32