diff --git a/cabal.project b/cabal.project index fa90e6d..f037e6b 100644 --- a/cabal.project +++ b/cabal.project @@ -11,3 +11,26 @@ repository cardano-haskell-packages packages: . +tests: true + +-- repeating the index-state for hackage to work around hackage.nix parsing limitation +index-state: 2024-06-15T17:35:54Z + +index-state: + , hackage.haskell.org 2024-06-15T17:35:54Z + , cardano-haskell-packages 2024-06-13T23:12:13Z + +-- TODO: Default value should be @direct@ in upcoming 3.10 version of cabal, omit this line then. +test-show-details: direct + +package cardano-crypto-praos + flags: -external-libsodium-vrf + +-- Using RDRAND instead of /dev/urandom as an entropy source for key +-- generation is dubious. Set the flag so we use /dev/urandom by default. +package cryptonite + flags: -support_rdrand + +-- TODO: This is fixed for in their later version, omit this when we update to it. +package strict-containers + ghc-options: -Wwarn=noncanonical-monad-instances diff --git a/cabal.project.freeze b/cabal.project.freeze index 77f0f77..ae5b5a5 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,6 +1,6 @@ active-repositories: hackage.haskell.org:merge, cardano-haskell-packages:merge -constraints: any.Cabal ==3.10.1.0, - any.Cabal-syntax ==3.10.1.0, +constraints: any.Cabal ==3.10.3.0, + any.Cabal-syntax ==3.10.3.0, any.Diff ==0.5, any.FailT ==0.1.2.0, any.Glob ==0.10.2, @@ -8,9 +8,9 @@ constraints: any.Cabal ==3.10.1.0, any.MemoTrie ==0.6.11, MemoTrie -examples, any.MonadRandom ==0.6, - any.OneTuple ==0.4.1.1, + any.OneTuple ==0.4.2, any.Only ==0.1, - any.PyF ==0.11.2.1, + any.PyF ==0.11.3.0, PyF -python_test, any.QuickCheck ==2.14.3, QuickCheck -old-random +templatehaskell, @@ -20,79 +20,77 @@ constraints: any.Cabal ==3.10.1.0, any.Win32-network ==0.1.1.1, Win32-network -demo, any.adjunctions ==4.4.2, - any.aeson ==2.2.1.0, + any.aeson ==2.2.3.0, aeson +ordered-keymap, any.aeson-pretty ==0.8.10, aeson-pretty -lib-only, any.algebraic-graphs ==0.7, - any.ansi-terminal ==1.0.2, + any.ansi-terminal ==1.1.1, ansi-terminal -example, - any.ansi-terminal-types ==0.11.5, - any.ansi-wl-pprint ==0.6.9, + any.ansi-terminal-types ==1.1, + any.ansi-wl-pprint ==1.0.2, ansi-wl-pprint -example, any.appar ==0.1.8, - any.array ==0.5.5.0, + any.array ==0.5.6.0, any.asn1-encoding ==0.9.6, any.asn1-parse ==0.9.5, any.asn1-types ==0.3.4, - any.assoc ==1.1, - assoc +tagged, + any.assoc ==1.1.1, + assoc -tagged, any.async ==2.2.5, async -bench, any.attoparsec ==0.14.4, attoparsec -developer, - any.attoparsec-aeson ==2.2.0.1, - any.auto-update ==0.1.6, + any.attoparsec-aeson ==2.2.2.0, + any.auto-update ==0.2.0, any.barbies ==2.1.1.0, - any.base ==4.18.1.0, + any.base ==4.18.2.1, any.base-compat ==0.13.1, any.base-compat-batteries ==0.13.1, any.base-deriving-via ==0.1.0.2, - any.base-orphans ==0.9.1, + any.base-orphans ==0.9.2, any.base16-bytestring ==1.0.2.0, any.base58-bytestring ==0.1.0, any.base64-bytestring ==1.2.1.0, any.base64-bytestring-type ==1.0.1, base64-bytestring-type +cereal +http-api-data +serialise, any.basement ==0.0.16, - any.bech32 ==1.1.5, + any.bech32 ==1.1.7, bech32 -release -static, - any.bifunctors ==5.6.1, + any.bifunctors ==5.6.2, bifunctors +tagged, any.bimap ==0.5.0, - any.bin ==0.1.3, + any.bin ==0.1.4, any.binary ==0.8.9.1, - any.binary-orphans ==1.0.4.1, + any.binary-orphans ==1.0.5, any.bitvec ==1.1.5.0, bitvec +simd, any.blaze-builder ==0.4.2.3, - any.boring ==0.2.1, + any.boring ==0.2.2, boring +tagged, any.brick ==2.3.1, brick -demos, any.byron-spec-chain ==1.0.0.2, any.byron-spec-ledger ==1.0.0.2, any.byteorder ==1.0.4, - any.bytestring ==0.11.5.2, - any.bytestring-builder ==0.10.8.2.0, - bytestring-builder +bytestring_has_builder, + any.bytestring ==0.11.5.3, any.bytestring-strict-builder ==0.4.5.7, any.cabal-doctest ==1.0.9, any.call-stack ==0.4.0, any.canonical-json ==0.6.0.1, - any.cardano-api ==8.38.0.0, + any.cardano-api ==8.39.3.0, any.cardano-binary ==1.7.1.0, any.cardano-crypto ==1.1.2, cardano-crypto -golden-tests -golden-tests-exe, - any.cardano-crypto-class ==2.1.4.0, + any.cardano-crypto-class ==2.1.5.0, cardano-crypto-class +secp256k1-support, any.cardano-crypto-praos ==2.1.2.0, - cardano-crypto-praos +external-libsodium-vrf, + cardano-crypto-praos -external-libsodium-vrf, any.cardano-crypto-test ==1.5.0.1, any.cardano-crypto-tests ==2.1.2.0, cardano-crypto-tests +secp256k1-support, any.cardano-crypto-wrapper ==1.5.1.1, - any.cardano-data ==1.2.0.0, + any.cardano-data ==1.2.2.0, any.cardano-git-rev ==0.1.3.0, any.cardano-ledger-allegra ==1.3.0.0, any.cardano-ledger-alonzo ==1.6.0.0, @@ -115,21 +113,20 @@ constraints: any.Cabal ==3.10.1.0, cardano-ledger-shelley -asserts, any.cardano-ledger-shelley-ma-test ==1.2.1.6, any.cardano-ledger-shelley-test ==1.3.0.1, - any.cardano-ledger-test ==9.9.9.9, - any.cardano-prelude ==0.1.0.4, + any.cardano-prelude ==0.2.0.0, cardano-prelude -development, - any.cardano-prelude-test ==0.1.0.2, + any.cardano-prelude-test ==0.1.0.3, cardano-prelude-test -development, any.cardano-protocol-tpraos ==1.1.0.0, any.cardano-slotting ==0.1.2.0, any.cardano-strict-containers ==0.1.3.0, any.case-insensitive ==1.2.1.0, - any.cassava ==0.5.3.0, - cassava -bytestring--lt-0_10_4, + any.cassava ==0.5.3.1, any.cborg ==0.2.10.0, cborg +optimize-gmp, any.cereal ==0.5.8.3, cereal -bytestring-builder, + any.character-ps ==0.1, any.charset ==0.3.10, clb -force-recomp, any.clock ==0.8.4, @@ -142,13 +139,13 @@ constraints: any.Cabal ==3.10.1.0, comonad +containers +distributive +indexed-traversable, any.composition-prelude ==3.0.0.2, composition-prelude -development, - any.concurrent-output ==1.10.20, + any.concurrent-output ==1.10.21, any.conduit ==1.3.5, any.conduit-extra ==1.3.6, any.config-ini ==0.2.7.0, config-ini -enable-doctests, - any.constraints ==0.14, - any.constraints-extras ==0.4.0.0, + any.constraints ==0.14.2, + any.constraints-extras ==0.4.0.1, constraints-extras +build-readme, any.containers ==0.6.7, any.contra-tracer ==0.1.0.2, @@ -157,25 +154,25 @@ constraints: any.Cabal ==3.10.1.0, any.cookie ==0.4.6, any.criterion ==1.6.3.0, criterion -embed-data-files -fast, - any.criterion-measurement ==0.2.1.0, + any.criterion-measurement ==0.2.2.0, criterion-measurement -fast, - any.crypton ==0.34, + any.crypton ==1.0.0, crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes, - any.crypton-connection ==0.3.2, - any.crypton-x509 ==1.7.6, + any.crypton-connection ==0.4.0, + any.crypton-x509 ==1.7.7, any.crypton-x509-store ==1.6.9, any.crypton-x509-system ==1.6.7, any.crypton-x509-validation ==1.6.12, any.cryptonite ==0.30, - cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes, + cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq -support_rdrand -support_sse +use_target_attributes, any.data-clist ==0.2, any.data-default ==0.7.1.1, any.data-default-class ==0.1.2.0, any.data-default-instances-containers ==0.0.1, any.data-default-instances-dlist ==0.0.1, any.data-default-instances-old-locale ==0.0.1, - any.data-fix ==0.3.2, - any.dec ==0.0.5, + any.data-fix ==0.3.3, + any.dec ==0.0.6, any.deepseq ==1.4.8.1, any.deferred-folds ==0.9.18.6, any.dense-linear-algebra ==0.1.0.0, @@ -183,12 +180,12 @@ constraints: any.Cabal ==3.10.1.0, any.dependent-sum ==0.7.2.0, any.deque ==0.4.4.1, any.deriving-aeson ==0.2.9, - any.deriving-compat ==0.6.5, + any.deriving-compat ==0.6.6, deriving-compat +base-4-9 +new-functor-classes +template-haskell-2-11, any.dictionary-sharing ==0.1.0.0, any.digest ==0.0.2.1, digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config, - any.directory ==1.3.8.1, + any.directory ==1.3.8.4, any.distributive ==0.6.2.1, distributive +semigroups +tagged, any.dlist ==1.0, @@ -202,13 +199,13 @@ constraints: any.Cabal ==3.10.1.0, any.erf ==2.0.0.0, any.errors ==2.3.0, any.exceptions ==0.10.7, - any.extra ==1.7.14, + any.extra ==1.7.16, any.fgl ==5.8.2.0, fgl +containers042, any.file-embed ==0.0.16.0, any.filelock ==0.1.1.7, - any.filepath ==1.4.100.4, - any.fin ==0.3, + any.filepath ==1.4.300.1, + any.fin ==0.3.1, any.fingertree ==0.1.5.0, any.flat ==0.6, any.foldl ==1.4.16, @@ -224,22 +221,22 @@ constraints: any.Cabal ==3.10.1.0, any.generically ==0.1.1, any.generics-sop ==0.5.1.4, any.genvalidity ==1.1.0.0, - any.ghc ==9.6.3, + any.ghc ==9.6.5, any.ghc-bignum ==1.3, - any.ghc-boot ==9.6.3, - any.ghc-boot-th ==9.6.3, - any.ghc-heap ==9.6.3, + any.ghc-boot ==9.6.5, + any.ghc-boot-th ==9.6.5, + any.ghc-heap ==9.6.5, any.ghc-paths ==0.1.0.12, any.ghc-prim ==0.10.0, - any.ghci ==9.6.3, + any.ghci ==9.6.5, any.githash ==0.1.7.0, any.graphviz ==2999.20.2.0, graphviz -test-parsing, any.groups ==0.5.3, any.half ==0.3.1, any.happy ==1.20.1.1, - any.hashable ==1.4.3.0, - hashable +integer-gmp -random-initial-seed, + any.hashable ==1.4.6.0, + hashable +arch-native +integer-gmp -random-initial-seed, any.haskeline ==0.8.2.1, any.haskell-lexer ==1.1.1, any.heapwords ==0.1.0.2, @@ -250,46 +247,47 @@ constraints: any.Cabal ==3.10.1.0, any.hpc ==0.6.2.0, any.hsc2hs ==0.68.10, hsc2hs -in-ghc-tree, - any.hspec ==2.11.7, - any.hspec-core ==2.11.7, - any.hspec-discover ==2.11.7, + any.hspec ==2.11.9, + any.hspec-core ==2.11.9, + any.hspec-discover ==2.11.9, any.hspec-expectations ==0.8.4, - any.http-api-data ==0.6, + any.http-api-data ==0.6.1, http-api-data -use-text-show, - any.http-client ==0.7.16, + any.http-client ==0.7.17, http-client +network-uri, any.http-client-tls ==0.3.6.3, any.http-conduit ==2.3.8.3, http-conduit +aeson, any.http-types ==0.12.4, - any.indexed-traversable ==0.1.3, - any.indexed-traversable-instances ==0.1.1.2, + any.indexed-traversable ==0.1.4, + any.indexed-traversable-instances ==0.1.2, any.infinite-list ==0.1.1, - any.integer-conversion ==0.1.0.1, + any.integer-conversion ==0.1.1, any.integer-gmp ==1.1, any.integer-logarithms ==1.0.3.1, integer-logarithms -check-bounds +integer-gmp, - any.invariant ==0.6.2, - any.io-classes ==1.3.1.0, + any.invariant ==0.6.3, + any.io-classes ==1.4.1.0, io-classes -asserts, - any.io-classes-mtl ==0.1.0.3, - any.io-sim ==1.3.1.0, + any.io-classes-mtl ==0.1.1.0, + any.io-sim ==1.4.1.0, io-sim -asserts, any.iproute ==1.7.12, any.isomorphism-class ==0.1.0.12, any.js-chart ==2.9.4.1, - any.kan-extensions ==5.2.5, + any.kan-extensions ==5.2.6, any.lazy-search ==0.1.3.0, any.lazysmallcheck ==0.6, any.lens ==5.2.3, lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy, - any.libyaml ==0.1.2, + any.libyaml ==0.1.4, libyaml -no-unicode -system-libyaml, + any.libyaml-clib ==0.2.5, any.lifted-async ==0.10.2.5, any.lifted-base ==0.2.3.12, any.list-t ==1.0.5.7, any.logict ==0.8.1.0, - any.math-functions ==0.3.4.3, + any.math-functions ==0.3.4.4, math-functions +system-erf +system-expm1, any.measures ==0.1.0.2, any.megaparsec ==9.6.1, @@ -298,23 +296,21 @@ constraints: any.Cabal ==3.10.1.0, memory +support_bytestring +support_deepseq, any.microlens ==0.4.13.1, any.microlens-mtl ==0.2.0.3, - any.microlens-th ==0.4.3.14, - any.microstache ==1.0.2.3, + any.microlens-th ==0.4.3.15, + any.microstache ==1.0.3, any.mime-types ==0.1.2.0, any.mmorph ==1.2.0, any.monad-control ==1.0.3.1, any.mono-traversable ==1.0.17.0, - any.monoidal-containers ==0.6.4.0, + any.monoidal-containers ==0.6.5.0, monoidal-containers +split-these, any.monoidal-synchronisation ==0.1.0.5, any.mtl ==2.3.1, - any.mtl-compat ==0.2.2, - mtl-compat -two-point-one -two-point-two, any.multiset ==0.3.4.3, any.mwc-random ==0.15.0.2, any.network ==3.1.4.0, network -devel, - any.network-mux ==0.4.5.0, + any.network-mux ==0.4.5.1, network-mux -ipv6 -tracetcpinfo, any.network-uri ==2.6.4.2, any.newtype ==0.2.2.0, @@ -329,25 +325,26 @@ constraints: any.Cabal ==3.10.1.0, optparse-applicative +process, any.optparse-applicative-fork ==0.18.1.0, optparse-applicative-fork +process, - any.ouroboros-consensus ==0.15.0.0, + any.os-string ==2.0.3, + any.ouroboros-consensus ==0.16.0.0, ouroboros-consensus -asserts, - any.ouroboros-consensus-cardano ==0.13.0.0, + any.ouroboros-consensus-cardano ==0.14.1.0, ouroboros-consensus-cardano -asserts, - any.ouroboros-consensus-diffusion ==0.10.0.0, + any.ouroboros-consensus-diffusion ==0.14.0.0, ouroboros-consensus-diffusion -asserts, any.ouroboros-consensus-protocol ==0.7.0.0, ouroboros-consensus-protocol -asserts, - any.ouroboros-network ==0.11.0.0, + any.ouroboros-network ==0.14.0.0, ouroboros-network -asserts, - any.ouroboros-network-api ==0.6.3.0, + any.ouroboros-network-api ==0.7.2.0, ouroboros-network-api -asserts, - any.ouroboros-network-framework ==0.11.0.0, + any.ouroboros-network-framework ==0.12.0.0, ouroboros-network-framework -ipv6, any.ouroboros-network-mock ==0.1.1.1, ouroboros-network-mock -asserts, - any.ouroboros-network-protocols ==0.7.0.0, + any.ouroboros-network-protocols ==0.8.1.0, ouroboros-network-protocols -asserts +cddl, - any.ouroboros-network-testing ==0.5.0.0, + any.ouroboros-network-testing ==0.6.1.0, ouroboros-network-testing -nightly, any.parallel ==3.2.2.0, any.parsec ==3.1.16.1, @@ -371,43 +368,42 @@ constraints: any.Cabal ==3.10.1.0, any.prettyprinter ==1.7.1, prettyprinter -buildreadme +text, any.prettyprinter-ansi-terminal ==1.1.3, + any.prettyprinter-compat-ansi-wl-pprint ==1.0.2, any.prettyprinter-configurable ==1.21.0.0, - any.primitive ==0.8.0.0, - any.process ==1.6.17.0, + any.primitive ==0.9.0.0, + any.process ==1.6.19.0, any.profunctors ==5.6.2, - any.protolude ==0.3.4, any.psqueues ==0.2.8.0, - any.quickcheck-instances ==0.3.30, - quickcheck-instances -bytestring-builder, + any.quickcheck-instances ==0.3.31, any.quickcheck-io ==0.2.0, any.quickcheck-state-machine ==0.9.0, any.quickcheck-transformer ==0.3.1.2, any.quiet ==0.2, - any.ral ==0.2.1, + any.ral ==0.2.2, ral +adjunctions +distributive +semigroupoids, any.random ==1.2.1.2, any.random-shuffle ==0.0.4, - any.recursion-schemes ==5.2.2.5, + any.recursion-schemes ==5.2.3, recursion-schemes +template-haskell, - any.reflection ==2.1.7, + any.reflection ==2.1.8, reflection -slow +template-haskell, any.resourcet ==1.3.0, any.rts ==1.0.2, any.safe ==0.3.21, any.safe-exceptions ==0.1.7.4, - any.scientific ==0.3.7.0, - scientific -bytestring-builder -integer-simple, + any.scientific ==0.3.8.0, + scientific -integer-simple, any.selective ==0.5, - any.semialign ==1.3, + any.semialign ==1.3.1, semialign +semigroupoids, - any.semigroupoids ==6.0.0.1, + any.semigroupoids ==6.0.1, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, any.semigroups ==0.20, semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, any.serialise ==0.2.6.1, serialise +newtime15, any.set-algebra ==1.1.0.2, - any.si-timers ==1.3.0.0, + any.si-timers ==1.4.0.0, si-timers -asserts, any.size-based ==0.1.3.2, any.small-steps ==1.0.1.0, @@ -432,10 +428,10 @@ constraints: any.Cabal ==3.10.1.0, any.strict ==0.5, any.strict-checked-vars ==0.2.0.0, strict-checked-vars -checkmvarinvariants -checktvarinvariants, - any.strict-list ==0.1.7.4, - any.strict-mvar ==1.3.0.0, - any.strict-sop-core ==0.1.0.0, - any.strict-stm ==1.3.0.0, + any.strict-list ==0.1.7.5, + any.strict-mvar ==1.4.0.0, + any.strict-sop-core ==0.1.1.0, + any.strict-stm ==1.4.0.0, strict-stm -asserts, any.syb ==0.7.2.4, any.system-cxx-std-lib ==1.0, @@ -459,24 +455,24 @@ constraints: any.Cabal ==3.10.1.0, any.text ==2.0.2, any.text-builder ==0.6.7.2, any.text-builder-dev ==0.3.4.2, - any.text-iso8601 ==0.1, - any.text-short ==0.1.5, + any.text-iso8601 ==0.1.1, + any.text-short ==0.1.6, text-short -asserts, any.text-zipper ==0.13, any.tf-random ==0.5, - any.th-abstraction ==0.6.0.0, - any.th-compat ==0.1.4, + any.th-abstraction ==0.7.0.0, + any.th-compat ==0.1.5, + any.th-env ==0.1.1, any.th-expand-syns ==0.4.11.0, any.th-lift ==0.8.4, any.th-lift-instances ==0.1.20, any.th-orphans ==0.13.14, any.th-reify-many ==0.1.10, any.th-utilities ==0.2.5.0, - any.these ==1.2, + any.these ==1.2.1, any.time ==1.12.2, - any.time-compat ==1.9.6.1, - time-compat -old-locale, - any.tls ==2.0.1, + any.time-compat ==1.9.7, + any.tls ==2.0.6, tls -devel, any.transformers ==0.6.1.0, any.transformers-base ==0.4.6, @@ -484,30 +480,29 @@ constraints: any.Cabal ==3.10.1.0, any.transformers-compat ==0.7.2, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, any.transformers-except ==0.1.4, - any.tree-diff ==0.3.0.1, - any.type-equality ==1, + any.tree-diff ==0.3.1, any.typed-process ==0.2.11.1, any.typed-protocols ==0.1.1.0, any.typed-protocols-cborg ==0.1.0.4, any.typed-protocols-examples ==0.2.0.2, any.unbounded-delays ==0.1.1.1, - any.universe-base ==1.1.3.1, - any.unix ==2.8.1.0, + any.universe-base ==1.1.4, + any.unix ==2.8.4.0, any.unix-bytestring ==0.4.0.1, any.unix-compat ==0.7.1, unix-compat -old-time, - any.unix-time ==0.4.12, + any.unix-time ==0.4.15, any.unliftio ==0.2.25.0, any.unliftio-core ==0.2.1.0, any.unordered-containers ==0.2.20, unordered-containers -debug, any.utf8-string ==1.0.2, - any.uuid-types ==1.0.5.1, + any.uuid-types ==1.0.6, any.validation-selective ==0.2.0.0.0.0.0.0.1, any.validity ==0.12.0.2, any.vector ==0.13.1.0, vector +boundschecks -internalchecks -unsafechecks -wall, - any.vector-algorithms ==0.9.0.1.0.0.0.0.1, + any.vector-algorithms ==0.9.0.2, vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, any.vector-binary-instances ==0.2.5.2, any.vector-map ==1.1.0.0, @@ -519,12 +514,13 @@ constraints: any.Cabal ==3.10.1.0, any.vty-crossplatform ==0.2.0.0, vty-crossplatform -demos, any.vty-unix ==0.1.0.0, + any.with-utf8 ==1.1.0.0, any.witherable ==0.4.2, any.wl-pprint-annotated ==0.1.0.1, any.wl-pprint-text ==1.2.0.2, any.word-wrap ==0.5, any.yaml ==0.11.11.2, yaml +no-examples +no-exe, - any.zlib ==0.7.0.0, + any.zlib ==0.7.1.0, zlib -bundled-c-zlib +non-blocking-ffi +pkg-config -index-state: cardano-haskell-packages 2024-03-08T10:14:14Z, hackage.haskell.org 2024-03-11T16:17:02Z +index-state: cardano-haskell-packages 2024-06-13T23:12:13Z, hackage.haskell.org 2024-06-15T17:35:54Z diff --git a/clb.cabal b/clb.cabal index ce1f0ca..47654ec 100644 --- a/clb.cabal +++ b/clb.cabal @@ -97,6 +97,7 @@ executable smoke-test build-depends: , base , cardano-api:{cardano-api, internal} + , cardano-ledger-core , clb , prettyprinter diff --git a/src/Clb.hs b/src/Clb.hs index 1620018..8c11023 100644 --- a/src/Clb.hs +++ b/src/Clb.hs @@ -67,17 +67,22 @@ import Cardano.Crypto.DSIGN qualified as Crypto import Cardano.Crypto.Hash qualified as Crypto import Cardano.Crypto.Seed qualified as Crypto import Cardano.Ledger.Address qualified as L (compactAddr, decompactAddr) +import Cardano.Ledger.Alonzo.Plutus.Evaluate qualified as PlutusEval +import Cardano.Ledger.Alonzo.Rules qualified as Rules.A import Cardano.Ledger.Api qualified as L +import Cardano.Ledger.Babbage.Rules qualified as Rules.B import Cardano.Ledger.Babbage.TxOut qualified as L (BabbageTxOut (TxOutCompact), getEitherAddrBabbageTxOut) import Cardano.Ledger.BaseTypes (Globals) import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.Compactible qualified as L import Cardano.Ledger.Core qualified as Core import Cardano.Ledger.Keys qualified as L +import Cardano.Ledger.Plutus qualified as LedgerPlutus import Cardano.Ledger.Plutus.TxInfo (transCred, transDataHash, transTxIn) import Cardano.Ledger.SafeHash qualified as L import Cardano.Ledger.Shelley.API qualified as L hiding (TxOutCompact) import Cardano.Ledger.Shelley.Core (EraRule) +import Cardano.Ledger.Shelley.Rules qualified as Rules.S import Cardano.Ledger.Slot (SlotNo) import Cardano.Ledger.TxIn qualified as L import Cardano.Slotting.EpochInfo (EpochInfo) @@ -89,20 +94,22 @@ import Clb.Params (PParams, genesisDefaultsFromParams) import Clb.TimeSlot (SlotConfig (..), slotConfigToEpochInfo) import Clb.Tx (OnChainTx (..)) import Control.Arrow (ArrowChoice (..)) -import Control.Lens (over, (&), (.~), (^.)) +import Control.Lens (over, (&), (.~), (^.), unsnoc) import Control.Monad (when) +import Control.Monad.Except (MonadError (throwError), liftEither, runExcept, runExceptT) import Control.Monad.Identity (Identity (runIdentity)) -import Control.Monad.Reader (runReader) +import Control.Monad.Reader (MonadTrans (lift), runReader) import Control.Monad.State (MonadState (get), StateT, gets, modify, modify', put, runState) -import Control.Monad.Trans (MonadIO, MonadTrans) -import Control.Monad.Trans.Maybe (MaybeT (runMaybeT)) +import Control.Monad.Trans (MonadIO) +import Control.Monad.Trans.Maybe (MaybeT (runMaybeT), hoistMaybe, maybeToExceptT) import Control.State.Transition (SingEP (..), globalAssertionPolicy) import Control.State.Transition.Extended ( ApplySTSOpts (..), TRC (..), ValidationPolicy (..), - applySTSOptsEither, + applySTSOptsEither ) +import Data.Bifunctor (Bifunctor (first)) import Data.Char (isSpace) import Data.Foldable (toList) import Data.Function (on) @@ -115,7 +122,9 @@ import Data.Text (Text) import PlutusLedgerApi.V1 qualified as P (Credential, Datum, DatumHash, TxOutRef) import PlutusLedgerApi.V1 qualified as PV1 import PlutusLedgerApi.V2 qualified as PV2 -import Prettyprinter (Doc, Pretty, colon, fillSep, hang, indent, pretty, vcat, vsep, (<+>)) +import PlutusLedgerApi.V3 qualified as PV3 +import Prettyprinter (Doc, Pretty, pretty, (<+>)) +import Prettyprinter qualified as Pretty import Test.Cardano.Ledger.Core.KeyPair qualified as TL import Text.Show.Pretty (ppShow) @@ -177,12 +186,12 @@ instance Pretty LogLevel where pretty Error = "[ERROR]" instance Pretty LogEntry where - pretty (LogEntry l msg) = pretty l <+> hang 1 msg' + pretty (LogEntry l msg) = pretty l <+> Pretty.hang 1 msg' where ws = wordsIdent <$> lines msg wsD = fmap pretty <$> ws - ls = fillSep <$> wsD - msg' = vsep ls + ls = Pretty.fillSep <$> wsD + msg' = Pretty.vsep ls -- | Like 'words' but keeps leading identation. wordsIdent :: String -> [String] @@ -261,9 +270,9 @@ instance Monoid (Log a) where mempty = Log Seq.empty ppLog :: Log LogEntry -> Doc ann -ppLog = vcat . fmap ppSlot . fromGroupLog +ppLog = Pretty.vcat . fmap ppSlot . fromGroupLog where - ppSlot (slot, events) = vcat [pretty slot <> colon, indent 2 (vcat $ pretty <$> events)] + ppSlot (slot, events) = Pretty.vcat [pretty slot <> Pretty.colon, Pretty.indent 2 (Pretty.vcat $ pretty <$> events)] fromGroupLog :: Log a -> [(Slot, [a])] fromGroupLog = fmap toGroup . groupBy ((==) `on` fst) . fromLog @@ -282,6 +291,31 @@ newtype Slot = Slot {getSlot :: Integer} instance Pretty Slot where pretty (Slot i) = "Slot" <+> pretty i +-- This data structure is used in a currently commented out logging flow. See note below in 'sendTx'. +data FailingPlutusScript = FailingPlutusScript + { fpsHash :: !(L.ScriptHash L.StandardCrypto) + , fpsLanguage :: !LedgerPlutus.Language + , fpsArgs :: ![PV2.Data] + } + +instance Pretty FailingPlutusScript where + pretty (FailingPlutusScript {fpsHash, fpsArgs, fpsLanguage}) = Pretty.nest 2 $ Pretty.vsep + [ "Failing Plutus Script" + , "Plutus language:" <+> Pretty.unsafeViaShow fpsLanguage + , "Script hash:" <+> Pretty.unsafeViaShow fpsHash + , Pretty.nest 2 . Pretty.vsep $ "Args" : argsDoc + , Pretty.nest 2 . Pretty.vsep $ ["ScriptContext", scriptCtxDoc] + ] + where + (argsDoc, scriptCtxDoc) = either error id . runExcept $ do + (rawArgs, rawScriptCtx) <- maybeToExceptT "absurd: FailingPlutusScript with no arguments" . hoistMaybe $ unsnoc fpsArgs + scriptCtxDoc' <- maybeToExceptT "absurd: FailingPlutusScript with non script context structure as the last argument" . hoistMaybe + $ case fpsLanguage of + LedgerPlutus.PlutusV1 -> Pretty.viaShow <$> PV2.fromData @PV1.ScriptContext rawScriptCtx + LedgerPlutus.PlutusV2 -> Pretty.viaShow <$> PV2.fromData @PV2.ScriptContext rawScriptCtx + LedgerPlutus.PlutusV3 -> Pretty.viaShow <$> PV2.fromData @PV3.ScriptContext rawScriptCtx + pure (Pretty.viaShow <$> rawArgs, scriptCtxDoc') + -------------------------------------------------------------------------------- -- Actions in Clb monad -------------------------------------------------------------------------------- @@ -376,15 +410,45 @@ getGlobals = do -- | Run `applyTx`, if succeed update state and record datums sendTx :: (Monad m) => C.Tx C.BabbageEra -> ClbT m ValidationResult -sendTx apiTx@(C.ShelleyTx _ tx) = do - state@ClbState {emulatedLedgerState} <- get - globals <- getGlobals - case applyTx ValidateAll globals emulatedLedgerState tx of - Right (newState, vtx) -> do - put $ state {emulatedLedgerState = newState} - recordNewDatums - return $ Success newState vtx - Left err -> return $ Fail tx err +sendTx apiTx@(C.ShelleyTx _ tx) = fmap (either (Fail tx) (uncurry Success)) . runExceptT $ do + state@ClbState {emulatedLedgerState, mockConfig} <- get + globals <- lift getGlobals + let utxo = getUtxosAtState state + sysS = L.systemStart globals + ei = L.epochInfo globals + pp = mockConfigProtocol mockConfig + sLst <- liftEither . first collectErrorsToApplyTx $ PlutusEval.collectPlutusScriptsWithContext ei sysS pp tx utxo + -- This will be more descriptive than just evaluating the scripts with the ledger (during applyTx below). + -- Specifically, it gives us access to the script contexts and the logs that we can show in case of script failure. + let (scriptLogs, scriptEvalResult) = PlutusEval.evalPlutusScriptsWithLogs tx sLst + -- Show the logs and the script context in debug. + lift . logInfo . LogEntry Debug $ ppShow scriptLogs + case scriptEvalResult of + LedgerPlutus.Passes _ -> pure () + LedgerPlutus.Fails _ fs -> do + -- Show the logs and the script context in case of failure. + lift . logInfo . LogEntry Error . show $ pretty scriptLogs + -- NOTE: The logging below is likely not necessary since the ValidationTagMismatch already contains an explanation of the error. + -- At least, that's what the codebase suggests + -- https://github.com/IntersectMBO/cardano-ledger/blob/ad4704f243e0e62216811b816f210b770f12a420/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Evaluate.hs#L257C25-L257C53 + -- https://github.com/IntersectMBO/cardano-ledger/blob/ad4704f243e0e62216811b816f210b770f12a420/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs#L364 + -- If logging is missing, go ahead and try uncommenting the below lines. + + -- for_ plutusWithCtxs $ \LedgerPlutus.PlutusWithContext {pwcScript,pwcScriptHash=fpsHash,pwcDatums=LedgerPlutus.PlutusDatums fpsArgs} -> do + -- let langDeducer :: forall l. LedgerPlutus.PlutusLanguage l => Either (LedgerPlutus.Plutus l) (LedgerPlutus.PlutusRunnable l) -> LedgerPlutus.Language + -- langDeducer _ = LedgerPlutus.plutusLanguage $ Proxy @l + -- -- NOTE: Args is essentially (datum, redeemer, script context) or (redeemer, script context). + -- -- See: https://github.com/IntersectMBO/cardano-ledger/blob/ed6d38b0bf0a54504c781b3c274745846476ca3c/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Evaluate.hs#L190 + -- lift . logInfo . LogEntry Error . show $ pretty FailingPlutusScript {fpsHash, fpsArgs,fpsLanguage=langDeducer pwcScript} + let failure = liftAlonzoUtxosFailure $ + Rules.A.ValidationTagMismatch @EmulatorEra + (tx ^. L.isValidTxL) + (Rules.A.FailedUnexpectedly (Rules.A.scriptFailureToFailureDescription <$> fs)) + throwError $ L.ApplyTxError @EmulatorEra [failure] + (newState, vtx) <- liftEither $ applyTx ValidateAll globals emulatedLedgerState tx + put $ state {emulatedLedgerState = newState} + recordNewDatums + pure (newState, vtx) where recordNewDatums = do state@ClbState {mockDatums} <- get @@ -393,6 +457,17 @@ sendTx apiTx@(C.ShelleyTx _ tx) = do state { mockDatums = M.union mockDatums txDatums } + -- Adapted from: https://github.com/IntersectMBO/cardano-ledger/blob/411054e40b4e08350049e4eaffdf0cc5f73e9d91/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs#L199 + -- Goal is to convert the [CollectError] stuff from the result into ApplyTxError. + collectErrorsToApplyTx :: [PlutusEval.CollectError EmulatorEra] -> ValidationError + collectErrorsToApplyTx errs = + let failure = liftAlonzoUtxosFailure $ Rules.A.CollectErrors errs + in L.ApplyTxError [failure] + + -- Replace this with 'injectFailure' when using cardano-ledger-shelley ^>= 1.10.0.0 etc. (waiting for atlas-cardano to use those deps) + -- This is hardcoded, needs update every time era changes and is generally terrible. + liftAlonzoUtxosFailure :: Rules.A.AlonzoUtxosPredFailure EmulatorEra -> Rules.S.ShelleyLedgerPredFailure EmulatorEra + liftAlonzoUtxosFailure = Rules.S.UtxowFailure . Rules.B.UtxoFailure . Rules.B.AlonzoInBabbageUtxoPredFailure . Rules.A.UtxosFailure {- | Given a 'C.TxBody from a 'C.Tx era', return the datums and redeemers along with their hashes. diff --git a/test/smoke/smoke-test.hs b/test/smoke/smoke-test.hs index 93b774a..951c812 100644 --- a/test/smoke/smoke-test.hs +++ b/test/smoke/smoke-test.hs @@ -1,6 +1,10 @@ module Main where -import Cardano.Api (Lovelace (Lovelace), lovelaceToValue) +import Cardano.Api.Value (lovelaceToValue) +import Cardano.Ledger.Coin (Coin (Coin)) +import Prettyprinter +import Prettyprinter.Render.String (renderString) + import Clb ( ClbState (mockInfo), checkErrors, @@ -10,14 +14,12 @@ import Clb ( ppLog, runClb, ) -import Prettyprinter -import Prettyprinter.Render.String (renderString) main :: IO () main = do putStrLn "Welcome to the smoke-test CLB harness!" - let _dummyTotalNotUsedNow = lovelaceToValue $ Lovelace 1_000_000_000_000 - let perWallet = lovelaceToValue $ Lovelace 1_000_000_000 + let _dummyTotalNotUsedNow = lovelaceToValue $ Coin 1_000_000_000_000 + let perWallet = lovelaceToValue $ Coin 1_000_000_000 let (_mbErrors, clb) = runClb (dumpUtxoState >> checkErrors) $ initClb defaultBabbage _dummyTotalNotUsedNow perWallet