Skip to content

Commit

Permalink
Add a Plutus certifying and rewarding script test to cardano-testnet
Browse files Browse the repository at this point in the history
  • Loading branch information
Jimbo4350 committed Nov 22, 2021
1 parent 0e07777 commit e0ee0de
Show file tree
Hide file tree
Showing 8 changed files with 834 additions and 30 deletions.
7 changes: 3 additions & 4 deletions cardano-cli/test/Test/Cli/JSON.hs
Expand Up @@ -6,15 +6,14 @@ module Test.Cli.JSON where
import Cardano.Prelude hiding (filter)

import Cardano.Api.Shelley
import Gen.Cardano.Api.Typed (genStakeAddress, genLovelace, genVerificationKeyHash)
import Gen.Cardano.Api.Typed (genLovelace, genStakeAddress, genVerificationKeyHash)

import Data.Aeson
import qualified Data.Map.Strict as Map

import Cardano.CLI.Shelley.Run.Query

import Hedgehog (Property, checkSequential, discover, forAll, property, tripping)
import Hedgehog (Gen)
import Hedgehog (Gen, Property, checkSequential, discover, forAll, property, tripping)
import Hedgehog.Gen as Gen
import Hedgehog.Range as Range

Expand All @@ -28,7 +27,7 @@ prop_json_roundtrip_delegations_and_rewards =
genDelegationsAndRewards :: Gen DelegationsAndRewards
genDelegationsAndRewards = do
let r = Range.constant 0 3
sAddrs <- Gen.list r genStakeAddress
sAddrs <- Gen.list r genStakeAddress
sLovelace <- Gen.list r genLovelace
let delegMapAmt = Map.fromList $ zip sAddrs sLovelace
poolIDs <- Gen.list r genPoolId
Expand Down
8 changes: 7 additions & 1 deletion cardano-testnet/cardano-testnet.cabal
Expand Up @@ -36,6 +36,8 @@ library
build-depends: aeson
, base16-bytestring
, bytestring
, cardano-api
, cardano-cli
, cardano-node
, containers
, directory
Expand All @@ -49,6 +51,7 @@ library
, process
, random
, resourcet
, safe-exceptions
, text
, time
, unordered-containers
Expand All @@ -63,6 +66,7 @@ library
Testnet.List
Testnet.Shelley
Testnet.SubmitApi
Testnet.Utils

executable cardano-testnet
import: base, project-config
Expand Down Expand Up @@ -106,6 +110,7 @@ test-suite cardano-testnet-tests
, base16-bytestring
, bytestring
, cardano-api
, cardano-cli
, cardano-testnet
, containers
, directory
Expand All @@ -117,7 +122,8 @@ test-suite cardano-testnet-tests
, text
, unordered-containers

other-modules: Spec.Plutus.Direct.ScriptContextEquality
other-modules: Spec.Plutus.Direct.CertifyingAndWithdrawingPlutus
Spec.Plutus.Direct.ScriptContextEquality
Spec.Plutus.Direct.ScriptContextEqualityMint
Spec.Plutus.Direct.TxInLockingPlutus
Spec.Plutus.Script.TxInLockingPlutus
Expand Down
63 changes: 41 additions & 22 deletions cardano-testnet/src/Testnet/Cardano.hs
Expand Up @@ -190,17 +190,16 @@ testnet testnetOptions H.Conf {..} = do
startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime
configurationTemplate <- H.noteShow $ base </> "configuration/defaults/byron-mainnet/configuration.yaml"
configurationFile <- H.noteShow $ tempAbsPath </> "configuration.yaml"

let bftNodesN = [1 .. numBftNodes testnetOptions]
let poolNodesN = [1 .. numPoolNodes testnetOptions]
let bftNodes = ("node-bft" <>) . show @Int <$> bftNodesN
let poolNodes = ("node-pool" <>) . show @Int <$> poolNodesN
let allNodes = bftNodes <> poolNodes
let initSupply = 1000000000
let maxSupply = 1000000000
let fundsPerGenesisAddress = initSupply `div` numBftNodes testnetOptions
let fundsPerByronAddress = fundsPerGenesisAddress * 9 `div` 10
let userPoolN = poolNodesN
poolNodesN = [1 .. numPoolNodes testnetOptions]
bftNodes = ("node-bft" <>) . show @Int <$> bftNodesN
poolNodes = ("node-pool" <>) . show @Int <$> poolNodesN
allNodes = bftNodes <> poolNodes
maxByronSupply = 10020000000
fundsPerGenesisAddress = maxByronSupply `div` numBftNodes testnetOptions
fundsPerByronAddress = fundsPerGenesisAddress - 100000000
userPoolN = poolNodesN
maxShelleySupply = 1000000000000

