Sulkta-OSS/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add shared Sample values module

Browse source 
- add Proposal validator testing
- add some Agora.Record improvements
This commit is contained in:
Emily Martins 2022-04-20 16:39:03 +02:00
parent 18df6ead55
commit eb4dc2c654
11 changed files with 367 additions and 270 deletions
Download patch file Download diff file Expand all files Collapse all files

218
agora-test/Spec/Sample/Proposal.hs
View file

@ -6,31 +6,21 @@ Description: Sample based testing for Proposal utxos
This module tests primarily the happy path for Proposal interactions
-}
module Spec.Sample.Proposal (
proposal,
propPolicy,
propPolicySymbol,
propThresholds,
signer,
signer2,
-- * Script contexts
proposalCreation,
cosignProposal,
proposalRef,
stakeRef,
) where
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
mintingPolicySymbol,
mkMintingPolicy,
mkValidator,
validatorHash,
)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
CurrencySymbol,
Datum (Datum),
MintingPolicy (..),
PubKeyHash,
ScriptContext (..),
ScriptPurpose (..),
@ -41,105 +31,33 @@ import Plutus.V1.Ledger.Api (
TxOutRef (TxOutRef),
)
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash)
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
import Agora.Governor (
Governor (Governor),
GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds),
governorPolicy,
governorValidator,
)
import Agora.Proposal (
Proposal (..),
ProposalDatum (..),
ProposalId (..),
ProposalStatus (..),
ProposalThresholds (..),
ProposalVotes (..),
ResultTag (..),
proposalPolicy,
proposalValidator,
)
import Agora.Stake (Stake (..), stakePolicy)
import Plutarch.SafeMoney
import Plutus.V1.Ledger.Address (scriptHashAddress)
import Agora.Stake (Stake (..), StakeDatum (StakeDatum))
import Plutarch.SafeMoney (Tagged (Tagged), untag)
import PlutusTx.AssocMap qualified as AssocMap
import Spec.Sample.Shared
import Spec.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
stake :: Stake
stake =
Stake
{ gtClassRef = Tagged $ Value.assetClass govSymbol ""
, proposalSTClass = Value.assetClass propPolicySymbol ""
}
stakeSymbol :: CurrencySymbol
stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef
governor :: Governor
governor = Governor
govPolicy :: MintingPolicy
govPolicy = mkMintingPolicy (governorPolicy governor)
govValidator :: Validator
govValidator = mkValidator (governorValidator governor)
govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy
proposal :: Proposal
proposal =
Proposal
{ governorSTAssetClass =
-- TODO: if we had a governor here
Value.assetClass govSymbol ""
, stakeSTAssetClass =
Value.assetClass stakeSymbol ""
}
-- | 'Proposal' policy instance.
propPolicy :: MintingPolicy
propPolicy = mkMintingPolicy (proposalPolicy proposal)
propPolicySymbol :: CurrencySymbol
propPolicySymbol = mintingPolicySymbol propPolicy
-- | A sample 'PubKeyHash'.
signer :: PubKeyHash
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
-- | Another sample 'PubKeyHash'.
signer2 :: PubKeyHash
signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
-- | 'Proposal' validator instance.
propValidator :: Validator
propValidator = mkValidator (proposalValidator proposal)
propValidatorHash :: ValidatorHash
propValidatorHash = validatorHash propValidator
propValidatorAddress :: Address
propValidatorAddress = scriptHashAddress propValidatorHash
propThresholds :: ProposalThresholds
propThresholds =
ProposalThresholds
{ countVoting = Tagged 1000
, create = Tagged 1
, vote = Tagged 10
}
-- | This script context should be a valid transaction.
proposalCreation :: ScriptContext
proposalCreation =
let st = Value.singleton propPolicySymbol "" 1 -- Proposal ST
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
proposalDatum :: Datum
proposalDatum =
Datum
@ -153,7 +71,7 @@ proposalCreation =
]
, status = Draft
, cosigners = [signer]
, thresholds = propThresholds
, thresholds = defaultProposalThresholds
, votes = ProposalVotes AssocMap.empty
}
)
@ -163,7 +81,7 @@ proposalCreation =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = propThresholds
{ proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 0
}
)
@ -172,7 +90,7 @@ proposalCreation =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = propThresholds
{ proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 1
}
)
@ -190,7 +108,7 @@ proposalCreation =
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash propValidator) Nothing
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
@ -221,13 +139,19 @@ proposalCreation =
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting propPolicySymbol
, scriptContextPurpose = Minting proposalPolicySymbol
}
proposalRef :: TxOutRef
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
stakeRef :: TxOutRef
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
-- | This script context should be a valid transaction.
cosignProposal :: [PubKeyHash] -> ScriptContext
cosignProposal :: [PubKeyHash] -> TxInfo
cosignProposal newSigners =
let st = Value.singleton propPolicySymbol "" 1 -- Proposal ST
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
proposalBefore :: ProposalDatum
proposalBefore =
ProposalDatum
@ -239,50 +163,70 @@ cosignProposal newSigners =
]
, status = Draft
, cosigners = [signer]
, thresholds = propThresholds
, thresholds = defaultProposalThresholds
, votes = ProposalVotes AssocMap.empty
}
stakeDatum :: StakeDatum
stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []
proposalAfter :: ProposalDatum
proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners}
proposalRef = (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
proposalRef
TxOut
{ txOutAddress = propValidatorAddress
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalBefore)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash propValidator) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = newSigners
, txInfoData =
[ datumPair . Datum $ toBuiltinData proposalBefore
, datumPair . Datum $ toBuiltinData proposalAfter
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Spending proposalRef
in TxInfo
{ txInfoInputs =
[ TxInInfo
proposalRef
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalBefore)
}
, TxInInfo
stakeRef
TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.singleton stakeSymbol "" 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
}
, TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.singleton stakeSymbol "" 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = newSigners
, txInfoData =
[ datumPair . Datum $ toBuiltinData proposalBefore
, datumPair . Datum $ toBuiltinData proposalAfter
, datumPair . Datum $ toBuiltinData stakeDatum
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}

