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

12
agora-specs/Spec/Effect/GovernorMutation.hs
View file

@ -2,8 +2,8 @@ module Spec.Effect.GovernorMutation (specs) where
import Agora.Effect.GovernorMutation (mutateGovernorValidator)
import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (ProposalId (..))
import Agora.Scripts (AgoraScripts (..))
import Data.Default.Class (Default (def))
import PlutusLedgerApi.V1 (ScriptContext (ScriptContext), ScriptPurpose (Spending))
import Sample.Effect.GovernorMutation (
@ -14,7 +14,7 @@ import Sample.Effect.GovernorMutation (
mkEffectTxInfo,
validNewGovernorDatum,
)
import Sample.Shared qualified as Shared
import Sample.Shared (agoraScripts, mkEffect)
import Test.Specification (
SpecificationTree,
effectFailsWith,
@ -32,7 +32,7 @@ specs =
"valid new governor datum"
[ validatorSucceedsWith
"governor validator should pass"
(governorValidator Shared.governor)
agoraScripts.compiledGovernorValidator
( GovernorDatum
def
(ProposalId 0)
@ -47,7 +47,7 @@ specs =
)
, effectSucceedsWith
"effect validator should pass"
(mutateGovernorValidator Shared.governor)
(mkEffect $ mutateGovernorValidator agoraScripts)
(mkEffectDatum validNewGovernorDatum)
(ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
]
@ -55,7 +55,7 @@ specs =
"invalid new governor datum"
[ validatorFailsWith
"governor validator should fail"
(governorValidator Shared.governor)
agoraScripts.compiledGovernorValidator
( GovernorDatum
def
(ProposalId 0)
@ -70,7 +70,7 @@ specs =
)
, effectFailsWith
"effect validator should fail"
(mutateGovernorValidator Shared.governor)
(mkEffect $ mutateGovernorValidator agoraScripts)
(mkEffectDatum validNewGovernorDatum)
(ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
]

30
agora-specs/Spec/Effect/TreasuryWithdrawal.hs
View file

@ -25,12 +25,14 @@ import Sample.Effect.TreasuryWithdrawal (
treasuries,
users,
)
import Sample.Shared (mkEffect)
import Test.Specification (
SpecificationTree,
effectFailsWith,
effectSucceedsWith,
group,
)
import Test.Util (sortValue)
specs :: [SpecificationTree]
specs =
@ -38,7 +40,7 @@ specs =
"effect"
[ effectSucceedsWith
"Simple"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum1
( buildScriptContext
[ inputGAT
@ -50,7 +52,7 @@ specs =
)
, effectSucceedsWith
"Simple with multiple treasuries "
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum1
( buildScriptContext
[ inputGAT
@ -67,7 +69,7 @@ specs =
)
, effectSucceedsWith
"Mixed Assets"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
@ -82,7 +84,7 @@ specs =
)
, effectFailsWith
"Pay to uknown 3rd party"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
@ -98,7 +100,7 @@ specs =
)
, effectFailsWith
"Missing receiver"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
@ -113,7 +115,7 @@ specs =
)
, effectFailsWith
"Unauthorized treasury"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum3
( buildScriptContext
[ inputGAT
@ -125,7 +127,7 @@ specs =
)
, effectFailsWith
"Prevent transactions besides the withdrawal"
(treasuryWithdrawalValidator currSymbol)
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum3
( buildScriptContext
[ inputGAT
@ -141,8 +143,14 @@ specs =
]
]
where
asset1 = Value.singleton "abbc12" "OrangeBottle"
asset2 = Value.singleton "abbc12" "19721121"
asset1 =
Value.singleton
"0d586e057e76238f8c56c0752507bfa45ae13b04f8497a311d4aaa48"
"OrangeBottle"
asset2 =
Value.singleton
"7e6aa764bceeba1f7acf47d20f1a2a85440afa2928f8ae96376f4d85"
"19721121"
datum1 =
TreasuryWithdrawalDatum
[ (head users, asset1 1)
@ -155,8 +163,8 @@ specs =
]
datum2 =
TreasuryWithdrawalDatum
[ (head users, asset2 5 <> asset1 4)
, (users !! 1, asset2 1 <> asset1 2)
[ (head users, sortValue $ asset2 5 <> asset1 4)
, (users !! 1, sortValue $ asset2 1 <> asset1 2)
, (users !! 2, asset1 1)
]
[ head treasuries

30
agora-specs/Spec/Stake.hs
View file

@ -9,14 +9,14 @@ Tests for Stake policy and validator
-}
module Spec.Stake (specs) where
import Agora.Scripts (AgoraScripts (..))
import Agora.Stake (
Stake (..),
StakeDatum (StakeDatum),
StakeRedeemer (DepositWithdraw),
)
import Agora.Stake.Scripts (stakePolicy, stakeValidator)
import Data.Bool (Bool (..))
import Data.Maybe (Maybe (..))
import Sample.Shared (agoraScripts)
import Sample.Stake (
DepositWithdrawExample (
DepositWithdrawExample,
@ -26,7 +26,6 @@ import Sample.Stake (
signer,
)
import Sample.Stake qualified as Stake (
stake,
stakeCreation,
stakeCreationUnsigned,
stakeCreationWrongDatum,
@ -41,7 +40,6 @@ import Test.Specification (
validatorFailsWith,
validatorSucceedsWith,
)
import Test.Util (toDatum)
import Prelude (Num (negate), ($))
-- | The SpecificationTree exported by this module.
@ -51,17 +49,17 @@ specs =
"policy"
[ policySucceedsWith
"stakeCreation"
(stakePolicy Stake.stake.gtClassRef)
agoraScripts.compiledStakePolicy
()
Stake.stakeCreation
, policyFailsWith
"stakeCreationWrongDatum"
(stakePolicy Stake.stake.gtClassRef)
agoraScripts.compiledStakePolicy
()
Stake.stakeCreationWrongDatum
, policyFailsWith
"stakeCreationUnsigned"
(stakePolicy Stake.stake.gtClassRef)
agoraScripts.compiledStakePolicy
()
Stake.stakeCreationUnsigned
]
@ -69,21 +67,21 @@ specs =
"validator"
[ validatorSucceedsWith
"stakeDepositWithdraw deposit"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw 100_000)
agoraScripts.compiledStakeValidator
(StakeDatum 100_000 signer Nothing [])
(DepositWithdraw 100_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000})
, validatorSucceedsWith
"stakeDepositWithdraw withdraw"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw $ negate 100_000)
agoraScripts.compiledStakeValidator
(StakeDatum 100_000 signer Nothing [])
(DepositWithdraw $ negate 100_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000})
, validatorFailsWith
"stakeDepositWithdraw negative GT"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw 1_000_000)
agoraScripts.compiledStakeValidator
(StakeDatum 100_000 signer Nothing [])
(DepositWithdraw 1_000_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000})
, group
"set delegate"

24
agora-specs/Spec/Treasury.hs
View file

@ -25,6 +25,8 @@ import Agora.Treasury (
TreasuryRedeemer (SpendTreasuryGAT),
treasuryValidator,
)
import Agora.Utils (CompiledValidator (CompiledValidator))
import Plutarch.Api.V1 (mkValidator)
import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey))
import PlutusLedgerApi.V1.Contexts (
ScriptContext (scriptContextPurpose, scriptContextTxInfo),
@ -35,7 +37,7 @@ import PlutusLedgerApi.V1.Credential (
StakingCredential (StakingHash),
)
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import Sample.Shared (trCredential)
import Sample.Shared (deterministicTracingConfing, trCredential)
import Sample.Treasury (
gatCs,
gatTn,
@ -51,6 +53,12 @@ import Test.Specification (
validatorSucceedsWith,
)
compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer
compiledTreasuryValidator =
CompiledValidator $
mkValidator deterministicTracingConfing $
treasuryValidator gatCs
specs :: [SpecificationTree]
specs =
[ group
@ -59,7 +67,7 @@ specs =
"Positive"
[ validatorSucceedsWith
"Allows for effect changes"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
validCtx
@ -70,7 +78,7 @@ specs =
"Fails with ScriptPurpose not Minting"
[ validatorFailsWith
"Spending"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
validCtx
@ -78,7 +86,7 @@ specs =
}
, validatorFailsWith
"Rewarding"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
validCtx
@ -88,7 +96,7 @@ specs =
}
, validatorFailsWith
"Certifying"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
validCtx
@ -100,7 +108,7 @@ specs =
]
, validatorFailsWith -- TODO: Use QuickCheck.
"Fails when multiple GATs burned"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
validCtx
@ -115,13 +123,13 @@ specs =
}
, validatorFailsWith
"Fails when GAT token name is not script address"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
trCtxGATNameNotAddress
, validatorFailsWith
"Fails with wallet as input"
(treasuryValidator gatCs)
compiledTreasuryValidator
()
SpendTreasuryGAT
( let txInfo = validCtx.scriptContextTxInfo