Merge pull request #10 from input-output-hk/bump-cardano-node-v8_2 bump cardano-… - input-output-hk/antaeus@0ebeec98 - Cardano Updates

Home / Input Output / antaeus / 0ebeec98

View on GitHub

File Changes

m

README.md

+2/-2

---

-

### Test Report TMP

+

### Test Report

After every test run a JUnit XML report is produced in e2e-tests/test-report-xml/test-results.xml. An existing report will be overwritten.

Run `allure serve <test-report-xml>` to generate and host the Allure report.

### Licensing

-

You are free to copy, modify, and distribute Antaeus under the terms of the Apache 2.0 license. See the [LICENSE](./LICENSE) and [NOTICE](./NOTICE) files for details.

\ No newline at end of file

+

You are free to copy, modify, and distribute Antaeus under the terms of the Apache 2.0 license. See the [LICENSE](./LICENSE) and [NOTICE](./NOTICE) files for details.

m

__std__/cells/antaeus/library/cabal-project-index-state.nix

+1/-1

{ inputs, cell }:

-

cell.library.antaeus-project.index-state

+

cell.library.antaeus-project.index-state-max

m

__std__/cells/antaeus/library/cardano-node.nix

+2/-2

      type = "github";

      owner = "input-output-hk";

      repo = "cardano-node";

-

      rev = "ebc7be471b30e5931b35f9bbc236d21c375b91bb";

-

      narHash = "sha256-WRRzfpDc+YVmTNbN9LNYY4dS8o21p/6NoKxtcZmoAcg=";

+

      rev = "a158a679690ed8b003ee06e1216ac8acd5ab823d";

+

      narHash = "sha256-uY7wPyCgKuIZcGu0+vGacjGw2kox8H5ZsVGsfTNtU0c=";

};

};

in

m

__std__/cells/antaeus/library/make-antaeus-project.nix

