From 580b39d9b9c2e55b24a5bed2f815385cefa22c3d Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 6 Jul 2021 12:48:43 +1000 Subject: [PATCH 1/3] Direct CLI plutus testing --- cabal.project | 5 +- cardano-testnet/cardano-testnet.cabal | 11 +- cardano-testnet/src/Test/Process.hs | 10 + cardano-testnet/test/Main.hs | 6 +- cardano-testnet/test/Spec/Extras.hs | 3 + .../Spec/Plutus/Direct/TxInLockingPlutus.hs | 225 ++++++++++++++++++ .../Script/TxInLockingPlutus.hs} | 7 +- .../scripts/always-succeeds-spending.plutus | 2 +- 8 files changed, 260 insertions(+), 9 deletions(-) create mode 100644 cardano-testnet/test/Spec/Extras.hs create mode 100644 cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs rename cardano-testnet/test/Spec/{Plutus.hs => Plutus/Script/TxInLockingPlutus.hs} (92%) diff --git a/cabal.project b/cabal.project index 57a65d70661..6655464e994 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,7 +110,7 @@ package cardano-ledger-alonzo-test source-repository-package type: git location: https://github.com/input-output-hk/hedgehog-extras - tag: 2f28e62f1508f07bb628963ee9bb23dc19ec0e03 + tag: 7ffbd217bb969d7c01f1e70cf58535df06e5d9a8 --sha256: 0sjlk19v0dg63v8dawg844y3wzm1nmq0qxpvhip81x5yi091jjmm source-repository-package diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 35034496d24..ba1926b1ca2 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -95,15 +95,22 @@ test-suite cardano-testnet-tests type: exitcode-stdio-1.0 - build-depends: cardano-testnet + build-depends: aeson + , cardano-testnet , directory , hedgehog , hedgehog-extras , filepath + , lens + , lens-aeson , tasty , tasty-hedgehog + , text + , unordered-containers - other-modules: Spec.Plutus + other-modules: Spec.Extras + 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/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/Extras.hs b/cardano-testnet/test/Spec/Extras.hs new file mode 100644 index 00000000000..a678ee33e46 --- /dev/null +++ b/cardano-testnet/test/Spec/Extras.hs @@ -0,0 +1,3 @@ +module Spec.Extras + ( + ) where 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..f6d481cb053 --- /dev/null +++ b/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs @@ -0,0 +1,225 @@ +{-# 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 Control.Lens +import Data.Aeson (Value) +import Data.Bool (not) +import Data.Function +import Data.Int +import Data.List ((!!)) +import Data.Maybe +import Data.Monoid +import Data.String +import GHC.Real +import GHC.Num +import Hedgehog (Property, (===)) +import Prelude (head) +import System.FilePath (()) +import Text.Show (Show(..)) + +import qualified Control.Lens as CL +import qualified Data.Aeson.Lens as CL +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 return" -} +{- HLINT ignore "Use let" -} + +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 + + -- path <- H.noteIO $ fromMaybe "" <$> IO.lookupEnv "PATH" + + 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 + scriptDatumHash <- pure "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b" + plutusRequiredSpace <- pure @_ @Integer 70000000 + plutusRequiredTime <- pure @_ @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 + ] + + -- mkdir -p $WORK + + 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" + txin <- H.noteShow $ utxo1Json ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack + lovelaceAtTxin <- H.nothingFailM . H.noteShow $ utxo1Json ^? CL.key (T.pack txin) . CL.key "value" . CL.key "lovelace" . CL._Integer + lovelaceAtTxinDiv2 <- H.noteShow $ lovelaceAtTxin `div` 2 + + void $ H.execCli + [ "transaction", "build-raw" + , "--alonzo-era" + , "--fee", "0" + , "--tx-in", 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 + + -- After "locking" the tx output at the script address, we can now can attempt to spend + -- the "locked" tx output below. + + 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" + + plutusUtxoTxIn <- H.noteShow $ plutusUtxoJson ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack + + 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" + + txinCollateral <- H.noteShow $ utxo2Json ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack + + 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 $ plutusUtxoJson ^? CL.key (T.pack plutusUtxoTxIn) . CL.key "value" . CL.key "lovelace" . CL._Integer + + 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", plutusUtxoTxIn + , "--tx-in-collateral", 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 92% rename from cardano-testnet/test/Spec/Plutus.hs rename to cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs index 1113c91ab73..81acba7bcc5 100644 --- a/cardano-testnet/test/Spec/Plutus.hs +++ b/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} -module Spec.Plutus +module Spec.Plutus.Script.TxInLockingPlutus ( hprop_plutus ) where @@ -11,6 +11,7 @@ import Data.Function import Data.Functor ((<$>)) import Data.Int import Data.Maybe +import Data.Monoid import Hedgehog (Property) import Prelude (head) import System.FilePath (()) @@ -38,7 +39,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) @@ -48,7 +49,7 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb , ("TESTNET_MAGIC", show @Int testnetMagic) , ("PATH", path) ] - , H.execConfigCwd = Just tempBaseAbsPath + , H.execConfigCwd = Last $ Just tempBaseAbsPath } scriptPath <- H.eval $ projectBase "scripts/plutus/example-txin-locking-plutus-script.sh" 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" } From c5d2a0f7484c4383967b9682a30856ff18355c75 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 9 Jul 2021 16:13:33 +1000 Subject: [PATCH 2/3] Convert to not use lenses --- cabal.project | 4 +- cardano-testnet/cardano-testnet.cabal | 5 +- cardano-testnet/src/Testnet/Conf.hs | 2 +- cardano-testnet/test/Spec/Extras.hs | 3 - .../Spec/Plutus/Direct/TxInLockingPlutus.hs | 59 +++++++++++-------- .../Spec/Plutus/Script/TxInLockingPlutus.hs | 15 ++++- .../example-txin-locking-plutus-script.sh | 5 +- 7 files changed, 54 insertions(+), 39 deletions(-) delete mode 100644 cardano-testnet/test/Spec/Extras.hs diff --git a/cabal.project b/cabal.project index 6655464e994..ce403317e60 100644 --- a/cabal.project +++ b/cabal.project @@ -110,8 +110,8 @@ package cardano-ledger-alonzo-test source-repository-package type: git location: https://github.com/input-output-hk/hedgehog-extras - tag: 7ffbd217bb969d7c01f1e70cf58535df06e5d9a8 - --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 ba1926b1ca2..e079f508021 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -101,15 +101,12 @@ test-suite cardano-testnet-tests , hedgehog , hedgehog-extras , filepath - , lens - , lens-aeson , tasty , tasty-hedgehog , text , unordered-containers - other-modules: Spec.Extras - Spec.Plutus.Direct.TxInLockingPlutus + 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/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/Spec/Extras.hs b/cardano-testnet/test/Spec/Extras.hs deleted file mode 100644 index a678ee33e46..00000000000 --- a/cardano-testnet/test/Spec/Extras.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Spec.Extras - ( - ) where diff --git a/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs b/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs index f6d481cb053..f4d224eca34 100644 --- a/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs +++ b/cardano-testnet/test/Spec/Plutus/Direct/TxInLockingPlutus.hs @@ -10,15 +10,17 @@ module Spec.Plutus.Direct.TxInLockingPlutus import Control.Applicative import Control.Monad -import Control.Lens -import Data.Aeson (Value) +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 -import Data.String +import Data.Monoid (Last(..), (<>)) +import Data.Text (Text) import GHC.Real import GHC.Num import Hedgehog (Property, (===)) @@ -26,8 +28,7 @@ import Prelude (head) import System.FilePath (()) import Text.Show (Show(..)) -import qualified Control.Lens as CL -import qualified Data.Aeson.Lens as CL +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 @@ -42,9 +43,20 @@ 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 @@ -52,8 +64,6 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb H.TestnetRuntime { H.bftSprockets, H.testnetMagic } <- H.testnet H.defaultTestnetOptions conf - -- path <- H.noteIO $ fromMaybe "" <$> IO.lookupEnv "PATH" - execConfig <- H.noteShow H.ExecConfig { H.execConfigEnv = Last $ Just [ ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName (head bftSprockets)) @@ -69,9 +79,10 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb plutusScriptFileInUse <- H.note $ base "scripts/plutus/scripts/always-succeeds-spending.plutus" -- This datum hash is the hash of the untyped 42 - scriptDatumHash <- pure "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b" - plutusRequiredSpace <- pure @_ @Integer 70000000 - plutusRequiredTime <- pure @_ @Integer 70000000 + 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" @@ -88,8 +99,6 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb , "--testnet-magic", show @Int testnetMagic ] - -- mkdir -p $WORK - utxoAddr <- H.execCli [ "address", "build" , "--testnet-magic", show @Int testnetMagic @@ -107,15 +116,16 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb H.cat $ work "utxo-1.json" utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" - txin <- H.noteShow $ utxo1Json ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack - lovelaceAtTxin <- H.nothingFailM . H.noteShow $ utxo1Json ^? CL.key (T.pack txin) . CL.key "value" . CL.key "lovelace" . CL._Integer + 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", txin + , "--tx-in", T.unpack txin , "--tx-out", plutusScriptAddr <> "+" <> show @Integer lovelaceAtTxinDiv2 , "--tx-out-datum-hash", scriptDatumHash , "--tx-out", utxoAddr <> "+" <> show @Integer lovelaceAtTxinDiv2 @@ -138,8 +148,7 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb H.threadDelay 5000000 - -- After "locking" the tx output at the script address, we can now can attempt to spend - -- the "locked" tx output below. + -- With the tx ouput at the script address we can now attempt to spend it. void $ H.execCli' execConfig [ "query", "utxo" @@ -151,8 +160,8 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb H.cat $ work "plutusutxo.json" plutusUtxoJson <- H.leftFailM . H.readJsonFile $ work "plutusutxo.json" - - plutusUtxoTxIn <- H.noteShow $ plutusUtxoJson ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack + plutusUtxo <- H.noteShowM $ H.jsonErrorFail $ J.fromJSON @(HashMap Text Utxo) plutusUtxoJson + plutusUtxoTxIn <- H.noteShow $ head $ HM.keys plutusUtxo void $ H.execCli' execConfig [ "query", "utxo" @@ -165,8 +174,8 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb H.cat $ work "utxo-2.json" utxo2Json :: Value <- H.leftFailM $ H.readJsonFile $ work "utxo-2.json" - - txinCollateral <- H.noteShow $ utxo2Json ^. CL._Object . CL.to HM.keys . CL.ix 0 . to T.unpack + 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" @@ -176,7 +185,7 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb let dummyaddress = "addr_test1vpqgspvmh6m2m5pwangvdg499srfzre2dd96qq57nlnw6yctpasy4" - lovelaceAtplutusScriptAddr <- H.nothingFailM . H.noteShow $ plutusUtxoJson ^? CL.key (T.pack plutusUtxoTxIn) . CL.key "value" . CL.key "lovelace" . CL._Integer + lovelaceAtplutusScriptAddr <- H.nothingFailM . H.noteShow $ plutusUtxo & HM.lookup plutusUtxoTxIn <&> value >>= HM.lookup "lovelace" txFee <- H.noteShow $ plutusRequiredTime + plutusRequiredSpace spendable <- H.noteShow $ lovelaceAtplutusScriptAddr - plutusRequiredTime - plutusRequiredSpace @@ -185,8 +194,8 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb [ "transaction", "build-raw" , "--alonzo-era" , "--fee", show @Integer txFee - , "--tx-in", plutusUtxoTxIn - , "--tx-in-collateral", txinCollateral + , "--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 diff --git a/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs b/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs index 81acba7bcc5..7897758cd05 100644 --- a/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs +++ b/cardano-testnet/test/Spec/Plutus/Script/TxInLockingPlutus.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Spec.Plutus.Script.TxInLockingPlutus @@ -7,19 +8,24 @@ module Spec.Plutus.Script.TxInLockingPlutus ) where import Control.Monad +import Data.Bool (not) import Data.Function import Data.Functor ((<$>)) import Data.Int +import Data.List ((!!)) import Data.Maybe import Data.Monoid -import Hedgehog (Property) +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 @@ -32,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" @@ -48,6 +56,7 @@ 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 = Last $ Just tempBaseAbsPath } @@ -59,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/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" From 1e577e8f31b5f0e3bb8e639d1bc2d00127bf26bf Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 9 Jul 2021 10:38:58 +0100 Subject: [PATCH 3/3] Fix mkfiles.sh --- scripts/byron-to-alonzo/mkfiles.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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/'