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

Restructure

Browse source 
`agora-spec` and `agora-spec` is merged to be `agora-specs`;
`agora-testlib` contains what previously was `Spec.Specification`.
This commit is contained in:
Seungheon Oh 2022-05-30 09:53:55 -05:00
parent e3031ed0aa
commit b65bc5a20d
21 changed files with 22 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

76
agora-specs/Spec/Effect/GovernorMutation.hs Normal file
View file

@ -0,0 +1,76 @@
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 Data.Default.Class (Default (def))
import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending))
import Sample.Effect.GovernorMutation (
effectRef,
govRef,
invalidNewGovernorDatum,
mkEffectDatum,
mkEffectTxInfo,
validNewGovernorDatum,
)
import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
effectFailsWith,
effectSucceedsWith,
group,
validatorFailsWith,
validatorSucceedsWith,
)
specs :: [SpecificationTree]
specs =
[ group
"validator"
[ group
"valid new governor datum"
[ validatorSucceedsWith
"governor validator should pass"
(governorValidator Shared.governor)
( GovernorDatum
def
(ProposalId 0)
def
def
)
MutateGovernor
( ScriptContext
(mkEffectTxInfo validNewGovernorDatum)
(Spending govRef)
)
, effectSucceedsWith
"effect validator should pass"
(mutateGovernorValidator Shared.governor)
(mkEffectDatum validNewGovernorDatum)
(ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
]
, group
"invalid new governor datum"
[ validatorFailsWith
"governor validator should fail"
(governorValidator Shared.governor)
( GovernorDatum
def
(ProposalId 0)
def
def
)
MutateGovernor
( ScriptContext
(mkEffectTxInfo invalidNewGovernorDatum)
(Spending govRef)
)
, effectFailsWith
"effect validator should fail"
(mutateGovernorValidator Shared.governor)
(mkEffectDatum validNewGovernorDatum)
(ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
]
]
]

172
agora-specs/Spec/Effect/TreasuryWithdrawal.hs Normal file
View file

@ -0,0 +1,172 @@
{- |
Module : Spec.Effect.TreasuryWithdrawalEffect
Maintainer : seungheon.ooh@gmail.com
Description: Sample based testing for Treasury Withdrawal Effect
This module specs the Treasury Withdrawal Effect.
-}
module Spec.Effect.TreasuryWithdrawal (specs) where
import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
treasuryWithdrawalValidator,
)
import Plutus.V1.Ledger.Value qualified as Value
import Sample.Effect.TreasuryWithdrawal (
buildReceiversOutputFromDatum,
buildScriptContext,
currSymbol,
inputCollateral,
inputGAT,
inputTreasury,
inputUser,
outputTreasury,
outputUser,
treasuries,
users,
)
import Test.Specification (
SpecificationTree,
effectFailsWith,
effectSucceedsWith,
group,
)
specs :: [SpecificationTree]
specs =
[ group
"effect"
[ effectSucceedsWith
"Simple"
(treasuryWithdrawalValidator currSymbol)
datum1
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 10)
]
$ outputTreasury 1 (asset1 7) :
buildReceiversOutputFromDatum datum1
)
, effectSucceedsWith
"Simple with multiple treasuries "
(treasuryWithdrawalValidator currSymbol)
datum1
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 10)
, inputTreasury 2 (asset1 100)
, inputTreasury 3 (asset1 500)
]
$ [ outputTreasury 1 (asset1 7)
, outputTreasury 2 (asset1 100)
, outputTreasury 3 (asset1 500)
]
++ buildReceiversOutputFromDatum datum1
)
, effectSucceedsWith
"Mixed Assets"
(treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 20)
, inputTreasury 2 (asset2 20)
]
$ [ outputTreasury 1 (asset1 13)
, outputTreasury 2 (asset2 14)
]
++ buildReceiversOutputFromDatum datum2
)
, effectFailsWith
"Pay to uknown 3rd party"
(treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 20)
, inputTreasury 2 (asset2 20)
]
$ [ outputUser 100 (asset1 2)
, outputTreasury 1 (asset1 11)
, outputTreasury 2 (asset2 14)
]
++ buildReceiversOutputFromDatum datum2
)
, effectFailsWith
"Missing receiver"
(treasuryWithdrawalValidator currSymbol)
datum2
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 20)
, inputTreasury 2 (asset2 20)
]
$ [ outputTreasury 1 (asset1 13)
, outputTreasury 2 (asset2 14)
]
++ drop 1 (buildReceiversOutputFromDatum datum2)
)
, effectFailsWith
"Unauthorized treasury"
(treasuryWithdrawalValidator currSymbol)
datum3
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 999 (asset1 20)
]
$ outputTreasury 999 (asset1 17) :
buildReceiversOutputFromDatum datum3
)
, effectFailsWith
"Prevent transactions besides the withdrawal"
(treasuryWithdrawalValidator currSymbol)
datum3
( buildScriptContext
[ inputGAT
, inputTreasury 1 (asset1 20)
, inputTreasury 999 (asset1 20)
, inputUser 99 (asset2 100)
]
$ [ outputTreasury 1 (asset1 17)
, outputUser 100 (asset2 100)
]
++ buildReceiversOutputFromDatum datum3
)
]
]
where
asset1 = Value.singleton "abbc12" "OrangeBottle"
asset2 = Value.singleton "abbc12" "19721121"
datum1 =
TreasuryWithdrawalDatum
[ (head users, asset1 1)
, (users !! 1, asset1 1)
, (users !! 2, asset1 1)
]
[ treasuries !! 1
, treasuries !! 2
, treasuries !! 3
]
datum2 =
TreasuryWithdrawalDatum
[ (head users, asset1 4 <> asset2 5)
, (users !! 1, asset1 2 <> asset2 1)
, (users !! 2, asset1 1)
]
[ head treasuries
, treasuries !! 1
, treasuries !! 2
]
datum3 =
TreasuryWithdrawalDatum
[ (head users, asset1 1)
, (users !! 1, asset1 1)
, (users !! 2, asset1 1)
]
[treasuries !! 1]