allPorts <- H.noteShowIO $ IO.allocateRandomPorts (L.length allNodes)
nodeToPort <- H.noteShow (M.fromList (L.zip allNodes allPorts))
Expand Down Expand Up @@ -307,7 +306,7 @@ testnet testnetOptions H.Conf {..} = do
, "--k", show @Int securityParam
, "--n-poor-addresses", "0"
, "--n-delegate-addresses", show @Int (numBftNodes testnetOptions)
, "--total-balance", show @Int initSupply
, "--total-balance", show @Int maxByronSupply
, "--delegate-share", "1"
, "--avvm-entry-count", "0"
, "--avvm-entry-balance", "0"
Expand Down Expand Up @@ -357,7 +356,7 @@ testnet testnetOptions H.Conf {..} = do
, "--tx", tempAbsPath </> "tx0.tx"
, "--wallet-key", tempAbsPath </> "byron/delegate-keys.000.key"
, "--rich-addr-from", richAddrFrom
, "--txout", show @(String, Int) (txAddr, fundsPerGenesisAddress)
, "--txout", show @(String, Int) (txAddr, fundsPerByronAddress)
]

-- Update Proposal and votes
Expand Down Expand Up @@ -428,14 +427,16 @@ testnet testnetOptions H.Conf {..} = do
-- and K=10, but we'll keep long KES periods so we don't have to bother
-- cycling KES keys
H.rewriteJsonFile (tempAbsPath </> "shelley/genesis.spec.json") . J.rewriteObject
$ HM.insert "slotLength" (J.toJSON @Double 0.2)
. HM.insert "activeSlotsCoeff" (J.toJSON @Double (activeSlotsCoeff testnetOptions))
$ HM.insert "activeSlotsCoeff" (J.toJSON @Double (activeSlotsCoeff testnetOptions))
. HM.insert "securityParam" (J.toJSON @Int 10)
. HM.insert "epochLength" (J.toJSON @Int (epochLength testnetOptions))
. HM.insert "slotLength" (J.toJSON @Double 0.2)
. HM.insert "maxLovelaceSupply" (J.toJSON @Int maxSupply)
. HM.insert "slotLength" (J.toJSON @Double (slotLength testnetOptions))
. HM.insert "maxLovelaceSupply" (J.toJSON @Int maxShelleySupply)
. flip HM.adjust "protocolParams"
( J.rewriteObject (HM.insert "decentralisationParam" (J.toJSON @Double 0.7))
( J.rewriteObject ( HM.insert "decentralisationParam" (J.toJSON @Double 0.7)
. HM.insert "rho" (J.toJSON @Double 0.1)
. HM.insert "tau" (J.toJSON @Double 0.1)
)
)

-- Now generate for real:
Expand All @@ -455,7 +456,7 @@ testnet testnetOptions H.Conf {..} = do
$ flip HM.adjust "protocolParams"
( J.rewriteObject
( flip HM.adjust "protocolVersion"
( J.rewriteObject (HM.insert "major" (J.toJSON @Int 2))
( J.rewriteObject (HM.insert "major" (J.toJSON @Int 6))
)
)
)
Expand Down Expand Up @@ -518,8 +519,9 @@ testnet testnetOptions H.Conf {..} = do
-- pool-owner1..n: will be the owner of the pools and we'll use their reward
-- account for pool rewards
let userAddrs = ("user" <>) . show @Int <$> userPoolN
let poolAddrs = ("pool-owner" <>) . show @Int <$> poolNodesN
let addrs = userAddrs <> poolAddrs
poolAddrs = ("pool-owner" <>) . show @Int <$> poolNodesN
addrs = userAddrs <> poolAddrs


H.createDirectoryIfMissing $ tempAbsPath </> "addresses"

Expand All @@ -534,13 +536,30 @@ testnet testnetOptions H.Conf {..} = do
, "--signing-key-file", paymentSKey
]

-- Stake address keys
void $ H.execCli
[ "address", "key-gen"
, "--verification-key-file", tempAbsPath </> "shelley/utxo-keys/utxo2.vkey"
, "--signing-key-file", tempAbsPath </> "shelley/utxo-keys/utxo2.skey"
]

void $ H.execCli
[ "stake-address", "key-gen"
, "--verification-key-file", tempAbsPath </> "addresses/" <> addr <> "-stake.vkey"
, "--signing-key-file", tempAbsPath </> "addresses/" <> addr <> "-stake.skey"
]

void $ H.execCli
[ "stake-address", "key-gen"
, "--verification-key-file", tempAbsPath </> "shelley/utxo-keys/utxo-stake.vkey"
, "--signing-key-file", tempAbsPath </> "shelley/utxo-keys/utxo-stake.skey"
]

void $ H.execCli
[ "stake-address", "key-gen"
, "--verification-key-file", tempAbsPath </> "shelley/utxo-keys/utxo2-stake.vkey"
, "--signing-key-file", tempAbsPath </> "shelley/utxo-keys/utxo2-stake.skey"
]

-- Payment addresses
void $ H.execCli
[ "address", "build"
Expand Down Expand Up @@ -628,7 +647,7 @@ testnet testnetOptions H.Conf {..} = do
, "--invalid-hereafter", "1000"
, "--fee", "0"
, "--tx-in", txIn
, "--tx-out", user1Addr <> "+" <> show @Int maxSupply
, "--tx-out", user1Addr <> "+" <> show @Int maxShelleySupply
, "--certificate-file", tempAbsPath </> "addresses/pool-owner1-stake.reg.cert"
, "--certificate-file", tempAbsPath </> "node-pool1/registration.cert"
, "--certificate-file", tempAbsPath </> "addresses/user1-stake.reg.cert"
Expand Down
63 changes: 63 additions & 0 deletions cardano-testnet/src/Testnet/Utils.hs
@@ -0,0 +1,63 @@
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TypeApplications #-}

module Testnet.Utils
( waitUntilEpoch
) where

import Cardano.Api

import Control.Concurrent (threadDelay)
import Control.Exception.Safe (MonadCatch)
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson (fromJSON)
import Data.Eq
import Data.Function
import Data.Int
import Data.Maybe
import GHC.Stack
import System.Directory (doesFileExist, removeFile)
import System.FilePath (FilePath)
import Text.Show

import Cardano.CLI.Shelley.Output

import qualified Hedgehog.Extras.Test.Base as H
import qualified Hedgehog.Extras.Test.File as H
import Hedgehog.Extras.Test.Process (ExecConfig)
import Hedgehog.Internal.Property (MonadTest)
import qualified Test.Process as H

-- | Submit the desired epoch to wait to.
waitUntilEpoch
:: (MonadCatch m, MonadIO m, MonadTest m)
=> FilePath
-- ^ Output file
-> Int
-- ^ Testnet magic
-> ExecConfig
-> EpochNo
-- ^ Desired epoch
-> m EpochNo
waitUntilEpoch fp testnetMagic execConfig desiredEpoch = do
exists <- liftIO $ doesFileExist fp
when exists $ liftIO $ removeFile fp

void $ H.execCli' execConfig
[ "query", "tip"
, "--testnet-magic", show @Int testnetMagic
, "--out-file", fp
]

tipJSON <- H.leftFailM $ H.readJsonFile fp
tip <- H.noteShowM $ H.jsonErrorFail $ fromJSON @QueryTipLocalStateOutput tipJSON
case mEpoch tip of
Nothing ->
H.failMessage
callStack "waitUntilEpoch: cardano-cli query tip returned Nothing for EpochNo"
Just currEpoch ->
if currEpoch == desiredEpoch
then return currEpoch
else do liftIO $ threadDelay 10_000_000
waitUntilEpoch fp testnetMagic execConfig desiredEpoch
4 changes: 3 additions & 1 deletion cardano-testnet/test/Main.hs
Expand Up @@ -14,6 +14,7 @@ import qualified Test.Tasty as T
import qualified Test.Tasty.Hedgehog as H
import qualified Test.Tasty.Ingredients as T

import qualified Spec.Plutus.Direct.CertifyingAndWithdrawingPlutus
import qualified Spec.Plutus.Direct.ScriptContextEquality
import qualified Spec.Plutus.Direct.ScriptContextEqualityMint
import qualified Spec.Plutus.Direct.TxInLockingPlutus
Expand All @@ -24,7 +25,8 @@ tests :: IO TestTree
tests = do
pure $ T.testGroup "test/Spec.hs"
[ T.testGroup "Spec"
[ H.testProperty "Spec.Plutus.Direct.TxInLockingPlutus" Spec.Plutus.Direct.TxInLockingPlutus.hprop_plutus
[ H.testProperty "Spec.Plutus.Direct.CertifyingAndWithdrawingPlutus" Spec.Plutus.Direct.CertifyingAndWithdrawingPlutus.hprop_plutus_certifying_withdrawing
, H.testProperty "Spec.Plutus.Direct.TxInLockingPlutus" Spec.Plutus.Direct.TxInLockingPlutus.hprop_plutus
-- This hangs on Windows for an unknown reason
, ignoreOnWindows "Spec.Plutus.Script.TxInLockingPlutus" Spec.Plutus.Script.TxInLockingPlutus.hprop_plutus
, H.testProperty "Spec.Plutus.SubmitApi.TxInLockingPlutus" Spec.Plutus.SubmitApi.TxInLockingPlutus.hprop_plutus
Expand Down

0 comments on commit e0ee0de

Please sign in to comment.