diff --git a/cabal.project b/cabal.project index 57a65d70661..ce403317e60 100644 --- a/cabal.project +++ b/cabal.project @@ -57,6 +57,9 @@ package cardano-node package cardano-node-chairman tests: True +package cardano-testnet + tests: True + -- The following is needed because Nix is doing something crazy. package byron-spec-ledger tests: False @@ -107,8 +110,8 @@ package cardano-ledger-alonzo-test source-repository-package type: git location: https://github.com/input-output-hk/hedgehog-extras - tag: 2f28e62f1508f07bb628963ee9bb23dc19ec0e03 - --sha256: 0sjlk19v0dg63v8dawg844y3wzm1nmq0qxpvhip81x5yi091jjmm + tag: f7adf144bbd6da1aae9a668f40a1f8fdf69c9135 + --sha256: 0f411zwlraqrp3f68vmif80kqdw18ddr0lqc9bfq83mv277gcb4k source-repository-package type: git diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 35034496d24..e079f508021 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -95,15 +95,19 @@ test-suite cardano-testnet-tests type: exitcode-stdio-1.0 - build-depends: cardano-testnet + build-depends: aeson + , cardano-testnet , directory , hedgehog , hedgehog-extras , filepath , tasty , tasty-hedgehog + , text + , unordered-containers - other-modules: Spec.Plutus + other-modules: Spec.Plutus.Direct.TxInLockingPlutus + Spec.Plutus.Script.TxInLockingPlutus ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-testnet/src/Test/Process.hs b/cardano-testnet/src/Test/Process.hs index 4101794a3b5..18a0275106a 100644 --- a/cardano-testnet/src/Test/Process.hs +++ b/cardano-testnet/src/Test/Process.hs @@ -1,5 +1,6 @@ module Test.Process ( execCli + , execCli' , procCli , procNode , procChairman @@ -11,6 +12,7 @@ import Data.Function import Data.String import GHC.Stack (HasCallStack) import Hedgehog (MonadTest) +import Hedgehog.Extras.Test.Process (ExecConfig) import System.Process (CreateProcess) import qualified GHC.Stack as GHC @@ -23,6 +25,14 @@ execCli -> m String execCli = GHC.withFrozenCallStack $ H.execFlex "cardano-cli" "CARDANO_CLI" +-- | Run cardano-cli, returning the stdout +execCli' + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => ExecConfig + -> [String] + -> m String +execCli' execConfig = GHC.withFrozenCallStack $ H.execFlex' execConfig "cardano-cli" "CARDANO_CLI" + -- | Create a 'CreateProcess' describing how to start the cardano-cli process -- and an argument list. procCli diff --git a/cardano-testnet/src/Testnet/Conf.hs b/cardano-testnet/src/Testnet/Conf.hs index 14eb9bf3f84..8b26446d43b 100644 --- a/cardano-testnet/src/Testnet/Conf.hs +++ b/cardano-testnet/src/Testnet/Conf.hs @@ -36,6 +36,6 @@ mkConf tempAbsPath maybeMagic = do tempRelPath <- H.noteShow $ FP.makeRelative tempBaseAbsPath tempAbsPath base <- H.noteShowM H.getProjectBase socketDir <- H.noteShow $ tempRelPath "socket" - logDir <- H.noteTempFile tempAbsPath "/logs" + logDir <- H.noteTempFile tempAbsPath "logs" return $ Conf {..} diff --git a/cardano-testnet/test/Main.hs b/cardano-testnet/test/Main.hs index 0f5c560f2cd..535bdc1559f 100644 --- a/cardano-testnet/test/Main.hs +++ b/cardano-testnet/test/Main.hs @@ -11,13 +11,15 @@ import qualified Test.Tasty as T import qualified Test.Tasty.Ingredients as T import qualified Test.Tasty.Hedgehog as H -import qualified Spec.Plutus +import qualified Spec.Plutus.Direct.TxInLockingPlutus +import qualified Spec.Plutus.Script.TxInLockingPlutus tests :: IO T.TestTree tests = do pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" - [ H.testProperty "Plutus" Spec.Plutus.hprop_plutus + [ H.testProperty "Spec.Plutus.Direct.TxInLockingPlutus" Spec.Plutus.Direct.TxInLockingPlutus.hprop_plutus + , H.testProperty "Spec.Plutus.Script.TxInLockingPlutus" Spec.Plutus.Script.TxInLockingPlutus.hprop_plutus ] ] diff --git a/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs b/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs new file mode 100644 index 00000000000..f4d224eca34 --- /dev/null +++ b/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Spec.Plutus.Direct.TxInLockingPlutus + ( hprop_plutus + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson (FromJSON(..), Value, (.:)) +import Data.Bool (not) +import Data.Eq +import Data.Function +import Data.Functor ((<&>)) +import Data.HashMap.Lazy (HashMap) +import Data.Int +import Data.List ((!!)) +import Data.Maybe +import Data.Monoid (Last(..), (<>)) +import Data.Text (Text) +import GHC.Real +import GHC.Num +import Hedgehog (Property, (===)) +import Prelude (head) +import System.FilePath (()) +import Text.Show (Show(..)) + +import qualified Data.Aeson as J +import qualified Data.List as L +import qualified Data.HashMap.Lazy as HM +import qualified Data.Text as T +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.Concurrent as H +import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.Process as H +import qualified System.Directory as IO +import qualified Test.Base as H +import qualified Test.Process as H +import qualified Testnet.Cardano as H +import qualified Testnet.Conf as H + +{- HLINT ignore "Redundant <&>" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Use let" -} + +data Utxo = Utxo + { address :: Text + , value :: HashMap Text Integer + } deriving (Eq, Show) + +instance FromJSON Utxo where + parseJSON = J.withObject "Utxo" $ \v -> Utxo + <$> v .: "address" + <*> v .: "value" + +hprop_plutus :: Property +hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsBasePath' -> do + projectBase <- H.note =<< H.noteIO . IO.canonicalizePath =<< H.getProjectBase + conf@H.Conf { H.tempBaseAbsPath, H.tempAbsPath } <- H.noteShowM $ H.mkConf tempAbsBasePath' Nothing + + H.TestnetRuntime { H.bftSprockets, H.testnetMagic } <- H.testnet H.defaultTestnetOptions conf + + execConfig <- H.noteShow H.ExecConfig + { H.execConfigEnv = Last $ Just + [ ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName (head bftSprockets)) + ] + , H.execConfigCwd = Last $ Just tempBaseAbsPath + } + + base <- H.note projectBase + work <- H.note tempAbsPath + utxoVKeyFile <- H.note $ tempAbsPath "shelley/utxo-keys/utxo1.vkey" + utxoSKeyFile <- H.note $ tempAbsPath "shelley/utxo-keys/utxo1.skey" + + plutusScriptFileInUse <- H.note $ base "scripts/plutus/scripts/always-succeeds-spending.plutus" + + -- This datum hash is the hash of the untyped 42 + let scriptDatumHash = "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b" + let plutusRequiredSpace = id @Integer 70000000 + let plutusRequiredTime = id @Integer 70000000 + + datumFile <- H.note $ base "scripts/plutus/data/42.datum" + redeemerFile <- H.note $ base "scripts/plutus/data/42.redeemer" + + -- Always succeeds Plutus script in use. Any datum and redeemer combination will succeed. + -- Script at: $plutusscriptinuse + + -- Step 1: Create a tx ouput with a datum hash at the script address. In order for a tx ouput to be locked + -- by a plutus script, it must have a datahash. We also need collateral tx inputs so we split the utxo + -- in order to accomodate this. + + plutusScriptAddr <- H.execCli + [ "address", "build" + , "--payment-script-file", plutusScriptFileInUse + , "--testnet-magic", show @Int testnetMagic + ] + + utxoAddr <- H.execCli + [ "address", "build" + , "--testnet-magic", show @Int testnetMagic + , "--payment-verification-key-file", utxoVKeyFile + ] + + void $ H.execCli' execConfig + [ "query", "utxo" + , "--address", utxoAddr + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-1.json" + ] + + H.cat $ work "utxo-1.json" + + utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" + utxo1 <- H.noteShowM $ H.jsonErrorFail $ J.fromJSON @(HashMap Text Utxo) utxo1Json + txin <- H.noteShow $ head $ HM.keys utxo1 + lovelaceAtTxin <- H.nothingFailM . H.noteShow $ utxo1 & HM.lookup txin <&> value >>= HM.lookup "lovelace" + lovelaceAtTxinDiv2 <- H.noteShow $ lovelaceAtTxin `div` 2 + + void $ H.execCli + [ "transaction", "build-raw" + , "--alonzo-era" + , "--fee", "0" + , "--tx-in", T.unpack txin + , "--tx-out", plutusScriptAddr <> "+" <> show @Integer lovelaceAtTxinDiv2 + , "--tx-out-datum-hash", scriptDatumHash + , "--tx-out", utxoAddr <> "+" <> show @Integer lovelaceAtTxinDiv2 + , "--out-file", work "create-datum-output.body" + ] + + void $ H.execCli + [ "transaction", "sign" + , "--tx-body-file", work "create-datum-output.body" + , "--testnet-magic", show @Int testnetMagic + , "--signing-key-file", utxoSKeyFile + , "--out-file", work "create-datum-output.tx" + ] + + void $ H.execCli' execConfig + [ "transaction", "submit" + , "--tx-file", work "create-datum-output.tx" + , "--testnet-magic", show @Int testnetMagic + ] + + H.threadDelay 5000000 + + -- With the tx ouput at the script address we can now attempt to spend it. + + void $ H.execCli' execConfig + [ "query", "utxo" + , "--address", plutusScriptAddr + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "plutusutxo.json" + ] + + H.cat $ work "plutusutxo.json" + + plutusUtxoJson <- H.leftFailM . H.readJsonFile $ work "plutusutxo.json" + plutusUtxo <- H.noteShowM $ H.jsonErrorFail $ J.fromJSON @(HashMap Text Utxo) plutusUtxoJson + plutusUtxoTxIn <- H.noteShow $ head $ HM.keys plutusUtxo + + void $ H.execCli' execConfig + [ "query", "utxo" + , "--address", utxoAddr + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-2.json" + ] + + H.cat $ work "utxo-2.json" + + utxo2Json :: Value <- H.leftFailM $ H.readJsonFile $ work "utxo-2.json" + utxo2 <- H.noteShowM $ H.jsonErrorFail $ J.fromJSON @(HashMap Text Utxo) utxo2Json + txinCollateral <- H.noteShow $ head $ HM.keys utxo2 + + void $ H.execCli' execConfig + [ "query", "protocol-parameters" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "pparams.json" + ] + + let dummyaddress = "addr_test1vpqgspvmh6m2m5pwangvdg499srfzre2dd96qq57nlnw6yctpasy4" + + lovelaceAtplutusScriptAddr <- H.nothingFailM . H.noteShow $ plutusUtxo & HM.lookup plutusUtxoTxIn <&> value >>= HM.lookup "lovelace" + + txFee <- H.noteShow $ plutusRequiredTime + plutusRequiredSpace + spendable <- H.noteShow $ lovelaceAtplutusScriptAddr - plutusRequiredTime - plutusRequiredSpace + + void $ H.execCli + [ "transaction", "build-raw" + , "--alonzo-era" + , "--fee", show @Integer txFee + , "--tx-in", T.unpack plutusUtxoTxIn + , "--tx-in-collateral", T.unpack txinCollateral + , "--tx-out", dummyaddress <> "+" <> show @Integer spendable + , "--tx-in-script-file", plutusScriptFileInUse + , "--tx-in-datum-file", datumFile + , "--protocol-params-file", work "pparams.json" + , "--tx-in-redeemer-file", redeemerFile + , "--tx-in-execution-units", show @(Integer, Integer) (plutusRequiredTime, plutusRequiredSpace) + , "--out-file", work "test-alonzo.body" + ] + + void $ H.execCli + [ "transaction", "sign" + , "--tx-body-file", work "test-alonzo.body" + , "--testnet-magic", show @Int testnetMagic + , "--signing-key-file", utxoSKeyFile + , "--out-file", work "alonzo.tx" + ] + + void $ H.execCli' execConfig + [ "transaction", "submit" + , "--tx-file", work "alonzo.tx" + , "--testnet-magic", show @Int testnetMagic + ] + + H.threadDelay 5000000 + + -- Querying UTxO at $dummyaddress. If there is ADA at the address the Plutus script successfully executed! + + result <- T.pack <$> H.execCli' execConfig + [ "query", "utxo" + , "--address", dummyaddress + , "--testnet-magic", show @Int testnetMagic + ] + + H.noteShow_ result + + L.filter (not . T.null) (T.splitOn " " (T.lines result !! 2)) !! 2 === "360000000" diff --git a/cardano-testnet/test/Spec/Plutus.hs b/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs similarity index 74% rename from cardano-testnet/test/Spec/Plutus.hs rename to cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs index 1113c91ab73..7897758cd05 100644 --- a/cardano-testnet/test/Spec/Plutus.hs +++ b/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs @@ -1,24 +1,31 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -module Spec.Plutus +module Spec.Plutus.Script.TxInLockingPlutus ( hprop_plutus ) where import Control.Monad +import Data.Bool (not) import Data.Function import Data.Functor ((<$>)) import Data.Int +import Data.List ((!!)) import Data.Maybe -import Hedgehog (Property) +import Data.Monoid +import Hedgehog (Property, (===)) import Prelude (head) import System.FilePath (()) import Text.Show (Show(..)) +import qualified Data.List as L +import qualified Data.Text as T import qualified Hedgehog.Internal.Property as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H import qualified Hedgehog.Extras.Test.Process as H import qualified System.Directory as IO import qualified System.Environment as IO @@ -31,6 +38,8 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb projectBase <- H.note =<< H.evalIO . IO.canonicalizePath =<< H.getProjectBase conf@H.Conf { H.tempBaseAbsPath, H.tempAbsPath } <- H.noteShowM $ H.mkConf tempAbsBasePath' Nothing + resultFile <- H.noteTempFile tempAbsPath "result.out" + H.TestnetRuntime { H.bftSprockets, H.testnetMagic } <- H.testnet H.defaultTestnetOptions conf cardanoCli <- H.binFlex "cardano-cli" "CARDANO_CLI" @@ -38,7 +47,7 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb path <- H.evalIO $ fromMaybe "" <$> IO.lookupEnv "PATH" let execConfig = H.ExecConfig - { H.execConfigEnv = Just + { H.execConfigEnv = Last $ Just [ ("CARDANO_CLI", cardanoCli) , ("BASE", projectBase) , ("WORK", tempAbsPath) @@ -47,8 +56,9 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb , ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName (head bftSprockets)) , ("TESTNET_MAGIC", show @Int testnetMagic) , ("PATH", path) + , ("RESULT_FILE", resultFile) ] - , H.execConfigCwd = Just tempBaseAbsPath + , H.execConfigCwd = Last $ Just tempBaseAbsPath } scriptPath <- H.eval $ projectBase "scripts/plutus/example-txin-locking-plutus-script.sh" @@ -58,4 +68,6 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb , scriptPath ] - return () + result <- T.pack <$> H.readFile resultFile + + L.filter (not . T.null) (T.splitOn " " (T.lines result !! 2)) !! 2 === "360000000" diff --git a/scripts/byron-to-alonzo/mkfiles.sh b/scripts/byron-to-alonzo/mkfiles.sh index 55b34a23b8d..1afc7443892 100755 --- a/scripts/byron-to-alonzo/mkfiles.sh +++ b/scripts/byron-to-alonzo/mkfiles.sh @@ -302,7 +302,7 @@ sed -i shelley/genesis.spec.json \ -e 's/"securityParam": 2160/"securityParam": 10/' \ -e 's/"epochLength": 432000/"epochLength": 1500/' \ -e 's/"maxLovelaceSupply": 0/"maxLovelaceSupply": 1000000000000/' \ - -e 's/"decentralisationParam": 1/"decentralisationParam": 0.7/' \ + -e 's/"decentralisationParam": 1.0/"decentralisationParam": 0.7/' \ -e 's/"major": 0/"major": 2/' \ -e 's/"updateQuorum": 5/"updateQuorum": 2/' diff --git a/scripts/plutus/example-txin-locking-plutus-script.sh b/scripts/plutus/example-txin-locking-plutus-script.sh index 15df6d16de9..df5360e056d 100755 --- a/scripts/plutus/example-txin-locking-plutus-script.sh +++ b/scripts/plutus/example-txin-locking-plutus-script.sh @@ -12,6 +12,7 @@ export CARDANO_NODE_SOCKET_PATH="${CARDANO_NODE_SOCKET_PATH:-example/node-bft1/n export TESTNET_MAGIC="${TESTNET_MAGIC:-42}" export UTXO_VKEY="${UTXO_VKEY:-example/shelley/utxo-keys/utxo1.vkey}" export UTXO_SKEY="${UTXO_SKEY:-example/shelley/utxo-keys/utxo1.skey}" +export RESULT_FILE="${RESULT_FILE:-$WORK/result.out}" echo "Socket path: $CARDANO_NODE_SOCKET_PATH" echo "Socket path: $(pwd)" @@ -129,5 +130,5 @@ sleep 5 echo "" echo "Querying UTxO at $dummyaddress. If there is ADA at the address the Plutus script successfully executed!" echo "" -$CARDANO_CLI query utxo --address "$dummyaddress" --testnet-magic "$TESTNET_MAGIC" - +$CARDANO_CLI query utxo --address "$dummyaddress" --testnet-magic "$TESTNET_MAGIC" \ + | tee "$RESULT_FILE" diff --git a/scripts/plutus/scripts/always-succeeds-spending.plutus b/scripts/plutus/scripts/always-succeeds-spending.plutus index 699b08f96ec..31def5e7975 100644 --- a/scripts/plutus/scripts/always-succeeds-spending.plutus +++ b/scripts/plutus/scripts/always-succeeds-spending.plutus @@ -1,5 +1,5 @@ { "type": "PlutusScriptV1", "description": "", - "cborHex": "5899589701000033200200333200200200333333200200200200200200332002002002002000051200001200001200120020020020020030050062002001200200200200200330040070062001200200200200200300300620012002002002002003002006200120020020020020030010062000011120020000212002001200200330010040031200001112002001200330010030021120000101" + "cborHex": "585c585a010000332233322233333322222233222220051200120012122222300500622122222330040070062122222300300621222223002006212222230010062001112200212212233001004003120011122123300100300211200101" }