132
agora-test/Spec/Sample/Shared.hs Normal file
View file

@ -0,0 +1,132 @@
{- |
Module : Spec.Sample.Shared
Maintainer : emi@haskell.fyi
Description: Shared useful values for creating Samples for testing.
Shared useful values for creating Samples for testing.
-}
module Spec.Sample.Shared (
-- * Misc
signer,
signer2,
-- * Components
-- ** Stake
stake,
stakeSymbol,
stakeValidatorHash,
stakeAddress,
-- ** Governor
governor,
govPolicy,
govValidator,
govSymbol,
-- ** Proposal
defaultProposalThresholds,
proposal,
proposalPolicySymbol,
proposalValidatorHash,
proposalValidatorAddress,
) where
import Agora.Governor (
Governor (Governor),
governorPolicy,
governorValidator,
)
import Agora.Proposal (
Proposal (..),
ProposalThresholds (..),
proposalPolicy,
proposalValidator,
)
import Agora.Stake (Stake (..), stakePolicy, stakeValidator)
import Plutarch.Api.V1 (
mintingPolicySymbol,
mkMintingPolicy,
mkValidator,
validatorHash,
)
import Plutarch.SafeMoney
import Plutus.V1.Ledger.Address (scriptHashAddress)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
CurrencySymbol,
MintingPolicy (..),
PubKeyHash,
)
import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash)
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
stake :: Stake
stake =
Stake
{ gtClassRef =
Tagged $
Value.assetClass
"da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
"LQ"
, proposalSTClass = Value.assetClass proposalPolicySymbol ""
}
stakeSymbol :: CurrencySymbol
stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef
stakeValidatorHash :: ValidatorHash
stakeValidatorHash = validatorHash $ mkValidator (stakeValidator stake)
stakeAddress :: Address
stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing
governor :: Governor
governor = Governor
govPolicy :: MintingPolicy
govPolicy = mkMintingPolicy (governorPolicy governor)
govValidator :: Validator
govValidator = mkValidator (governorValidator governor)
govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy
proposal :: Proposal
proposal =
Proposal
{ governorSTAssetClass =
-- TODO: if we had a governor here
Value.assetClass govSymbol ""
, stakeSTAssetClass =
Value.assetClass stakeSymbol ""
}
proposalPolicySymbol :: CurrencySymbol
proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal)
-- | A sample 'PubKeyHash'.
signer :: PubKeyHash
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
-- | Another sample 'PubKeyHash'.
signer2 :: PubKeyHash
signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
proposalValidatorHash :: ValidatorHash
proposalValidatorHash = validatorHash (mkValidator $ proposalValidator proposal)
proposalValidatorAddress :: Address
proposalValidatorAddress = scriptHashAddress proposalValidatorHash
defaultProposalThresholds :: ProposalThresholds
defaultProposalThresholds =
ProposalThresholds
{ countVoting = Tagged 1000
, create = Tagged 1
, vote = Tagged 10
}