+2/-5

    #  source-repository-packages

    sha256map = {

-

      "https://github.com/input-output-hk/cardano-addresses"."b7273a5d3c21f1a003595ebf1e1f79c28cd72513" = "129r5kyiw10n2021bkdvnr270aiiwyq58h472d151ph0r7wpslgp";

-

      "https://github.com/input-output-hk/cardano-config"."1646e9167fab36c0bff82317743b96efa2d3adaa" = "sha256-TNbpnR7llUgBN2WY7CryMxNVupBIUH01h1hRNHoxboY=";

-

      "https://github.com/input-output-hk/cardano-ledger"."da3e9ae10cf9ef0b805a046c84745f06643583c2" = "sha256-3VUZKkLu1R43GUk9IwgsGQ55O0rnu8NrCkFX9gqA4ck=";

-

      "https://github.com/input-output-hk/cardano-wallet"."18a931648550246695c790578d4a55ee2f10463e" = "0i40hp1mdbljjcj4pn3n6zahblkb2jmpm8l4wnb36bya1pzf66fx";

-

      "https://github.com/sevanspowell/hw-aeson"."b5ef03a7d7443fcd6217ed88c335f0c411a05408" = "1dwx90wqavdl4d0npbzbxyh2pzi9zs1qz7nvsrb3n1cm2xbv4i5z";

+

      "https://github.com/input-output-hk/cardano-node"."a158a679690ed8b003ee06e1216ac8acd5ab823d" = "sha256-uY7wPyCgKuIZcGu0+vGacjGw2kox8H5ZsVGsfTNtU0c=";

+

      "https://github.com/james-iohk/cardano-node"."adf50dc5de3d44bdb5c3dc0b28e18b3a5477f36c" = "18yhmfa95sfry9jsgv9rg1giv73235wwjvw7qr3jximj88gprakn";

};

    inputMap = {

m

cabal.project

+25/-80

    c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56

    d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee

-

index-state: 2023-02-28T00:00:00Z

-

-- See CONTRIBUTING.adoc for how to update index-state

index-state:

-

  , hackage.haskell.org 2023-02-28T00:00:00Z

-

  , cardano-haskell-packages 2023-03-13T07:15:21Z

+

  , hackage.haskell.org 2023-05-11T00:00:00Z

+

  , cardano-haskell-packages 2023-05-11T00:00:00Z

packages: e2e-tests

-- We never, ever, want this.

-- 'tasty' output.

test-show-details: direct

-

allow-newer:

-

  -- cardano-ledger packages need aeson >2, the following packages have a

-

  -- too restictive upper bounds on aeson, so we relax them here. The hackage

-

  -- trustees can make a revision to these packages cabal file to solve the

-

  -- issue permanently.

-

  , ekg:aeson

-

  , ekg-json:aeson

-

  , openapi3:aeson

-

  , servant:aeson

-

  , servant-client-core:aeson

-

  , servant-server:aeson

-

  , servant-foreign:lens

-

-

allow-older:

-

  -- freer-extras works with lens-5.2 (rather than 5.2.1)

-

  , freer-extras:lens

-

  -- freer-extras works with resource-pool-0.3.1.0 (rather than 0.4.0.0)

-

  , freer-extras:resource-pool

-

  -- plutus-ledger works with lens-5.2 (rather than 5.2.1)

-

  , plutus-ledger:lens

-

-

constraints:

-

  -- cardano-prelude-0.1.0.0 needs

-

  , protolude <0.3.1

-

-

  -- cardano-ledger-byron-0.1.0.0 needs

-

  , cardano-binary <1.5.0.1

-

-

  -- plutus-core-1.0.0.1 needs

-

  , cardano-crypto-class >2.0.0.0

-

  , algebraic-graphs <0.7

-

-

  , cardano-data == 0.1.0.0

-

-

  -- cardano-ledger-core-0.1.0.0 needs

-

  , cardano-crypto-class <2.0.0.1

-

-

  -- cardano-crypto-class-2.0.0.0.1 needs

-

  , cardano-prelude <0.1.0.1

-

-

  -- dbvar from cardano-wallet needs

-

  , io-classes <0.3.0.0

-

-

  -- newer typed-protocols need io-classes>=0.3.0.0 which is incompatible with dbvar's constraint above

-

  , typed-protocols==0.1.0.0

-

-

  , aeson >= 2

-

-

  , hedgehog >= 1.1

-

-

  , resource-pool <0.4.0.0

-

-

  , http2 <4.0.0

-

-

  -- ouroboros-consensus-shelley-0.1.0.1 needs

-

  , ouroboros-consensus-protocol==0.1.0.1

-

-

  -- ledger packages:

-

  , cardano-ledger-alonzo == 0.1.0.0

-

  , cardano-ledger-babbage == 0.1.0.0

-

  , cardano-ledger-byron == 0.1.0.0

-

  , cardano-ledger-byron-test == 1.3.0

-

  , cardano-ledger-conway == 0.1.0.0

-

  , cardano-ledger-core == 0.1.0.0

-

  , cardano-ledger-pretty == 0.1.0.0

-

  , cardano-ledger-shelley == 0.1.0.0

-

  , cardano-ledger-shelley-ma == 0.1.0.0

-

  , cardano-crypto-test == 1.3.0

-

  , cardano-crypto-wrapper == 1.3.0

-

  , byron-spec-chain == 0.1.0.0

-

  , byron-spec-ledger == 0.1.0.0

-

  , set-algebra == 0.1.0.0

-

  , small-steps == 0.1.0.0

-

  , small-steps-test == 0.1.0.0

-

  , vector-map == 0.1.0.0

-

-- These packages appear in our dependency tree and are very slow to build.

-- Empirically, turning off optimization shaves off ~50% build time.

-- It also mildly improves recompilation avoidance.

package cardano-api

  optimization: False

+

package cardano-crypto-praos

+

  flags: -external-libsodium-vrf

+

+

-- Pin to the master with 8.0.0 version (not an official release)

+

source-repository-package

+

    type: git

+

    location: https://github.com/input-output-hk/cardano-node

+

    tag: a158a679690ed8b003ee06e1216ac8acd5ab823d

+

    subdir:

+

      cardano-api

+

      cardano-cli

+

      cardano-node

+

      trace-forward

+

      trace-dispatcher

+

      trace-resources

+

+

-- Fork for improvements to Babbage testnet - see https://github.com/input-output-hk/cardano-node/pull/5224

+

source-repository-package

+

    type: git

+

    location: https://github.com/james-iohk/cardano-node

+

    tag: adf50dc5de3d44bdb5c3dc0b28e18b3a5477f36c

+

    subdir:

+

      cardano-testnet

a

cardano-cli/test/data/golden/alonzo/genesis.alonzo.spec.json

+194/-0

+

+

    "lovelacePerUTxOWord": 34482,

+

    "executionPrices": {

+

        "prSteps": {

+

            "numerator": 721,

+

            "denominator": 10000000

+

},

+

        "prMem": {

+

            "numerator": 577,

+

            "denominator": 10000

+

+

},

+

    "maxTxExUnits": {

+

        "exUnitsMem": 10000000,

+

        "exUnitsSteps": 10000000000

+

},

+

    "maxBlockExUnits": {

+

        "exUnitsMem": 50000000,

+

        "exUnitsSteps": 40000000000

+

},

+

    "maxValueSize": 5000,

+

    "collateralPercentage": 150,

+

    "maxCollateralInputs": 3,

+

    "costModels": {

+

        "PlutusV1": {

+

            "sha2_256-memory-arguments": 4,

+

            "equalsString-cpu-arguments-constant": 1000,

+

            "cekDelayCost-exBudgetMemory": 100,

+

            "lessThanEqualsByteString-cpu-arguments-intercept": 103599,

+

            "divideInteger-memory-arguments-minimum": 1,

+

            "appendByteString-cpu-arguments-slope": 621,

+

            "blake2b-cpu-arguments-slope": 29175,

+

            "iData-cpu-arguments": 150000,

+

            "encodeUtf8-cpu-arguments-slope": 1000,

+

            "unBData-cpu-arguments": 150000,

+

            "multiplyInteger-cpu-arguments-intercept": 61516,

+

            "cekConstCost-exBudgetMemory": 100,

+

            "nullList-cpu-arguments": 150000,

+

            "equalsString-cpu-arguments-intercept": 150000,

+

            "trace-cpu-arguments": 150000,

+

            "mkNilData-memory-arguments": 32,

+

            "lengthOfByteString-cpu-arguments": 150000,

+

            "cekBuiltinCost-exBudgetCPU": 29773,

+

            "bData-cpu-arguments": 150000,

+

            "subtractInteger-cpu-arguments-slope": 0,

+

            "unIData-cpu-arguments": 150000,

+

            "consByteString-memory-arguments-intercept": 0,

+

            "divideInteger-memory-arguments-slope": 1,

+

            "divideInteger-cpu-arguments-model-arguments-slope": 118,

+

            "listData-cpu-arguments": 150000,

+

            "headList-cpu-arguments": 150000,

+

            "chooseData-memory-arguments": 32,

+

            "equalsInteger-cpu-arguments-intercept": 136542,

+

            "sha3_256-cpu-arguments-slope": 82363,

+

            "sliceByteString-cpu-arguments-slope": 5000,

+

            "unMapData-cpu-arguments": 150000,

+

            "lessThanInteger-cpu-arguments-intercept": 179690,

+

            "mkCons-cpu-arguments": 150000,

+

            "appendString-memory-arguments-intercept": 0,

+

            "modInteger-cpu-arguments-model-arguments-slope": 118,

+

            "ifThenElse-cpu-arguments": 1,

+

            "mkNilPairData-cpu-arguments": 150000,

+

            "lessThanEqualsInteger-cpu-arguments-intercept": 145276,

+

            "addInteger-memory-arguments-slope": 1,

+

            "chooseList-memory-arguments": 32,

+

            "constrData-memory-arguments": 32,

+

            "decodeUtf8-cpu-arguments-intercept": 150000,

+

            "equalsData-memory-arguments": 1,

+

            "subtractInteger-memory-arguments-slope": 1,

+

            "appendByteString-memory-arguments-intercept": 0,

+

            "lengthOfByteString-memory-arguments": 4,

+

            "headList-memory-arguments": 32,

+

            "listData-memory-arguments": 32,

+

            "consByteString-cpu-arguments-intercept": 150000,

+

            "unIData-memory-arguments": 32,

+

            "remainderInteger-memory-arguments-minimum": 1,

+

            "bData-memory-arguments": 32,

+

            "lessThanByteString-cpu-arguments-slope": 248,

+

            "encodeUtf8-memory-arguments-intercept": 0,

+

            "cekStartupCost-exBudgetCPU": 100,

+

            "multiplyInteger-memory-arguments-intercept": 0,

+

            "unListData-memory-arguments": 32,

+

            "remainderInteger-cpu-arguments-model-arguments-slope": 118,

+

            "cekVarCost-exBudgetCPU": 29773,

+

            "remainderInteger-memory-arguments-slope": 1,

+

            "cekForceCost-exBudgetCPU": 29773,

+

            "sha2_256-cpu-arguments-slope": 29175,

+

            "equalsInteger-memory-arguments": 1,

+

            "indexByteString-memory-arguments": 1,

+

            "addInteger-memory-arguments-intercept": 1,

+

            "chooseUnit-cpu-arguments": 150000,

+

            "sndPair-cpu-arguments": 150000,

+

            "cekLamCost-exBudgetCPU": 29773,

+

            "fstPair-cpu-arguments": 150000,

+

            "quotientInteger-memory-arguments-minimum": 1,

+

            "decodeUtf8-cpu-arguments-slope": 1000,

+

            "lessThanInteger-memory-arguments": 1,

+

            "lessThanEqualsInteger-cpu-arguments-slope": 1366,

+

            "fstPair-memory-arguments": 32,

+

            "modInteger-memory-arguments-intercept": 0,

+

            "unConstrData-cpu-arguments": 150000,

+

            "lessThanEqualsInteger-memory-arguments": 1,

+

            "chooseUnit-memory-arguments": 32,

+

            "sndPair-memory-arguments": 32,

+

            "addInteger-cpu-arguments-intercept": 197209,

+

            "decodeUtf8-memory-arguments-slope": 8,

+

            "equalsData-cpu-arguments-intercept": 150000,

+

            "mapData-cpu-arguments": 150000,

+

            "mkPairData-cpu-arguments": 150000,

+

            "quotientInteger-cpu-arguments-constant": 148000,

+

            "consByteString-memory-arguments-slope": 1,

+

            "cekVarCost-exBudgetMemory": 100,

+

            "indexByteString-cpu-arguments": 150000,

+

            "unListData-cpu-arguments": 150000,

+

            "equalsInteger-cpu-arguments-slope": 1326,

+

            "cekStartupCost-exBudgetMemory": 100,

+

            "subtractInteger-cpu-arguments-intercept": 197209,

+

            "divideInteger-cpu-arguments-model-arguments-intercept": 425507,

+

            "divideInteger-memory-arguments-intercept": 0,

+

            "cekForceCost-exBudgetMemory": 100,

+

            "blake2b-cpu-arguments-intercept": 2477736,

+

            "remainderInteger-cpu-arguments-constant": 148000,

+

            "tailList-cpu-arguments": 150000,

+

            "encodeUtf8-cpu-arguments-intercept": 150000,

+

            "equalsString-cpu-arguments-slope": 1000,

+

            "lessThanByteString-memory-arguments": 1,

+

            "multiplyInteger-cpu-arguments-slope": 11218,

+

            "appendByteString-cpu-arguments-intercept": 396231,

+

            "lessThanEqualsByteString-cpu-arguments-slope": 248,

+

            "modInteger-memory-arguments-slope": 1,

+

            "addInteger-cpu-arguments-slope": 0,

+

            "equalsData-cpu-arguments-slope": 10000,

+

            "decodeUtf8-memory-arguments-intercept": 0,

+

            "chooseList-cpu-arguments": 150000,

+

            "constrData-cpu-arguments": 150000,

+

            "equalsByteString-memory-arguments": 1,

+

            "cekApplyCost-exBudgetCPU": 29773,

+

            "quotientInteger-memory-arguments-slope": 1,

+

            "verifySignature-cpu-arguments-intercept": 3345831,

+

            "unMapData-memory-arguments": 32,

+

            "mkCons-memory-arguments": 32,

+

            "sliceByteString-memory-arguments-slope": 1,

+

            "sha3_256-memory-arguments": 4,

+

            "ifThenElse-memory-arguments": 1,

+

            "mkNilPairData-memory-arguments": 32,

+

            "equalsByteString-cpu-arguments-slope": 247,

+

            "appendString-cpu-arguments-intercept": 150000,

+

            "quotientInteger-cpu-arguments-model-arguments-slope": 118,

+

            "cekApplyCost-exBudgetMemory": 100,

+

            "equalsString-memory-arguments": 1,

+

            "multiplyInteger-memory-arguments-slope": 1,

+

            "cekBuiltinCost-exBudgetMemory": 100,

+

            "remainderInteger-memory-arguments-intercept": 0,

+

            "sha2_256-cpu-arguments-intercept": 2477736,

+

            "remainderInteger-cpu-arguments-model-arguments-intercept": 425507,

+

            "lessThanEqualsByteString-memory-arguments": 1,

+

            "tailList-memory-arguments": 32,

+

            "mkNilData-cpu-arguments": 150000,

+

            "chooseData-cpu-arguments": 150000,

+

            "unBData-memory-arguments": 32,

+

            "blake2b-memory-arguments": 4,

+

            "iData-memory-arguments": 32,

+

            "nullList-memory-arguments": 32,

+

            "cekDelayCost-exBudgetCPU": 29773,

+

            "subtractInteger-memory-arguments-intercept": 1,

+

            "lessThanByteString-cpu-arguments-intercept": 103599,

+

            "consByteString-cpu-arguments-slope": 1000,

+

            "appendByteString-memory-arguments-slope": 1,

+

            "trace-memory-arguments": 32,

+

            "divideInteger-cpu-arguments-constant": 148000,

+

            "cekConstCost-exBudgetCPU": 29773,

+

            "encodeUtf8-memory-arguments-slope": 8,

+

            "quotientInteger-cpu-arguments-model-arguments-intercept": 425507,

+

            "mapData-memory-arguments": 32,

+

            "appendString-cpu-arguments-slope": 1000,

+

            "modInteger-cpu-arguments-constant": 148000,

+

            "verifySignature-cpu-arguments-slope": 1,

+

            "unConstrData-memory-arguments": 32,

+

            "quotientInteger-memory-arguments-intercept": 0,

+

            "equalsByteString-cpu-arguments-constant": 150000,

+

            "sliceByteString-memory-arguments-intercept": 0,

+

            "mkPairData-memory-arguments": 32,

+

            "equalsByteString-cpu-arguments-intercept": 112536,

+

            "appendString-memory-arguments-slope": 1,

+

            "lessThanInteger-cpu-arguments-slope": 497,

+

            "modInteger-cpu-arguments-model-arguments-intercept": 425507,

+

            "modInteger-memory-arguments-minimum": 1,

+

            "sha3_256-cpu-arguments-intercept": 0,

+

            "verifySignature-memory-arguments": 1,

+

            "cekLamCost-exBudgetMemory": 100,

+

            "sliceByteString-cpu-arguments-intercept": 150000

+

+

+

\ No newline at end of file

a

cardano-cli/test/data/golden/conway/genesis.conway.spec.json

+3/-0

+

+

  "genDelegs": {}

+

m

e2e-tests/e2e-tests.cabal

+37/-12

  -- Other IOG dependencies

  --------------------------

  build-depends:

-

    , cardano-api

+

    , cardano-api                    ^>=8.0

    , cardano-binary

-

    , cardano-ledger-alonzo

-

    , cardano-ledger-babbage

+

    , cardano-crypto-class

+

    , cardano-crypto-wrapper

+

    , cardano-ledger-allegra

+

    , cardano-ledger-alonzo          ^>=1.1

+

    , cardano-ledger-babbage         ^>=1.1

+

    , cardano-ledger-binary

    , cardano-ledger-byron

+

    , cardano-ledger-conway          ^>=1.1

    , cardano-ledger-core

+

    , cardano-ledger-mary            ^>=1.1

    , cardano-ledger-shelley

-

    , cardano-ledger-shelley-ma

+

    , cardano-protocol-tpraos        ^>=1.0

+

    , cardano-slotting

+

    , cardano-testnet                ^>=8.0

    , iohk-monitoring

+

    , ouroboros-consensus

+

    , ouroboros-consensus-byron

+

    , ouroboros-consensus-cardano

+

    , ouroboros-consensus-diffusion

+

    , ouroboros-consensus-protocol   ^>=0.4

+

    , ouroboros-consensus-shelley

+

    , ouroboros-network-api

  ------------------------

  -- Non-IOG dependencies

  ------------------------

  build-depends:

-

    , base

+

    , base                  >=4.9 && <5

    , bytestring

    , containers

    , filepath

    , optparse-applicative

    , prettyprinter

    , process

+

    , random

    , serialise

    , sqlite-simple

    , stm

  main-is:        Spec.hs

  hs-source-dirs: test

  other-modules:

-

    CardanoTestnet

    Helpers.Common

    Helpers.Query

    Helpers.ScriptUtils

    Helpers.Tx

    Helpers.TypeConverters

    Helpers.Utils

+

    OldPlutus.CBOR.Extras

+

    OldPlutus.Prettyprinter.Extras

+

    OldPlutus.Scripts

    PlutusScripts.Always

    PlutusScripts.Helpers

    PlutusScripts.SECP256k1

  -- Other IOG dependencies

  --------------------------

  build-depends:

-

    , cardano-api:{cardano-api, gen}

-

    , cardano-testnet

+

    , cardano-api:{cardano-api, gen}  ^>=8.0

+

    , cardano-binary

+

    , cardano-crypto-class

+

    , cardano-ledger-core

+

    , cardano-testnet                 ^>=8.0

    , iohk-monitoring

    , ouroboros-network

-

    , plutus-core                     ==1.0.0.1

-

    , plutus-ledger-api               ==1.0.0.1

-

    , plutus-tx                       ==1.0.0.0

-

    , plutus-tx-plugin                ==1.0.0.0

+

    , plutus-core

+

    , plutus-ledger-api               ^>=1.1

+

    , plutus-tx

+

    , plutus-tx-plugin

  ------------------------

  -- Non-IOG dependencies

    , async

    , base             >=4.9 && <5

    , bytestring

+

    , cborg

    , containers

+

    , deepseq

    , directory

    , exceptions

    , filepath

+

    , flat

    , hedgehog

    , hedgehog-extras

    , prettyprinter

    , serialise

    , stm

    , streaming

+

    , tagged

    , tasty

    , tasty-hedgehog

    , temporary

r

e2e-tests/test/CardanoTestnet.hs

+0/-471

-

{-# LANGUAGE CPP                 #-}

-

{-# LANGUAGE GADTs               #-}

-

{-# LANGUAGE NamedFieldPuns      #-}

-

{-# LANGUAGE NumericUnderscores  #-}

-

{-# LANGUAGE OverloadedStrings   #-}

-

{-# LANGUAGE RecordWildCards     #-}

-

{-# LANGUAGE ScopedTypeVariables #-}

-

{-# LANGUAGE TypeApplications    #-}

-

-

{-# OPTIONS_GHC -Wno-unused-local-binds -Wno-unused-matches #-}

-

{-# OPTIONS_GHC -Wno-name-shadowing #-}

-

{-# OPTIONS_GHC -Wno-missing-import-lists #-}

-

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-

-

-- | Copy of Cardano.Babbage from cardano-testnet (1.35.4 branch) with some tweaks to make it

-

--   work correctly in Alonzo and Babbage eras. Will use cardano-testnet in future when it has

-

--   been refined to work correctly in multi-era.

-

module CardanoTestnet

-

  ( TestnetOptions(..)

-

  , defaultTestnetOptions

-

  , TestnetNodeOptions(..)

-

  , defaultTestnetNodeOptions

-

-

  , Era(..)

-

  , TestnetRuntime (..)

-

  , TestnetNode (..)

-

  , PaymentKeyPair(..)

-

-

  , testnet

-

  ) where

-

-

import Cardano.Api qualified as C

-

import Control.Concurrent (threadDelay)

-

import Control.Monad (forM, forM_, unless, when)

-

import Control.Monad.IO.Class (MonadIO, liftIO)

-

import Data.Aeson (encode, object, toJSON, (.=))

-

import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))

-

import Hedgehog.Extras.Stock.Time (showUTCTimeSeconds)

-

import System.FilePath.Posix ((</>))

-

import Test.Runtime (Delegator (..), NodeLoggingFormat (..), PaymentKeyPair (..), PoolNode (PoolNode),

-

                     PoolNodeKeys (..), StakingKeyPair (..), TestnetNode (..), TestnetRuntime (..))

-

-

import Data.Functor (void, ($>), (<&>))

-

import Data.HashMap.Lazy qualified as HM

-

import Data.List qualified as L

-

import Data.Time.Clock qualified as DTC

-

import Hedgehog (MonadTest)

-

import Hedgehog qualified as H

-

import Hedgehog.Extras.Stock.Aeson qualified as J

-

import Hedgehog.Extras.Stock.IO.Network.Socket qualified as H

-

import Hedgehog.Extras.Stock.IO.Network.Sprocket qualified as IO

-

import Hedgehog.Extras.Stock.OS qualified as OS

-

import Hedgehog.Extras.Stock.String qualified as S

-

import Hedgehog.Extras.Test.Base qualified as H

-

import Hedgehog.Extras.Test.File qualified as H

-

import Hedgehog.Extras.Test.Process qualified as H

-

import Network.Socket qualified as IO

-

import System.IO qualified as IO

-

import System.Info qualified as OS

-

import System.Process qualified as IO

-

import Test.Assert qualified as H

-

import Test.Process qualified as H

-

import Testnet.Conf qualified as H

-

import UnliftIO.Exception qualified as IO

-

-

{- HLINT ignore "Reduce duplication" -}

-

{- HLINT ignore "Redundant <&>" -}

-

{- HLINT ignore "Redundant flip" -}

-

{- HLINT ignore "Redundant id" -}

-

{- HLINT ignore "Use let" -}

-

-

data Era = Alonzo | Babbage deriving (Eq, Show)

-

-

data TestnetOptions = TestnetOptions

-

  { era               :: C.AnyCardanoEra

-

  , protocolVersion   :: Int

-

  , slotDuration      :: Int

-

  , slotLength        :: Double

-

  , activeSlotsCoeff  :: Double

-

  , securityParam     :: Int

-

  , totalBalance      :: Int

-

  , nodeLoggingFormat :: NodeLoggingFormat

-

  } deriving (Eq, Show)

-

-

defaultTestnetOptions :: TestnetOptions

-

defaultTestnetOptions = TestnetOptions

-

  { era = C.AnyCardanoEra C.BabbageEra

-

  , protocolVersion = 8

-

  , slotDuration = 1000

-

  , slotLength = 0.2

-

  , activeSlotsCoeff = 0.1 -- higher value (e.g. 0.9) prevents long waits for slot leader but could be the cause of more rollbacks/forks

-

  , securityParam = 10

-

  , totalBalance = 10020000000

-

  , nodeLoggingFormat = NodeLoggingFormatAsJson

-

-

-

data TestnetNodeOptions = TestnetNodeOptions deriving (Eq, Show)

-

-

defaultTestnetNodeOptions :: TestnetNodeOptions

-

defaultTestnetNodeOptions = TestnetNodeOptions

-

-

-- | For an unknown reason, CLI commands are a lot slower on Windows than on Linux and

-

-- MacOS.  We need to allow a lot more time to set up a testnet.

-

startTimeOffsetSeconds :: DTC.NominalDiffTime

-

startTimeOffsetSeconds = if OS.isWin32 then 90 else 15

-

-

-- | Check if a TCP port is open

-

isPortOpen :: Int -> IO Bool

-

isPortOpen port = do

-

  socketAddressInfos <- IO.getAddrInfo Nothing (Just "127.0.0.1") (Just (show port))

-

  case socketAddressInfos of

-

    socketAddressInfo:_ -> canConnect (IO.addrAddress socketAddressInfo) $> True

-

    []                  -> return False

-

-

-- | Check if it is possible to connect to a socket address

-

-- TODO: upstream fix to Hedgehog Extras

-

canConnect :: IO.SockAddr -> IO Bool

-

canConnect sockAddr = IO.bracket (IO.socket IO.AF_INET IO.Stream 6) IO.close' $ \sock -> do

-

  res <- IO.try $ IO.connect sock sockAddr

-

  case res of

-

    Left (_ :: IO.IOException) -> return False

-

    Right _                    -> return True

-

-

-- | Get random list of open ports. Timeout after 60seconds if unsuccessful.

-

getOpenPorts :: (MonadTest m, Control.Monad.IO.Class.MonadIO m) => Int -> Int -> m [Int]

-

getOpenPorts n numberOfPorts = do

-

  when (n == 0) $ do

-

   error "getOpenPorts timeout"

-

  ports <- liftIO $ H.allocateRandomPorts numberOfPorts

-

  allOpen <- liftIO $ mapM isPortOpen ports

-

  unless (and allOpen) $ do

-

    H.annotate "Some ports are not open, trying again..."

-

    liftIO $ threadDelay 1_000_000 -- wait 1 sec

-

    void $ getOpenPorts (pred n) numberOfPorts

-

  pure ports

-

-

testnet :: TestnetOptions -> H.Conf -> H.Integration TestnetRuntime

-

testnet testnetOptions H.Conf {..} = do

-

  H.createDirectoryIfMissing (tempAbsPath </> "logs")

-

-

  H.lbsWriteFile (tempAbsPath </> "byron.genesis.spec.json") . encode $ object

-

    [ "heavyDelThd"       .= ("300000000000" :: String)

-

    , "maxBlockSize"      .= ("2000000" :: String)

-

    , "maxTxSize"         .= ("4096" :: String)

-

    , "maxHeaderSize"     .= ("2000000" :: String)

-

    , "maxProposalSize"   .= ("700" :: String)

-

    , "mpcThd"            .= ("20000000000000" :: String)

-

    , "scriptVersion"     .= (0 :: Int)

-

    , "slotDuration"      .= show @Int (slotDuration testnetOptions)

-

    , "unlockStakeEpoch"  .= ("18446744073709551615" :: String)

-

    , "updateImplicit"    .= ("10000" :: String)

-

    , "updateProposalThd" .= ("100000000000000" :: String)

-

    , "updateVoteThd"     .= ("1000000000000" :: String)

-

    , "softforkRule" .= object

-

      [ "initThd" .= ("900000000000000" :: String)

-

      , "minThd" .= ("600000000000000" :: String)

-

      , "thdDecrement" .= ("50000000000000" :: String)

-

-

    , "txFeePolicy" .= object

-

      [ "multiplier" .= ("43946000000" :: String)

-

      , "summand" .= ("155381000000000" :: String)

-

-

-

-

  void $ H.note OS.os

-

  currentTime <- H.noteShowIO DTC.getCurrentTime

-

  startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime

-

-

  let numPoolNodes = 3 :: Int

-

-

  void . H.execCli $

-

    [ "byron", "genesis", "genesis"

-

    , "--protocol-magic", show @Int testnetMagic

-

    , "--start-time", showUTCTimeSeconds startTime

-

    , "--k", show @Int (securityParam testnetOptions)

-

    , "--n-poor-addresses", "0"

-

    , "--n-delegate-addresses", show numPoolNodes

-

    , "--total-balance", show @Int (totalBalance testnetOptions)

-

    , "--delegate-share", "1"

-

    , "--avvm-entry-count", "0"

-

    , "--avvm-entry-balance", "0"

-

    , "--protocol-parameters-file", tempAbsPath </> "byron.genesis.spec.json"

-

    , "--genesis-output-dir", tempAbsPath </> "byron-gen-command"

-

-

-

  -- Because in Babbage the overlay schedule and decentralization parameter

-

  -- are deprecated, we must use the "create-staked" cli command to create

-

  -- SPOs in the ShelleyGenesis

-

-

  alonzoBabbageTestGenesisJsonSourceFile <- H.noteShow $ base </> "scripts/babbage/alonzo-babbage-test-genesis.json"

-

  alonzoBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath </> "genesis.alonzo.spec.json"

-

-

  H.copyFile alonzoBabbageTestGenesisJsonSourceFile alonzoBabbageTestGenesisJsonTargetFile

-

-

  configurationFile <- H.noteShow $ tempAbsPath </> "configuration.yaml"

-

-

  H.readFile configurationTemplate >>= H.writeFile configurationFile

-

-

  H.rewriteYamlFile (tempAbsPath </> "configuration.yaml") . J.rewriteObject

m

e2e-tests/test/Helpers/Common.hs

+1/-1

import Cardano.Api qualified as C

-- | Any CardanoEra with CardanoMode

-

toEraInCardanoMode :: C.CardanoEra era -> (C.EraInMode era C.CardanoMode)

+

toEraInCardanoMode :: C.CardanoEra era -> C.EraInMode era C.CardanoMode

toEraInCardanoMode era = fromMaybe $ C.toEraInMode era C.CardanoMode

  where

    fromMaybe Nothing    = error $ "No mode for this era " ++ show era ++ " in CardanoMode"

m

e2e-tests/test/Helpers/ScriptUtils.hs

+2/-2

-- subset of utilities from plutus-script-utils

module Helpers.ScriptUtils where

-

import Plutus.V1.Ledger.Api qualified as PV1

-

import Plutus.V2.Ledger.Api qualified as PV2

+

import PlutusLedgerApi.V1 qualified as PV1

+

import PlutusLedgerApi.V2 qualified as PV2

import PlutusTx (UnsafeFromData)

import PlutusTx.Prelude qualified as P

m

e2e-tests/test/Helpers/Test.hs

+0/-1

    success

) where

-

import CardanoTestnet qualified as TN

import Control.Monad.IO.Class (MonadIO (liftIO))

import Data.IORef (IORef)

import Data.Maybe (isNothing)

m

e2e-tests/test/Helpers/TestData.hs

+1/-1

{-# LANGUAGE RankNTypes #-}

module Helpers.TestData where

+

import Cardano.Api qualified as C

import Cardano.Api.Shelley qualified as C

-

import CardanoTestnet qualified as TN

import Control.Monad.IO.Class (MonadIO)

import Data.Time.Clock.POSIX (POSIXTime)

import Hedgehog (MonadTest)

m

e2e-tests/test/Helpers/TestResults.hs

+0/-1

{-# OPTIONS_GHC -Wno-missing-fields #-}

{-# LANGUAGE RecordWildCards #-}

module Helpers.TestResults (

-

    TestInfo(..),

    TestSuiteResults(..),

    TestResult(..),

    testSuitesToJUnit,

m

e2e-tests/test/Helpers/Testnet.hs

+80/-47

{-# OPTIONS_GHC -Wno-name-shadowing #-}

-

{-# LANGUAGE CPP        #-}

-

{-# LANGUAGE LambdaCase #-}

+

{-# LANGUAGE CPP                #-}

+

{-# LANGUAGE LambdaCase         #-}

+

{-# LANGUAGE NumericUnderscores #-}

+

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

+

{-# OPTIONS_GHC -Wno-unused-do-bind #-}

module Helpers.Testnet where

import Cardano.Api (Error)

import Cardano.Api qualified as C

import Cardano.Api.Shelley qualified as C

-

import CardanoTestnet qualified as TN

import Control.Monad.IO.Class (MonadIO, liftIO)

import Data.Maybe (fromJust)

import Hedgehog (MonadTest)

import Helpers.Utils (maybeReadAs)

import System.Directory qualified as IO

import System.Environment qualified as IO

+

import System.FilePath ((</>))

#if defined(mingw32_HOST_OS)

import System.Posix.Signals (sigKILL, signalProcess)

#endif

+

import Cardano.Testnet qualified as C

+

import Cardano.Testnet qualified as CTN hiding (testnetMagic)

import System.Process (cleanupProcess)

import System.Process.Internals (PHANDLE, ProcessHandle__ (ClosedHandle, OpenExtHandle, OpenHandle), withProcessHandle)

-

import Test.Runtime qualified as TN

-

import Testnet.Conf qualified as TC (Conf (..), ProjectBase (ProjectBase), YamlFilePath (YamlFilePath), mkConf)

+

import Testnet.Util.Runtime qualified as CTN

+

+

data TestnetOptions = TestnetOptions

+

  { testnetEra             :: C.AnyCardanoEra

+

  , testnetProtocolVersion :: Int

+

  , testnetCardanoOptions  :: C.TestnetOptions

+

+

+

defAlonzoTestnetOptions :: TestnetOptions

+

defAlonzoTestnetOptions = TestnetOptions

+

  { testnetEra = C.AnyCardanoEra C.AlonzoEra

+

  , testnetProtocolVersion = 6

+

  , testnetCardanoOptions = CTN.CardanoOnlyTestnetOptions CTN.cardanoDefaultTestnetOptions

+

      { CTN.cardanoEpochLength = 10_000 } -- higher value so that txs can have higher upper bound validity range

+

+

+

defBabbageTestnetOptions :: Int -> TestnetOptions

+

defBabbageTestnetOptions protocolVersion = TestnetOptions

+

  { testnetEra = C.AnyCardanoEra C.BabbageEra

+

  , testnetProtocolVersion = protocolVersion

+

  , testnetCardanoOptions = C.BabbageOnlyTestnetOptions CTN.babbageDefaultTestnetOptions

+

      { CTN.babbageProtocolVersion = protocolVersion

+

      , CTN.babbageSlotDuration = 200

+

      , CTN.babbageEpochLength = 10_000 -- higher value so that txs can have higher upper bound validity range

+

+

data LocalNodeOptions = LocalNodeOptions

-

  { era             :: C.AnyCardanoEra

-

  , protocolVersion :: Int

-

  , localEnvDir     :: FilePath -- path to directory containing 'utxo-keys' and 'ipc' directories

-

  , testnetMagic    :: Int

+

  { localNodeEra             :: C.AnyCardanoEra

+

  , localNodeProtocolVersion :: Int

+

  , localNodeEnvDir          :: FilePath -- path to directory containing 'utxo-keys' and 'ipc' directories

+

  , localNodeTestnetMagic    :: Int

  } deriving Show

-

localNodeOptionsPreview :: Either LocalNodeOptions TN.TestnetOptions

+

localNodeOptionsPreview :: Either LocalNodeOptions TestnetOptions

localNodeOptionsPreview = Left $ LocalNodeOptions

-

  { era = C.AnyCardanoEra C.BabbageEra

-

  , protocolVersion = 8

-

  , localEnvDir = "/tmp/preview"

-

  , testnetMagic = 2

+

  { localNodeEra = C.AnyCardanoEra C.BabbageEra

+

  , localNodeProtocolVersion = 8

+

  , localNodeEnvDir = "/tmp/preview"

+

  , localNodeTestnetMagic = 2

data TimedOut = ProcessExitTimedOut Int PHANDLE deriving Show

instance Error TimedOut where

  displayError (ProcessExitTimedOut t pid) = "Timeout. Waited " ++ show t ++ "s in `cleanupTestnet` for process to exit. pid=" ++ show pid

-

testnetOptionsAlonzo6, testnetOptionsBabbage7, testnetOptionsBabbage8 :: Either LocalNodeOptions TN.TestnetOptions

-

testnetOptionsAlonzo6 = Right $ TN.defaultTestnetOptions {TN.era = C.AnyCardanoEra C.AlonzoEra, TN.protocolVersion = 6}

-

testnetOptionsBabbage7 = Right $ TN.defaultTestnetOptions {TN.era = C.AnyCardanoEra C.BabbageEra, TN.protocolVersion = 7}

-

testnetOptionsBabbage8 = Right $ TN.defaultTestnetOptions {TN.era = C.AnyCardanoEra C.BabbageEra, TN.protocolVersion = 8}

+

testnetOptionsAlonzo6, testnetOptionsBabbage7, testnetOptionsBabbage8 :: Either LocalNodeOptions TestnetOptions

+

testnetOptionsAlonzo6 = Right defAlonzoTestnetOptions

+

testnetOptionsBabbage7 = Right $defBabbageTestnetOptions 7

+

testnetOptionsBabbage8 = Right $ defBabbageTestnetOptions 8

-

eraFromOptions :: (MonadTest m) => Either LocalNodeOptions TN.TestnetOptions -> m C.AnyCardanoEra

-

eraFromOptions = return . either era TN.era

+

eraFromOptions :: (MonadTest m) => Either LocalNodeOptions TestnetOptions -> m C.AnyCardanoEra

+

eraFromOptions = return . either localNodeEra testnetEra

-

pvFromOptions :: (MonadTest m) => Either LocalNodeOptions TN.TestnetOptions -> m Int

-

pvFromOptions = return . either protocolVersion TN.protocolVersion

+

pvFromOptions :: (MonadTest m) => Either LocalNodeOptions TestnetOptions -> m Int

+

pvFromOptions = return . either localNodeProtocolVersion testnetProtocolVersion

-- | Get path to where cardano-testnet files are

getProjectBase :: (MonadIO m, MonadTest m) => m String

-- | Start a testnet with provided testnet options (including era and protocol version)

startTestnet ::

  C.CardanoEra era ->

-

  TN.TestnetOptions ->

+

  TestnetOptions ->

  FilePath ->

  FilePath ->

-

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [TN.PoolNode])

+

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [CTN.PoolNode])

startTestnet era testnetOptions base tempAbsBasePath' = do

  configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"

-

  conf :: TC.Conf <- HE.noteShowM $ TC.mkConf (TC.ProjectBase base) (TC.YamlFilePath configurationTemplate) (tempAbsBasePath' <> "/") Nothing

-

  tn <- TN.testnet testnetOptions conf

+

  conf :: CTN.Conf <- HE.noteShowM $ CTN.mkConf (CTN.ProjectBase base) (CTN.YamlFilePath configurationTemplate) (tempAbsBasePath' <> "/") Nothing

+

  tn <- CTN.testnet (testnetCardanoOptions testnetOptions) conf

  -- Boilerplate codecs used for protocol serialisation. The number of epochSlots is specific

  -- to each blockchain instance. This value is used by cardano mainnet/testnet and only applies

      networkId = getNetworkId tn

  pparams <- getProtocolParams era localNodeConnectInfo

  liftIO $ IO.setEnv "CARDANO_NODE_SOCKET_PATH" socketPathAbs -- set node socket environment for Cardano.Api.Convenience.Query

-

  pure (localNodeConnectInfo, pparams, networkId, Just $ TN.poolNodes tn)

+

  pure (localNodeConnectInfo, pparams, networkId, Just $ CTN.poolNodes tn)

-

cleanupTestnet :: (MonadIO m) => Maybe [TN.PoolNode] -> m [Either TimedOut ()]

+

cleanupTestnet :: (MonadIO m) => Maybe [CTN.PoolNode] -> m [Either TimedOut ()]

cleanupTestnet mPoolNodes = case mPoolNodes of

    Just poolNodes -> do

-

      liftIO $ mapM_ (\node -> cleanupProcess (Just (TN.poolNodeStdinHandle node), Nothing, Nothing, TN.poolNodeProcessHandle node)) poolNodes -- graceful SIGTERM all nodes

+

      liftIO $ mapM_ (\ (CTN.PoolNode poolRuntime _) -> cleanupProcess (Just (CTN.nodeStdinHandle poolRuntime), Nothing, Nothing, CTN.nodeProcessHandle poolRuntime)) poolNodes -- graceful SIGTERM all nodes

      if not OS.isWin32 then -- do no process kill signalling on windows

-

        liftIO $ mapM (\node -> killUnixHandle $ TN.poolNodeProcessHandle node) poolNodes -- kill signal for any node unix handles still open

+

        liftIO $ mapM (\node -> killUnixHandle $ CTN.nodeProcessHandle $ CTN.poolRuntime node) poolNodes -- kill signal for any node unix handles still open

        else return []

    _ ->     return []

    where

  C.CardanoEra era ->

  LocalNodeOptions ->

  FilePath ->

-

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [TN.PoolNode])

+

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [CTN.PoolNode])

connectToLocalNode era localNodeOptions tempAbsPath = do

-

  let localEnvDir' = localEnvDir localNodeOptions

+

  let localEnvDir' = localNodeEnvDir localNodeOptions

  HE.createDirectoryIfMissing (tempAbsPath </> "utxo-keys")

  HE.createDirectoryIfMissing (tempAbsPath </> "sockets")

  HE.createFileLink (localEnvDir' </> "ipc/node.socket") (tempAbsPath </> "sockets/node.socket")

  let socketPathAbs = tempAbsPath </> "sockets/node.socket"

-

      networkId = C.Testnet $ C.NetworkMagic $ fromIntegral (testnetMagic localNodeOptions)

+

      networkId = C.Testnet $ C.NetworkMagic $ fromIntegral (localNodeTestnetMagic localNodeOptions)

  -- Boilerplate codecs used for protocol serialisation. The number of epochSlots is specific

  -- to each blockchain instance. This value is used by cardano mainnet/testnet and only applies

-- | Start testnet with cardano-testnet or use local node that's already

--   connected to a public testnet

setupTestEnvironment ::

-

  Either LocalNodeOptions TN.TestnetOptions ->

+

  Either LocalNodeOptions TestnetOptions ->

  FilePath ->

-

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [TN.PoolNode])

+

  H.Integration (C.LocalNodeConnectInfo C.CardanoMode, C.ProtocolParameters, C.NetworkId, Maybe [CTN.PoolNode])

setupTestEnvironment options tempAbsPath = do

  case options of

    Left localNodeOptions -> do

-

      C.AnyCardanoEra era <- return $ era localNodeOptions

+

      C.AnyCardanoEra era <- return $ localNodeEra localNodeOptions

      liftIO $ putStrLn "\nConnecting to local node..."

      connectToLocalNode era localNodeOptions tempAbsPath

    Right testnetOptions -> do

-

      C.AnyCardanoEra era <- return $ TN.era testnetOptions

+

      C.AnyCardanoEra era <- return $ testnetEra testnetOptions

      pv <- pvFromOptions options

      base <- getProjectBase

      liftIO $ putStrLn $ "\nStarting local testnet in " ++ show era ++ " PV" ++ show pv ++ "..."

      startTestnet era testnetOptions base tempAbsPath

-- | Network ID of the testnet

-

getNetworkId :: TN.TestnetRuntime -> C.NetworkId

-

getNetworkId tn = C.Testnet $ C.NetworkMagic $ fromIntegral (TN.testnetMagic tn)

m

e2e-tests/test/Helpers/Tx.hs

+9/-12

module Helpers.Tx where

-

import Cardano.Api (QueryConvenienceError)

+

import Cardano.Api (QueryConvenienceError, SubmitResult (SubmitFail, SubmitSuccess))

import Cardano.Api qualified as C

import Cardano.Api.Shelley qualified as C

import Control.Monad.IO.Class (MonadIO, liftIO)

import Hedgehog.Extras.Test qualified as HE

import Hedgehog.Extras.Test.Base qualified as H

import Helpers.Common (toEraInCardanoMode)

-

import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (SubmitFail, SubmitSuccess))

+

import Helpers.Utils qualified as U

+

--import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (SubmitFail, SubmitSuccess))

deriving instance Show QueryConvenienceError

  C.TxOut C.CtxTx era

txOut era value address =

  C.TxOut

-

    (maybeAnyAddressInEra $ C.anyAddressInEra era $ C.toAddressAny address)

+

    (U.unsafeFromRight $ C.anyAddressInEra era $ C.toAddressAny address)

    (C.TxOutValue (multiAssetSupportedInEra era) value)

    C.TxOutDatumNone

    C.ReferenceScriptNone

-

  where

-

    maybeAnyAddressInEra Nothing    = error $ "Era must be ShelleyBased"

-

    maybeAnyAddressInEra (Just aie) = aie

-- | Build TxOut with a reference script

txOutWithRefScript ::

    C.CardanoEra era ->

    C.Value ->

    C.Address C.ShelleyAddr ->

-

    C.ScriptData ->

+

    C.HashableScriptData ->

    C.TxOut C.CtxTx era

-- | Build TxOut with inline datum

txOutWithInlineDatum era value address datum = withInlineDatum era datum $ txOut era value address

  withDatumHash,

  withDatumInTx ::

    C.CardanoEra era ->

-

    C.ScriptData ->

+

    C.HashableScriptData ->

    C.TxOut C.CtxTx era ->

    C.TxOut C.CtxTx era

-- | Add inline datum to TxOut

withInlineDatum era datum (C.TxOut e v _ rs) =

  C.TxOut e v (C.TxOutDatumInline (refInsScriptsAndInlineDatsSupportedInEra era) datum) rs

-- | Add datum hash to TxOut

withDatumHash era datum (C.TxOut e v _ rs) =

-

  C.TxOut e v (C.TxOutDatumHash (scriptDataSupportedInEra era) (C.hashScriptData datum)) rs

+

  C.TxOut e v (C.TxOutDatumHash (scriptDataSupportedInEra era) (C.hashScriptDataBytes datum)) rs

-- | Add datum hash to TxOut whilst including datum value in txbody

withDatumInTx era datum (C.TxOut e v _ rs) =

  C.TxOut e v (C.TxOutDatumInTx (scriptDataSupportedInEra era) datum) rs

  return $

    withIsShelleyBasedEra era $

      C.constructBalancedTx

-

        (toEraInCardanoMode era)

        txBody

        (C.shelleyAddressInEra changeAddress)

        Nothing -- Override key witnesses

        nodeEraUtxo -- tx inputs

        pparams

-

        eraHistory

+

        (C.toLedgerEpochInfo eraHistory)

        systemStart

        stakePools

        [C.WitnessPaymentKey sKey]

  C.CardanoEra era ->

  C.TxBodyContent C.BuildTx era ->

  m (C.TxBody era)

-

buildRawTx era = withIsShelleyBasedEra era $ HE.leftFail . C.makeTransactionBody -- TODO: handle error

+

buildRawTx era = withIsShelleyBasedEra era $ HE.leftFail . C.createAndValidateTransactionBody -- TODO: handle error

-- | Witness txbody with signing key when not using convenience build function

signTx :: (MonadIO m) =>

m

e2e-tests/test/Helpers/TypeConverters.hs

+19/-24

import Cardano.Api.Byron qualified as C

import Cardano.Api.Shelley qualified as C

import Cardano.Chain.Common (addrToBase58)

-

import Plutus.V1.Ledger.Address (Address (Address))

-

import Plutus.V1.Ledger.Api qualified as PV1

-

import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash))

-

import Plutus.V1.Ledger.Value qualified as Value

-

import Plutus.V2.Ledger.Api qualified as PV2

+

import PlutusLedgerApi.V1 qualified as PV1

+

import PlutusLedgerApi.V1.Address (Address (Address))

+

import PlutusLedgerApi.V1.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash))

+

import PlutusLedgerApi.V1.Value qualified as Value

+

import PlutusLedgerApi.V2 qualified as PV2

import PlutusTx.Prelude qualified as PlutusTx

fromCardanoPaymentKeyHash :: C.Hash C.PaymentKey -> PV1.PubKeyHash

fromCardanoPaymentKeyHash paymentKeyHash = PV1.PubKeyHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes paymentKeyHash

-

fromCardanoScriptData :: C.ScriptData -> PV1.BuiltinData

-

fromCardanoScriptData = PV1.dataToBuiltinData . C.toPlutusData

+

fromCardanoScriptData :: C.HashableScriptData -> PV1.BuiltinData

+

fromCardanoScriptData = PV1.dataToBuiltinData . C.toPlutusData . C.getScriptData

-

fromCardanoScriptHash :: C.ScriptHash -> PV1.ValidatorHash

-

fromCardanoScriptHash scriptHash = PV1.ValidatorHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes scriptHash

+

fromCardanoScriptHash :: C.ScriptHash -> PV1.ScriptHash

+

fromCardanoScriptHash scriptHash = PV1.ScriptHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes scriptHash

fromCardanoTxIn :: C.TxIn -> PV1.TxOutRef

fromCardanoTxIn (C.TxIn txId (C.TxIx txIx)) = PV1.TxOutRef (fromCardanoTxId txId) (toInteger txIx)

-

scriptToValidatorHash :: C.ScriptHash -> PV1.ValidatorHash

-

scriptToValidatorHash = PV1.ValidatorHash . PlutusTx.toBuiltin . C.serialiseToRawBytes

-

cardanoAddressCredential :: C.AddressInEra era -> Credential

cardanoAddressCredential (C.AddressInEra C.ByronAddressInAnyEra (C.ByronAddress address))

  = PubKeyCredential

          $ PlutusTx.toBuiltin

          $ C.serialiseToRawBytes paymentKeyHash

      C.PaymentCredentialByScript scriptHash ->

-

          ScriptCredential $ scriptToValidatorHash scriptHash

+

          ScriptCredential $ fromCardanoScriptHash scriptHash

cardanoStakingCredential :: C.AddressInEra era -> Maybe StakingCredential

cardanoStakingCredential (C.AddressInEra C.ByronAddressInAnyEra _) = Nothing

      $ PV1.PubKeyHash

      $ PlutusTx.toBuiltin

      $ C.serialiseToRawBytes stakeKeyHash

-

    fromCardanoStakeCredential (C.StakeCredentialByScript scriptHash) = ScriptCredential (scriptToValidatorHash scriptHash)

+

    fromCardanoStakeCredential (C.StakeCredentialByScript scriptHash) = ScriptCredential $ fromCardanoScriptHash scriptHash

toPlutusAddress :: C.AddressInEra era -> Address

toPlutusAddress address = Address (cardanoAddressCredential address) (cardanoStakingCredential address)

fromCardanoTxOutDatum (C.TxOutDatumHash _ h) =

    PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h)

fromCardanoTxOutDatum (C.TxOutDatumInTx _ d) =

-

    PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d))

+

    PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d))

fromCardanoTxOutDatum (C.TxOutDatumInline _ d) =

    PV2.OutputDatum $ PV2.Datum $ fromCardanoScriptData d

fromCardanoTxOutDatumHash (C.TxOutDatumHash _ h) =

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h)

fromCardanoTxOutDatumHash (C.TxOutDatumInTx _ d) =

-

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d))

+

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d))

fromCardanoTxOutDatumHash (C.TxOutDatumInline _ d) =

-

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d))

+

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d))

fromCardanoTxOutDatumHash' :: C.TxOutDatum C.CtxUTxO era -> Maybe PV1.DatumHash

fromCardanoTxOutDatumHash' C.TxOutDatumNone       = Nothing

fromCardanoTxOutDatumHash' (C.TxOutDatumHash _ h) =

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h)

fromCardanoTxOutDatumHash' (C.TxOutDatumInline _ d) =

-

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d))

+

    Just $ PV1.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d))

fromCardanoTxOutToPV1TxInfoTxOut :: C.TxOut C.CtxTx era -> PV1.TxOut

fromCardanoTxOutToPV1TxInfoTxOut (C.TxOut _ _ C.TxOutDatumInline{} _) =

refScriptToScriptHash :: C.ReferenceScript era -> Maybe PV2.ScriptHash

refScriptToScriptHash C.ReferenceScriptNone = Nothing

refScriptToScriptHash (C.ReferenceScript _ (C.ScriptInAnyLang _ s)) =

-

    let (PV2.ValidatorHash h) = fromCardanoScriptHash $ C.hashScript s

+

    let (PV2.ScriptHash h) = fromCardanoScriptHash $ C.hashScript s

     in Just $ PV2.ScriptHash h

fromCardanoTxId :: C.TxId -> PV1.TxId

fromCardanoTxId txId = PV1.TxId $ PlutusTx.toBuiltin $ C.serialiseToRawBytes txId

-

fromCardanoPolicyId :: C.PolicyId -> PV1.MintingPolicyHash

-

fromCardanoPolicyId (C.PolicyId scriptHash) = PV2.MintingPolicyHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes scriptHash)

+

fromCardanoPolicyId :: C.PolicyId -> PV1.CurrencySymbol

+

fromCardanoPolicyId (C.PolicyId scriptHash) = PV2.CurrencySymbol $ PlutusTx.toBuiltin (C.serialiseToRawBytes scriptHash)

fromCardanoAssetName :: C.AssetName -> Value.TokenName

fromCardanoAssetName (C.AssetName bs) = Value.TokenName $ PlutusTx.toBuiltin bs

fromCardanoAssetId :: C.AssetId -> Value.AssetClass

fromCardanoAssetId C.AdaAssetId = Value.assetClass PV1.adaSymbol PV1.adaToken

fromCardanoAssetId (C.AssetId policyId assetName) =

-

    Value.assetClass

-

        (Value.mpsSymbol . fromCardanoPolicyId $ policyId)

-

        (fromCardanoAssetName assetName)

+

    Value.assetClass (fromCardanoPolicyId policyId) (fromCardanoAssetName assetName)

fromCardanoValue :: C.Value -> Value.Value

fromCardanoValue (C.valueToList -> list) =

a

e2e-tests/test/OldPlutus/CBOR/Extras.hs

+21/-0

+

module OldPlutus.CBOR.Extras where

+

+

import Codec.CBOR.Decoding as CBOR (Decoder, decodeBytes)

+

import Codec.Serialise (Serialise, decode, encode)

+

import Data.Either.Extras (fromRightM)

+

import Flat qualified

+

import Flat.Decoder qualified as Flat

+

+

-- | Newtype to provide 'Serialise' instances for types with a 'Flat' instance that

+

-- just encodes the flat-serialized value as a CBOR bytestring

+

newtype SerialiseViaFlat a = SerialiseViaFlat a

+

instance Flat.Flat a => Serialise (SerialiseViaFlat a) where

+

  encode (SerialiseViaFlat a) = encode $ Flat.flat a

+

  decode = SerialiseViaFlat <$> decodeViaFlat Flat.decode

+

+

decodeViaFlat :: Flat.Get a -> CBOR.Decoder s a

+

decodeViaFlat decoder = do

+

    bs <- decodeBytes

+

    -- lift any flat's failures to be cborg failures (MonadFail)

+

    fromRightM (fail . show) $

+

        Flat.unflatWith decoder bs

a

e2e-tests/test/OldPlutus/Prettyprinter/Extras.hs

+35/-0

+

{-# LANGUAGE TypeApplications #-}

+

{-# OPTIONS_GHC -fno-warn-orphans #-}

+

{-# OPTIONS_GHC -Wno-missing-import-lists #-}

+

module OldPlutus.Prettyprinter.Extras

+

    ( PrettyShow(..)

+

    , Pretty(..)

+

    , PrettyFoldable(..)

+

    , Tagged(Tagged)

+

    ) where

+

+

import Data.Foldable (Foldable (toList))

+

import Data.Proxy (Proxy (..))

+

import Data.String (IsString (..))

+

import Data.Tagged

+

import GHC.TypeLits (KnownSymbol, symbolVal)

+

import Prettyprinter

+

+

-- | Newtype wrapper for deriving 'Pretty' via a 'Show' instance

+

newtype PrettyShow a = PrettyShow { unPrettyShow :: a }

+

+

instance Show a => Pretty (PrettyShow a) where

+

  pretty = viaShow . unPrettyShow

+

+

-- | Newtype wrapper for deriving 'Pretty' for a 'Foldable' container by

+

--   calling 'toList'.

+

newtype PrettyFoldable f a = PrettyFoldable { unPrettyFoldable :: f a }

+

+

instance (Foldable f, Pretty a) => Pretty (PrettyFoldable f a) where

+

  pretty = pretty . toList . unPrettyFoldable

+

+

instance (KnownSymbol a, Pretty b) => Pretty (Tagged a b) where

+

  pretty = prettyTagged

+

+

prettyTagged :: forall a b ann. (KnownSymbol a, Pretty b) => Tagged a b -> Doc ann

+

prettyTagged (Tagged b) = fromString (symbolVal (Proxy @a)) <+> pretty b

a

e2e-tests/test/OldPlutus/Scripts.hs

+375/-0

+

-- editorconfig-checker-disable-file

+

{-# LANGUAGE DeriveAnyClass    #-}

+

{-# LANGUAGE DerivingVia       #-}

+

{-# LANGUAGE NoImplicitPrelude #-}

+

{-# LANGUAGE TemplateHaskell   #-}

+

{-# LANGUAGE TypeApplications  #-}

+

+

{-# OPTIONS_GHC -fno-warn-orphans #-}

+

{-# OPTIONS_GHC -fno-specialise #-}

+

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

+

{-# OPTIONS_GHC -Wno-missing-import-lists #-}

+

+

-- | Functions for working with scripts on the ledger.

+

module OldPlutus.Scripts

+

+

    -- * Scripts

+

      Script (..)

+

    , scriptSize

+

    , fromCompiledCode

+

    , ScriptError (..)

+

    , applyValidator

+

    , applyMintingPolicyScript

+

    , applyStakeValidatorScript

+

    , applyArguments

+

    -- * Script wrappers

+

    , mkValidatorScript

+

    , Validator (..)

+

    , unValidatorScript

+

    , Redeemer(..)

+

    , Datum(..)

+

    , mkMintingPolicyScript

+

    , MintingPolicy (..)

+

    , unMintingPolicyScript

+

    , mkStakeValidatorScript

+

    , StakeValidator (..)

+

    , unStakeValidatorScript

+

    , Context(..)

+

    -- * Hashes

+

    , DatumHash(..)

+

    , RedeemerHash(..)

+

    , ScriptHash(..)

+

    , ValidatorHash(..)

+

    , MintingPolicyHash (..)

+

    , StakeValidatorHash (..)

+

    ) where

+

+

import Prelude qualified as Haskell

+

+

import Codec.Serialise (Serialise (..), serialise)

+

import Control.DeepSeq (NFData)

+

import Control.Lens hiding (Context)

+

import Data.ByteString.Lazy qualified as BSL

+

import Data.String

+

import Data.Text (Text)

+

import GHC.Generics (Generic)

+

import OldPlutus.CBOR.Extras (SerialiseViaFlat (..))

+

import OldPlutus.Prettyprinter.Extras

+

import PlutusCore qualified as PLC

+

import PlutusCore.Data qualified as PLC

+

import PlutusCore.MkPlc qualified as PLC

+

import PlutusLedgerApi.V1.Bytes (LedgerBytes (..))

+

import PlutusTx (CompiledCode, FromData (..), ToData (..), UnsafeFromData (..), getPlc, makeLift)

+

import PlutusTx.Builtins as Builtins

+

import PlutusTx.Builtins.Internal as BI

+

import PlutusTx.Prelude

+

import UntypedPlutusCore qualified as UPLC

+

+

-- | A script on the chain. This is an opaque type as far as the chain is concerned.

+

newtype Script = Script { unScript :: UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun () }

+

  deriving stock (Generic)

+

  deriving anyclass (NFData)

+

  -- See Note [Using Flat inside CBOR instance of Script]

+

  -- Currently, this is off because the old implementation didn't actually work, so we need to be careful

+

  -- about introducing a working version

+

  deriving Serialise via (SerialiseViaFlat (UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ()))

+

+

{-| Note [Using Flat inside CBOR instance of Script]

+

`plutus-ledger` uses CBOR for data serialisation and `plutus-core` uses Flat. The

+

choice to use Flat was made to have a more efficient (most wins are in uncompressed

+

size) data serialisation format and use less space on-chain.

+

+

To make `plutus-ledger` work with scripts serialised with Flat, and keep the CBOR

+

format otherwise we have defined a Serialise instance for Script, which is a wrapper

+

over Programs serialised with Flat. The instance will see programs as an opaque

+

ByteString, which is the result of encoding programs using Flat.

+

+

Because Flat is not self-describing and it gets used in the encoding of Programs,

+

data structures that include scripts (for example, transactions) no-longer benefit

+

for CBOR's ability to self-describe it's format.

+

-}

+

+

{- Note [Eq and Ord for Scripts]

+

We need `Eq` and `Ord` instances for `Script`s mostly so we can put them in `Set`s.

+

However, the `Eq` instance for `Program`s is *alpha-equivalence*, and we don't

+

have a compatible `Ord` instance, nor is it easy to derive one.

+

+

So we piggyback off a different representation. In this instance we have two

+

options:

+

- Use the serialized form

+

- Use a hash

+

The problem with the latter is that we don't want to add a derived `Hashable` instance

+

for `Program`s that's not compatible with the `Eq` instance. We *could* add a derived

+

instance for `Program`s with de Bruijn indices, since in that case the derived `Eq`

+

coincides with alpha-equivalence. However, this might be faster.

+

+

For the moment we use the serialized form. We used to store the serialized form directly

+

in `Script`, but that led to a lot of deserializing and reserializing in `applyProgram`.

+

Here we have to serialize when we do `Eq` or `Ord` operations, but this happens comparatively

+

infrequently (I believe).

+

-}

+

+

{- Note [Serialise instances for Datum and Redeemer]

+

The `Serialise` instances for `Datum` and `Redeemer` exist for several reasons:

+

+

- They are useful for the indexers in plutus-apps

+

- There's clearly only one sensible way to encode `Datum` and `Redeemer` into CBOR,

+

  since they just wrap `PLC.Data`.

+

- The encoders and decoders are annoying to implement downstream, because one would

+

  have to import `BuiltinData` which is from a different package.

+

-}

+

+

instance Haskell.Eq Script where

+

    a == b = Builtins.toBuiltin (BSL.toStrict (serialise a)) == Builtins.toBuiltin (BSL.toStrict (serialise b))

+

+

instance Haskell.Ord Script where

+

    a `compare` b = Builtins.toBuiltin (BSL.toStrict (serialise a)) `compare` Builtins.toBuiltin (BSL.toStrict (serialise b))

+

+

instance Haskell.Show Script where

+

    showsPrec _ _ = Haskell.showString "<Script>"

+

+

-- | The size of a 'Script'. No particular interpretation is given to this, other than that it is

+

-- proportional to the serialized size of the script.

+

scriptSize :: Script -> Integer

+

scriptSize (Script s) = UPLC.programSize s

+

+

-- | Turn a 'CompiledCode' (usually produced by 'compile') into a 'Script' for use with this package.

+

fromCompiledCode :: CompiledCode a -> Script

+

fromCompiledCode = Script . toNameless . getPlc

+

    where

+

      toNameless :: UPLC.Program UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()

+

                 -> UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ()

+

      toNameless = over UPLC.progTerm $ UPLC.termMapNames UPLC.unNameDeBruijn

+

+

data ScriptError =

+

    EvaluationError [Text] Haskell.String -- ^ Expected behavior of the engine (e.g. user-provided error)

+

    | EvaluationException Haskell.String Haskell.String -- ^ Unexpected behavior of the engine (a bug)

+

    deriving stock (Haskell.Show, Haskell.Eq, Generic)

+

    deriving anyclass (NFData)

+

+

applyArguments :: Script -> [PLC.Data] -> Script

+

applyArguments (Script p) args =

+

    let termArgs = Haskell.fmap (PLC.mkConstant ()) args

+

        applied t = PLC.mkIterApp () t termArgs

+

    in Script $ over UPLC.progTerm applied p

+

+

mkValidatorScript :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> Validator

+

mkValidatorScript = Validator . fromCompiledCode

+

+

unValidatorScript :: Validator -> Script

+

unValidatorScript = getValidator

+

+

mkMintingPolicyScript :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy

+

mkMintingPolicyScript = MintingPolicy . fromCompiledCode

+

+

unMintingPolicyScript :: MintingPolicy -> Script

+

unMintingPolicyScript = getMintingPolicy

+

+

mkStakeValidatorScript :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> StakeValidator

+

mkStakeValidatorScript = StakeValidator . fromCompiledCode

+

+

unStakeValidatorScript :: StakeValidator -> Script

+

unStakeValidatorScript = getStakeValidator

+

+

-- | 'Validator' is a wrapper around 'Script's which are used as validators in transaction outputs.

+

newtype Validator = Validator { getValidator :: Script }

+

  deriving stock (Generic)

+

  deriving newtype (Haskell.Eq, Haskell.Ord, Serialise)

+

  deriving anyclass (NFData)

+

  deriving Pretty via (PrettyShow Validator)

+

+

instance Haskell.Show Validator where

+

    show = const "Validator { <script> }"

+

+

-- | 'Datum' is a wrapper around 'Data' values which are used as data in transaction outputs.

+

newtype Datum = Datum { getDatum :: BuiltinData  }

+

  deriving stock (Generic, Haskell.Show)

+

  deriving newtype (Haskell.Eq, Haskell.Ord, Eq, ToData, FromData, UnsafeFromData, Pretty)

+

  deriving anyclass (NFData)

+

+

-- See Note [Serialise instances for Datum and Redeemer]

+

instance Serialise Datum where

+

    encode (Datum (BuiltinData d)) = encode d

+

    decode = Datum . BuiltinData Haskell.<$> decode

+

+

-- | 'Redeemer' is a wrapper around 'Data' values that are used as redeemers in transaction inputs.

+

newtype Redeemer = Redeemer { getRedeemer :: BuiltinData }

+

  deriving stock (Generic, Haskell.Show)

+

  deriving newtype (Haskell.Eq, Haskell.Ord, Eq, ToData, FromData, UnsafeFromData, Pretty)

+

  deriving anyclass (NFData)

m

e2e-tests/test/PlutusScripts/Always.hs

+140/-112

Diff too large – View on GitHub

Yesterday's Report

Tuesday, September 26, 2023

853 commits in 69 repos

New Repo Discovered

Tue, 26 Sep 23 00:58:21 +0000 · example-appwallet

TypeScript · Apache-2.0

New Releases

Wed, 27 Sep 23 07:25:40 +0000 · Test Release catalyst-ci Tue, 26 Sep 23 16:11:29 +0000 · Unstable Development Builds mithril Tue, 26 Sep 23 12:13:46 +0000 · 4.22.610 " .cip95. " yoroi-frontend Tue, 26 Sep 23 07:51:29 +0000 · Add uniffi bindgen installation catalyst-gh-mdbook-doc Tue, 26 Sep 23 07:51:29 +0000 · Add uniffi bindgen installation catalyst-gh-tools Mon, 25 Sep 23 15:33:04 +0000 · Release cordova-1.0 catalyst-core

3,844 commits this week Sep 20, 2023 - Sep 27, 2023

Showing 25 of 3844 recent commits.