diff --git a/cabal.project b/cabal.project index 552b8452db6..2ca388bf017 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/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 497493f7f70..08914eff286 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)) @@ -66,14 +76,13 @@ hprop_plutus = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAb utxoVKeyFile <- H.note $ tempAbsPath "shelley/utxo-keys/utxo1.vkey" utxoSKeyFile <- H.note $ tempAbsPath "shelley/utxo-keys/utxo1.skey" - -- ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName (head bftSprockets)) - plutusScriptFileInUse <- H.note $ base "scripts/plutus/scripts/untyped-always-succeeds-txin.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" @@ -90,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 @@ -109,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 @@ -140,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" @@ -153,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" @@ -167,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" @@ -178,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 @@ -187,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