59
agora-test/Spec/Sample/Stake.hs
View file

@ -7,8 +7,7 @@ This module tests primarily the happy path for Stake creation
-}
module Spec.Sample.Stake (
stake,
policy,
policySymbol,
stakeSymbol,
validatorHashTN,
signer,
@ -22,19 +21,14 @@ module Spec.Sample.Stake (
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
mintingPolicySymbol,
mkMintingPolicy,
mkValidator,
validatorHash,
)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
CurrencySymbol,
Datum (Datum),
DatumHash (DatumHash),
MintingPolicy (..),
PubKeyHash,
ScriptContext (..),
ScriptPurpose (..),
ToData (toBuiltinData),
@ -45,8 +39,7 @@ import Plutus.V1.Ledger.Api (
)
import Plutus.V1.Ledger.Contexts (TxOut (TxOut), TxOutRef (TxOutRef))
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Scripts (Validator)
import Plutus.V1.Ledger.Value (AssetClass (AssetClass), TokenName (TokenName))
import Plutus.V1.Ledger.Value (TokenName (TokenName))
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
@ -54,47 +47,19 @@ import Plutus.V1.Ledger.Value qualified as Value
import Agora.SafeMoney (GTTag)
import Agora.Stake
import Plutarch.SafeMoney
import Spec.Sample.Shared
import Spec.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
-- | 'Stake' parameters for 'LQ'.
stake :: Stake
stake =
Stake
{ gtClassRef =
Tagged
( AssetClass
( "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
, "LQ"
)
)
, proposalSTClass = AssetClass ("", "")
}
-- | 'Stake' policy instance.
policy :: MintingPolicy
policy = mkMintingPolicy (stakePolicy stake.gtClassRef)
policySymbol :: CurrencySymbol
policySymbol = mintingPolicySymbol policy
-- | A sample 'PubKeyHash'.
signer :: PubKeyHash
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
-- | 'Stake' validator instance.
validator :: Validator
validator = mkValidator (stakeValidator stake)
-- | 'TokenName' that represents the hash of the 'Stake' validator.
validatorHashTN :: TokenName
validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValidator stake) in TokenName vh
-- | This script context should be a valid transaction.
stakeCreation :: ScriptContext
stakeCreation =
let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST
let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer [])
in ScriptContext
@ -103,7 +68,7 @@ stakeCreation =
{ txInfoInputs = []
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue = st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242
, txOutDatumHash = Just (DatumHash "")
}
@ -117,7 +82,7 @@ stakeCreation =
, txInfoData = [("", datum)]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting policySymbol
, scriptContextPurpose = Minting stakeSymbol
}
-- | This ScriptContext should fail because the datum has too much GT.
@ -127,7 +92,7 @@ stakeCreationWrongDatum =
datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer []) -- Too much GT
in ScriptContext
{ scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]}
, scriptContextPurpose = Minting policySymbol
, scriptContextPurpose = Minting stakeSymbol
}
-- | This ScriptContext should fail because the datum has too much GT.
@ -138,7 +103,7 @@ stakeCreationUnsigned =
stakeCreation.scriptContextTxInfo
{ txInfoSignatories = []
}
, scriptContextPurpose = Minting policySymbol
, scriptContextPurpose = Minting stakeSymbol
}
--------------------------------------------------------------------------------
@ -154,7 +119,7 @@ data DepositWithdrawExample = DepositWithdrawExample
-- | Create a ScriptContext that deposits or withdraws, given the config for it.
stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
stakeDepositWithdraw config =
let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST
let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
stakeBefore :: StakeDatum
stakeBefore = StakeDatum config.startAmount signer []
@ -167,7 +132,7 @@ stakeDepositWithdraw config =
[ TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st
<> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)
@ -176,7 +141,7 @@ stakeDepositWithdraw config =
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)
, txOutDatumHash = Just (toDatumHash stakeAfter)