agora/agora-specs/Spec/Effect/TreasuryWithdrawal.hs
2022-08-12 05:01:35 +08:00

180 lines
5.3 KiB
Haskell

{- |
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 PlutusLedgerApi.V1.Value qualified as Value
import Sample.Effect.TreasuryWithdrawal (
buildReceiversOutputFromDatum,
buildScriptContext,
currSymbol,
inputCollateral,
inputGAT,
inputTreasury,
inputUser,
outputTreasury,
outputUser,
treasuries,
users,
)
import Sample.Shared (mkEffect)
import Test.Specification (
SpecificationTree,
effectFailsWith,
effectSucceedsWith,
group,
)
import Test.Util (sortValue)
specs :: [SpecificationTree]
specs =
[ group
"effect"
[ effectSucceedsWith
"Simple"
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum1
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 1 (asset1 10)
]
$ outputTreasury 1 (asset1 7) :
buildReceiversOutputFromDatum datum1
)
, effectSucceedsWith
"Simple with multiple treasuries "
(mkEffect $ 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"
(mkEffect $ 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"
(mkEffect $ 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"
(mkEffect $ 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"
(mkEffect $ treasuryWithdrawalValidator currSymbol)
datum3
( buildScriptContext
[ inputGAT
, inputCollateral 10
, inputTreasury 999 (asset1 20)
]
$ outputTreasury 999 (asset1 17) :
buildReceiversOutputFromDatum datum3
)
, effectFailsWith
"Prevent transactions besides the withdrawal"
(mkEffect $ 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
"0d586e057e76238f8c56c0752507bfa45ae13b04f8497a311d4aaa48"
"OrangeBottle"
asset2 =
Value.singleton
"7e6aa764bceeba1f7acf47d20f1a2a85440afa2928f8ae96376f4d85"
"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, sortValue $ asset2 5 <> asset1 4)
, (users !! 1, sortValue $ asset2 1 <> asset1 2)
, (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]