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

speed up test execution by precompiling scripts

Browse source 
x250 faster!
This commit is contained in:
Hongrui Fang 2022-08-10 17:38:21 +08:00
parent 3d9c447783
commit b6a30b9ea9
18 changed files with 299 additions and 282 deletions
Download patch file Download diff file Expand all files Collapse all files

24
agora-specs/Sample/Proposal/Advance.hs
View file

@ -37,15 +37,11 @@ module Sample.Proposal.Advance (
mkBadGovernorOutputDatumBundle,
) where
import Agora.AuthorityToken (
AuthorityToken (AuthorityToken),
authorityTokenPolicy,
)
import Agora.Governor (
Governor (..),
GovernorDatum (..),
GovernorRedeemer (MintGATs),
)
import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (
ProposalDatum (..),
ProposalId (ProposalId),
@ -56,7 +52,6 @@ import Agora.Proposal (
ResultTag (ResultTag),
emptyVotesFor,
)
import Agora.Proposal.Scripts (proposalValidator)
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (
@ -66,12 +61,11 @@ import Agora.Proposal.Time (
votingTime
),
)
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (
Stake (gtClassRef),
StakeDatum (..),
StakeRedeemer (WitnessStake),
)
import Agora.Stake.Scripts (stakeValidator)
import Agora.Utils (validatorHashToTokenName)
import Control.Monad.State (execState, modify, when)
import Data.Default (def)
@ -107,18 +101,18 @@ import Sample.Proposal.Shared (
stakeTxRef,
)
import Sample.Shared (
agoraScripts,
authorityTokenSymbol,
govAssetClass,
govValidatorHash,
governor,
minAda,
proposalPolicySymbol,
proposalValidatorHash,
signer,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
group,
@ -394,7 +388,7 @@ mkStakeBuilder ps =
minAda
<> Value.assetClassValue stakeAssetClass 1
<> Value.assetClassValue
(untag stake.gtClassRef)
(untag governor.gtClassRef)
ps.perStakeGTs
perStake idx i o =
let withSig =
@ -565,7 +559,7 @@ mkTestTree name pb val =
testValidator
val.forProposalValidator
"proposal"
(proposalValidator Shared.proposal)
agoraScripts.compiledProposalValidator
proposalInputDatum
proposalRedeemer
(spend proposalRef)
@ -576,7 +570,7 @@ mkTestTree name pb val =
testValidator
val.forStakeValidator
"stake"
(stakeValidator Shared.stake)
agoraScripts.compiledStakeValidator
(getStakeInputDatumAt pb.stakeParameters idx)
stakeRedeemer
( spend (mkStakeRef idx)
@ -586,7 +580,7 @@ mkTestTree name pb val =
testValidator
(fromJust val.forGovernorValidator)
"governor"
(governorValidator Shared.governor)
agoraScripts.compiledGovernorValidator
governorInputDatum
governorRedeemer
(spend governorRef)
@ -596,7 +590,7 @@ mkTestTree name pb val =
testPolicy
(fromJust val.forAuthorityTokenPolicy)
"authority"
(authorityTokenPolicy $ AuthorityToken Shared.govAssetClass)
agoraScripts.compiledAuthorityTokenPolicy
authorityTokenRedeemer
(mint authorityTokenSymbol)
<$ (pb.authorityTokenParameters)

15
agora-specs/Sample/Proposal/Cosign.hs
View file

@ -14,6 +14,7 @@ module Sample.Proposal.Cosign (
mkTestTree,
) where
import Agora.Governor (Governor (..))
import Agora.Proposal (
ProposalDatum (..),
ProposalId (ProposalId),
@ -22,19 +23,17 @@ import Agora.Proposal (
ResultTag (ResultTag),
emptyVotesFor,
)
import Agora.Proposal.Scripts (proposalValidator)
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (draftTime),
)
import Agora.SafeMoney (GTTag)
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (
Stake (gtClassRef),
StakeDatum (StakeDatum, owner),
StakeRedeemer (WitnessStake),
stakedAmount,
)
import Agora.Stake.Scripts (stakeValidator)
import Data.Coerce (coerce)
import Data.Default (def)
import Data.List (sort)
@ -61,15 +60,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared (
agoraScripts,
governor,
minAda,
proposalPolicySymbol,
proposalValidatorHash,
signer,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
group,
@ -149,7 +148,7 @@ cosign ps = builder
sortValue $
minAda
<> Value.assetClassValue
(untag stake.gtClassRef)
(untag governor.gtClassRef)
(untag perStakedGTs)
<> sst
@ -322,7 +321,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
in testValidator
isValid
"proposal"
(proposalValidator Shared.proposal)
agoraScripts.compiledProposalValidator
proposalInputDatum
(mkProposalRedeemer ps)
(spend proposalRef)
@ -334,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
in testValidator
isValid
"stake"
(stakeValidator Shared.stake)
agoraScripts.compiledStakeValidator
stakeInputDatum
stakeRedeemer
(spend $ mkStakeRef idx)

24
agora-specs/Sample/Proposal/Create.hs
View file

@ -20,27 +20,24 @@ module Sample.Proposal.Create (
) where
import Agora.Governor (
Governor (..),
GovernorDatum (..),
GovernorRedeemer (CreateProposal),
)
import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (
Proposal (governorSTAssetClass),
ProposalDatum (..),
ProposalId (ProposalId),
ProposalStatus (..),
ResultTag (ResultTag),
emptyVotesFor,
)
import Agora.Proposal.Scripts (proposalPolicy)
import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..))
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (
ProposalLock (..),
Stake (gtClassRef),
StakeDatum (..),
StakeRedeemer (PermitVote),
)
import Agora.Stake.Scripts (stakeValidator)
import Data.Coerce (coerce)
import Data.Default (Default (def))
import Data.Tagged (Tagged, untag)
@ -69,19 +66,19 @@ import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared (
agoraScripts,
govAssetClass,
govValidatorHash,
governor,
minAda,
proposal,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer,
signer2,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
import Test.Util (CombinableBuilder, closedBoundedInterval, mkMinting, mkSpending, sortValue)
@ -270,7 +267,7 @@ createProposal ps = builder
where
pst = Value.singleton proposalPolicySymbol "" 1
sst = Value.assetClassValue stakeAssetClass 1
gst = Value.assetClassValue proposal.governorSTAssetClass 1
gst = Value.assetClassValue govAssetClass 1
---
@ -279,7 +276,7 @@ createProposal ps = builder
sortValue $
sortValue $
sst
<> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs)
<> Value.assetClassValue (untag governor.gtClassRef) (untag stakedGTs)
<> minAda
proposalValue = sortValue $ pst <> minAda
@ -438,7 +435,7 @@ mkTestTree
testPolicy
validForProposalPolicy
"proposal"
(proposalPolicy Shared.proposal.governorSTAssetClass)
agoraScripts.compiledProposalPolicy
proposalPolicyRedeemer
(mint proposalPolicySymbol)
@ -446,15 +443,16 @@ mkTestTree
testValidator
validForGovernorValidator
"governor"
(governorValidator Shared.governor)
agoraScripts.compiledGovernorValidator
governorInputDatum
governorRedeemer
(spend governorRef)
stakeTest =
testValidator
validForStakeValidator
"stake"
(stakeValidator Shared.stake)
agoraScripts.compiledStakeValidator
(mkStakeInputDatum ps)
stakeRedeemer
(spend stakeRef)

16
agora-specs/Sample/Proposal/UnlockStake.hs
View file

@ -25,6 +25,7 @@ module Sample.Proposal.UnlockStake (
--------------------------------------------------------------------------------
import Agora.Governor (Governor (..))
import Agora.Proposal (
ProposalDatum (..),
ProposalId (..),
@ -33,10 +34,9 @@ import Agora.Proposal (
ProposalVotes (..),
ResultTag (..),
)
import Agora.Proposal.Scripts (proposalValidator)
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
import Agora.Stake (ProposalLock (..), Stake (..), StakeDatum (..), StakeRedeemer (RetractVotes))
import Agora.Stake.Scripts (stakeValidator)
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (ProposalLock (..), StakeDatum (..), StakeRedeemer (RetractVotes))
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..), untag)
import Plutarch.Context (
@ -59,15 +59,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared (
agoraScripts,
governor,
minAda,
proposalPolicySymbol,
proposalValidatorHash,
signer,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (CombinableBuilder, mkSpending, sortValue, updateMap)
@ -277,7 +277,7 @@ unlockStake ps =
sortValue $
mconcat
[ Value.assetClassValue
(untag stake.gtClassRef)
(untag governor.gtClassRef)
(untag defStakedGTs)
, sst
, minAda
@ -532,7 +532,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
testValidator
(not ps.alterOutputStake)
"stake"
(stakeValidator Shared.stake)
agoraScripts.compiledStakeValidator
(mkStakeInputDatum ps)
stakeRedeemer
(spend stakeRef)
@ -544,7 +544,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
in testValidator
isValid
"proposal"
(proposalValidator Shared.proposal)
agoraScripts.compiledProposalValidator
(mkProposalInputDatum ps pid)
proposalRedeemer
(spend ref)

15
agora-specs/Sample/Proposal/Vote.hs
View file

@ -11,6 +11,7 @@ module Sample.Proposal.Vote (
validVoteAsDelegateParameters,
) where
import Agora.Governor (Governor (..))
import Agora.Proposal (
ProposalDatum (..),
ProposalId (ProposalId),
@ -19,18 +20,16 @@ import Agora.Proposal (
ProposalVotes (ProposalVotes),
ResultTag (ResultTag),
)
import Agora.Proposal.Scripts (proposalValidator)
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (draftTime, votingTime),
)
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (
ProposalLock (..),
Stake (gtClassRef),
StakeDatum (..),
StakeRedeemer (PermitVote),
)
import Agora.Stake.Scripts (stakeValidator)
import Data.Default (Default (def))
import Data.Tagged (Tagged (Tagged), untag)
import Plutarch.Context (
@ -52,15 +51,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared (
agoraScripts,
governor,
minAda,
proposalPolicySymbol,
proposalValidatorHash,
signer,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
group,
@ -205,7 +204,7 @@ vote params =
stakeValue =
sortValue $
sst
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
<> Value.assetClassValue (untag governor.gtClassRef) params.voteCount
<> minAda
signer =
@ -278,7 +277,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
testValidator
isValid
"proposal"
(proposalValidator Shared.proposal)
agoraScripts.compiledProposalValidator
proposalInputDatum
(mkProposalRedeemer ps)
(spend proposalRef)
@ -287,7 +286,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
let stakeInputDatum = mkStakeInputDatum ps
in validatorSucceedsWith
"stake"
(stakeValidator Shared.stake)
agoraScripts.compiledStakeValidator
stakeInputDatum
stakeRedeemer
(spend stakeRef)