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 1, 2021
1 parent ae961f3 commit 6227b77
Show file tree
Hide file tree
Showing 8 changed files with 823 additions and 30 deletions.
7 changes: 3 additions & 4 deletions cardano-cli/test/Test/Cli/JSON.hs
Original file line number Diff line number Diff line change
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
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,8 @@ library
build-depends: aeson
, base16-bytestring
, bytestring
, cardano-api
, cardano-cli
, containers
, directory
, exceptions
Expand All @@ -47,6 +49,7 @@ library
, process
, random
, resourcet
, safe-exceptions
, text
, time
, unordered-containers
Expand All @@ -61,6 +64,7 @@ library
Testnet.List
Testnet.Shelley
Testnet.SubmitApi
Testnet.Utils

executable cardano-testnet
import: base, project-config
Expand Down Expand Up @@ -102,6 +106,7 @@ test-suite cardano-testnet-tests

build-depends: aeson
, cardano-api
, cardano-cli
, cardano-testnet
, containers
, directory
Expand All @@ -113,7 +118,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
Original file line number Diff line number Diff line change
Expand Up @@ -142,17 +142,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 @@ -266,7 +265,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 @@ -316,7 +315,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 @@ -387,14 +386,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 @@ -414,7 +415,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 @@ -477,8 +478,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 @@ -493,13 +495,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 @@ -587,7 +606,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
67 changes: 67 additions & 0 deletions cardano-testnet/src/Testnet/Utils.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,67 @@
{-# 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
if exists
then liftIO $ removeFile fp
else return ()

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
epoch <-
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
return epoch
4 changes: 3 additions & 1 deletion cardano-testnet/test/Main.hs
Original file line number Diff line number Diff line change
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
, H.testProperty "Spec.Plutus.Script.TxInLockingPlutus" Spec.Plutus.Script.TxInLockingPlutus.hprop_plutus
, H.testProperty "Spec.Plutus.SubmitApi.TxInLockingPlutus" Spec.Plutus.SubmitApi.TxInLockingPlutus.hprop_plutus
, ignoreOnWindows "Spec.Plutus.Direct.ScriptContextEquality" Spec.Plutus.Direct.ScriptContextEquality.hprop_plutus_script_context_equality
Expand Down

0 comments on commit 6227b77

Please sign in to comment.