diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 2f443cd..02394bc 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -8,6 +8,7 @@ import Test.Tasty (defaultMain, testGroup) -------------------------------------------------------------------------------- +import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal import Spec.AuthorityToken qualified as AuthorityToken import Spec.Model.MultiSig qualified as MultiSig import Spec.Stake qualified as Stake @@ -19,6 +20,12 @@ main = testGroup "test suite" [ testGroup + "Effects" + [ testGroup + "Treasury Withdrawal Effect" + TreasuryWithdrawal.tests + ] + , testGroup "Stake tests" Stake.tests , testGroup diff --git a/agora-test/Spec/Effect/TreasuryWithdrawal.hs b/agora-test/Spec/Effect/TreasuryWithdrawal.hs new file mode 100644 index 0000000..77ceb92 --- /dev/null +++ b/agora-test/Spec/Effect/TreasuryWithdrawal.hs @@ -0,0 +1,24 @@ +{- | +Module : Spec.Effect.TreasuryWithdrawalEffect +Maintainer : seungheon.ooh@gmail.com +Description: Sample based testing for Treasury Withdrawal Effect + +This module tests the Treasury Withdrawal Effect. +-} +module Spec.Effect.TreasuryWithdrawal (currSymbol, signer, validator, validatorHashTN, scriptContext1, tests) where + +import Spec.Sample.Effect.TreasuryWithdrawal + + +import Agora.Effect.TreasuryWithdrawal + +import Spec.Util + +import Test.Tasty + +tests :: [TestTree] +tests = + [ testGroup + "effect" + [effectSucceedsWith "test1" (treasuryWithdrawalValidator currSymbol) datum scriptContext1] + ] diff --git a/agora-test/Spec/Effect/TreasuryWithdrawalEffect.hs b/agora-test/Spec/Effect/TreasuryWithdrawalEffect.hs deleted file mode 100644 index f3e9396..0000000 --- a/agora-test/Spec/Effect/TreasuryWithdrawalEffect.hs +++ /dev/null @@ -1,257 +0,0 @@ -{- | -Module : Spec.Effect.TreasuryWithdrawalEffect -Maintainer : seungheon.ooh@gmail.com -Description: Sample based testing for Treasury Withdrawal Effect - -This module tests the Treasury Withdrawal Effect. --} -module Spec.Effect.TreasuryWithdrawalEffect (currSymbol, signer, validator, validatorHashTN, scriptContext1, tests) where - -import Plutarch.Api.V1 -import Plutarch.Builtin -import Plutarch.Evaluate -import Plutus.V1.Ledger.Api -import Plutus.V1.Ledger.Interval qualified as Interval -import Plutus.V1.Ledger.Value qualified as Value - -import Data.ByteString.Hash - -import Agora.AuthorityToken -import Agora.Effect.TreasuryWithdrawal - -import Spec.Util - -import Test.Tasty - --- receiverList :: TreasuryWithdrawalDatum --- receiverList = TreasuryWithdrawalDatum [(mempty, mempty)] - --- | A sample Currency Symbol. -currSymbol :: CurrencySymbol -currSymbol = CurrencySymbol "12312099" - -gtSymbol :: CurrencySymbol -gtSymbol = CurrencySymbol "abb" - -gtToken :: TokenName -gtToken = TokenName "hey" - --- | A sample 'PubKeyHash'. -signer :: PubKeyHash -signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" - --- | List of users who the effect will pay to. -users :: [Credential] -users = - PubKeyCredential . PubKeyHash . toBuiltin . sha2 - <$> [ "Orange" - , "Bottle" - , "Hello" - ] - --- | List of users who the effect will pay to. -treasuries :: [Credential] -treasuries = - ScriptCredential . ValidatorHash . toBuiltin . sha2 - <$> [ "1234" - , "qwer" - , "asdf" - ] - -_aa :: [Credential] -_aa = treasuries - --- | Datum for Treasury Withdrawal Effect Validator. -datum :: TreasuryWithdrawalDatum -datum = - TreasuryWithdrawalDatum - [ (users !! 0, Value.singleton "1234ab" "LQ" 1) - , (users !! 1, Value.singleton "1234ab" "LQ" 1) - , (users !! 2, Value.singleton "1234ab" "LQ" 1) - ] - --- | Effect validator instance. -validator :: Validator -validator = mkValidator $ treasuryWithdrawalValidator currSymbol - --- | 'TokenName' that represents the hash of the 'Stake' validator. -validatorHashTN :: TokenName -validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh - -scriptContext1 :: ScriptContext -scriptContext1 = - ScriptContext - { scriptContextTxInfo = - TxInfo - { txInfoInputs = - [ TxInInfo -- Initiator - (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) - TxOut - { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing - , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST - , txOutDatumHash = Just (DatumHash "") - } - , TxInInfo -- Treasury 1 - (TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2) - TxOut - { txOutAddress = Address (treasuries !! 0) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 10 - , txOutDatumHash = Just (DatumHash "") - } - , TxInInfo -- Treasury 2 - (TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3) - TxOut - { txOutAddress = Address (treasuries !! 1) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 10 - , txOutDatumHash = Just (DatumHash "") - } - ] - , txInfoOutputs = - [ TxOut - { txOutAddress = Address (users !! 0) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 1 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (users !! 1) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 1 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (users !! 2) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 1 - , txOutDatumHash = Nothing - } - , -- Send left overs to treasuries - TxOut - { txOutAddress = Address (treasuries !! 0) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 7 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (treasuries !! 1) Nothing - , txOutValue = Value.singleton "1234ab" "LQ" 10 - , txOutDatumHash = Nothing - } - ] - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = Value.singleton currSymbol validatorHashTN (-1) - , txInfoDCert = [] - , txInfoWdrl = [] - , txInfoValidRange = Interval.always - , txInfoSignatories = [signer] - , txInfoData = [] - , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - } - , scriptContextPurpose = - Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) - } - -tests :: [TestTree] -tests = - [ testGroup - "effect" - [effectSucceedsWith "test1" (treasuryWithdrawalValidator currSymbol) datum scriptContext1] - ] - -_asdfa :: IO () -_asdfa = do - let (res, _budget, traces) = evalScript $ compile ((treasuryWithdrawalValidator currSymbol) # pforgetData (pconstantData datum) # pforgetData (pconstantData ()) # pconstant scriptContext1) - case res of - Left e -> do - putStrLn $ show e <> " Traces: " <> show traces - Right _v -> - pure () - -_test :: IO () -_test = do - let (res, _budget, traces) = - evalScript $ - compile - ( authorityTokensValidIn # pconstant currSymbol - # ( pconstant $ - TxOut - { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing - , txOutValue = Value.singleton currSymbol validatorHashTN 1 - , txOutDatumHash = Just (DatumHash "") - } - ) - ) - case res of - Left e -> do - putStrLn $ show e <> " Traces: " <> show traces - Right _v -> - pure () - -_test2 :: IO () -_test2 = do - let (res, _budget, traces) = evalScript $ compile (singleAuthorityTokenBurned (pconstant currSymbol) (pconstantData tinfo) (pconstant mv)) - case res of - Left e -> do - putStrLn $ show e <> " Traces: " <> show traces - Right _v -> - putStrLn $ show res - where - mv = mempty -- Value.singleton currSymbol validatorHashTN (1) - tinfo = - TxInfo - { txInfoInputs = - [ TxInInfo -- Initiator - (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) - TxOut - { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing - , txOutValue = mempty - , txOutDatumHash = Just (DatumHash "") - } - , TxInInfo -- Treasury 1 - (TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2) - TxOut - { txOutAddress = Address (treasuries !! 0) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 10 - , txOutDatumHash = Just (DatumHash "") - } - , TxInInfo -- Treasury 2 - (TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3) - TxOut - { txOutAddress = Address (treasuries !! 1) Nothing - , txOutValue = Value.singleton "1234ab" "LQLQLQL" 10 - , txOutDatumHash = Just (DatumHash "") - } - ] - , txInfoOutputs = - [ TxOut - { txOutAddress = Address (users !! 0) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 1 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (users !! 1) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 1 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (users !! 2) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 1 - , txOutDatumHash = Nothing - } - , -- Send left overs to treasuries - TxOut - { txOutAddress = Address (treasuries !! 0) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 7 - , txOutDatumHash = Nothing - } - , TxOut - { txOutAddress = Address (treasuries !! 1) Nothing - , txOutValue = Value.singleton gtSymbol gtToken 10 - , txOutDatumHash = Nothing - } - ] - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = mempty -- Value.singleton currSymbol validatorHashTN (-1) - , txInfoDCert = [] - , txInfoWdrl = [] - , txInfoValidRange = Interval.always - , txInfoSignatories = [signer] - , txInfoData = [] - , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - } diff --git a/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs b/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs new file mode 100644 index 0000000..0f5d5a1 --- /dev/null +++ b/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs @@ -0,0 +1,132 @@ +{- | +Module : Spec.Sample.Effect.TreasuryWithdrawalEffect +Maintainer : seungheon.ooh@gmail.com +Description: Sample based testing for Treasury Withdrawal Effect + +This module provides smaples for Treasury Withdrawal Effect tests. +-} +module Spec.Sample.Effect.TreasuryWithdrawal (datum, currSymbol, signer, validator, validatorHashTN, scriptContext1) where + +import Plutarch.Api.V1 +import Plutus.V1.Ledger.Api +import Plutus.V1.Ledger.Interval qualified as Interval +import Plutus.V1.Ledger.Value qualified as Value + +import Data.ByteString.Hash + +import Agora.Effect.TreasuryWithdrawal + +-- | A sample Currency Symbol. +currSymbol :: CurrencySymbol +currSymbol = CurrencySymbol "12312099" + +-- | A sample 'PubKeyHash'. +signer :: PubKeyHash +signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" + +-- | List of users who the effect will pay to. +users :: [Credential] +users = + PubKeyCredential . PubKeyHash . toBuiltin . sha2 + <$> [ "Orange" + , "Bottle" + , "Hello" + ] + +-- | List of users who the effect will pay to. +treasuries :: [Credential] +treasuries = + ScriptCredential . ValidatorHash . toBuiltin . sha2 + <$> [ "1234" + , "qwer" + , "asdf" + ] + +_aa :: [Credential] +_aa = treasuries + +-- | Datum for Treasury Withdrawal Effect Validator. +datum :: TreasuryWithdrawalDatum +datum = + TreasuryWithdrawalDatum + [ (users !! 0, Value.singleton "1234ab" "LQ" 1) + , (users !! 1, Value.singleton "1234ab" "LQ" 1) + , (users !! 2, Value.singleton "1234ab" "LQ" 1) + ] + +-- | Effect validator instance. +validator :: Validator +validator = mkValidator $ treasuryWithdrawalValidator currSymbol + +-- | 'TokenName' that represents the hash of the 'Stake' validator. +validatorHashTN :: TokenName +validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh + +scriptContext1 :: ScriptContext +scriptContext1 = + ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ TxInInfo -- Initiator + (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) + TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST + , txOutDatumHash = Just (DatumHash "") + } + , TxInInfo -- Treasury 1 + (TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2) + TxOut + { txOutAddress = Address (treasuries !! 0) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 10 + , txOutDatumHash = Just (DatumHash "") + } + , TxInInfo -- Treasury 2 + (TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3) + TxOut + { txOutAddress = Address (treasuries !! 1) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 10 + , txOutDatumHash = Just (DatumHash "") + } + ] + , txInfoOutputs = + [ TxOut + { txOutAddress = Address (users !! 0) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 1 + , txOutDatumHash = Nothing + } + , TxOut + { txOutAddress = Address (users !! 1) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 1 + , txOutDatumHash = Nothing + } + , TxOut + { txOutAddress = Address (users !! 2) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 1 + , txOutDatumHash = Nothing + } + , -- Send left overs to treasuries + TxOut + { txOutAddress = Address (treasuries !! 0) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 7 + , txOutDatumHash = Nothing + } + , TxOut + { txOutAddress = Address (treasuries !! 1) Nothing + , txOutValue = Value.singleton "1234ab" "LQ" 10 + , txOutDatumHash = Nothing + } + ] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = Value.singleton currSymbol validatorHashTN (-1) + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer] + , txInfoData = [] + , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + } + , scriptContextPurpose = + Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) + } diff --git a/agora.cabal b/agora.cabal index 3f47333..0ace2a8 100644 --- a/agora.cabal +++ b/agora.cabal @@ -152,7 +152,8 @@ test-suite agora-test main-is: Spec.hs hs-source-dirs: agora-test other-modules: - Spec.Effect.TreasuryWithdrawalEffect + Spec.Effect.TreasuryWithdrawal + Spec.Sample.Effect.TreasuryWithdrawal Spec.Model.MultiSig Spec.Sample.Stake Spec.Stake