diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 02394bc..40a7b7f 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -8,8 +8,8 @@ import Test.Tasty (defaultMain, testGroup) -------------------------------------------------------------------------------- -import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal import Spec.AuthorityToken qualified as AuthorityToken +import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal import Spec.Model.MultiSig qualified as MultiSig import Spec.Stake qualified as Stake diff --git a/agora-test/Spec/Effect/TreasuryWithdrawal.hs b/agora-test/Spec/Effect/TreasuryWithdrawal.hs index 77ceb92..09bf1dc 100644 --- a/agora-test/Spec/Effect/TreasuryWithdrawal.hs +++ b/agora-test/Spec/Effect/TreasuryWithdrawal.hs @@ -5,20 +5,117 @@ 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 +module Spec.Effect.TreasuryWithdrawal (tests) where -import Spec.Sample.Effect.TreasuryWithdrawal +import Spec.Sample.Effect.TreasuryWithdrawal ( + buildReceiversOutputFromDatum, + buildScriptContext, + currSymbol, + inputGAT, + inputTreasury, + outputTreasury, + outputUser, + users, + ) +import Agora.Effect.TreasuryWithdrawal ( + TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), + treasuryWithdrawalValidator, + ) -import Agora.Effect.TreasuryWithdrawal +import Plutus.V1.Ledger.Value qualified as Value +import Spec.Util (effectFailsWith, effectSucceedsWith) -import Spec.Util - -import Test.Tasty +import Test.Tasty (TestTree, testGroup) tests :: [TestTree] tests = [ testGroup "effect" - [effectSucceedsWith "test1" (treasuryWithdrawalValidator currSymbol) datum scriptContext1] + [ effectSucceedsWith + "Simple" + (treasuryWithdrawalValidator currSymbol) + datum1 + ( buildScriptContext + [ inputGAT + , inputTreasury 1 (asset1 10) + ] + $ outputTreasury 1 (asset1 7) : + buildReceiversOutputFromDatum datum1 + ) + , effectSucceedsWith + "Simple with multiple treasuries " + (treasuryWithdrawalValidator currSymbol) + datum1 + ( buildScriptContext + [ inputGAT + , 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 + , 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 + , 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 + , inputTreasury 1 (asset1 20) + , inputTreasury 2 (asset2 20) + ] + $ [ outputTreasury 1 (asset1 13) + , outputTreasury 2 (asset2 14) + ] + ++ drop 1 (buildReceiversOutputFromDatum datum2) + ) + ] ] + 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) + ] + datum2 = + TreasuryWithdrawalDatum + [ (head users, asset1 4 <> asset2 5) + , (users !! 1, asset1 2 <> asset2 1) + , (users !! 2, asset1 1) + ] diff --git a/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs b/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs index 0f5d5a1..c228dc5 100644 --- a/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs @@ -5,16 +5,59 @@ 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 +module Spec.Sample.Effect.TreasuryWithdrawal ( + inputTreasury, + inputGAT, + outputTreasury, + outputUser, + buildReceiversOutputFromDatum, + currSymbol, + users, + treasuries, + buildScriptContext, +) where -import Plutarch.Api.V1 -import Plutus.V1.Ledger.Api +import Plutarch.Api.V1 (mkValidator, validatorHash) +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (..), + CurrencySymbol (CurrencySymbol), + DatumHash (DatumHash), + PubKeyHash (PubKeyHash), + ScriptContext (..), + ScriptPurpose (Spending), + TokenName (TokenName), + TxInInfo (TxInInfo), + TxInfo ( + TxInfo, + txInfoDCert, + txInfoData, + txInfoFee, + txInfoId, + txInfoInputs, + txInfoMint, + txInfoOutputs, + txInfoSignatories, + txInfoValidRange, + txInfoWdrl + ), + TxOut (..), + TxOutRef (TxOutRef), + Validator, + ValidatorHash (ValidatorHash), + Value, + toBuiltin, + ) import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Value qualified as Value -import Data.ByteString.Hash +import Data.ByteString.Char8 qualified as C +import Data.ByteString.Hash (sha2) -import Agora.Effect.TreasuryWithdrawal +import Agora.Effect.TreasuryWithdrawal ( + TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), + treasuryWithdrawalValidator, + ) -- | A sample Currency Symbol. currSymbol :: CurrencySymbol @@ -26,33 +69,57 @@ signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" -- | List of users who the effect will pay to. users :: [Credential] -users = - PubKeyCredential . PubKeyHash . toBuiltin . sha2 - <$> [ "Orange" - , "Bottle" - , "Hello" - ] +users = PubKeyCredential . PubKeyHash . toBuiltin . sha2 . C.pack . show <$> ([1 ..] :: [Integer]) -- | List of users who the effect will pay to. treasuries :: [Credential] -treasuries = - ScriptCredential . ValidatorHash . toBuiltin . sha2 - <$> [ "1234" - , "qwer" - , "asdf" - ] +treasuries = ScriptCredential . ValidatorHash . toBuiltin . sha2 . C.pack . show <$> ([1 ..] :: [Integer]) -_aa :: [Credential] -_aa = treasuries +inputGAT :: TxInInfo +inputGAT = + TxInInfo -- Initiator + (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) + TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST + , txOutDatumHash = Just (DatumHash "") + } --- | 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) - ] +inputTreasury :: Int -> Value -> TxInInfo +inputTreasury indx val = + TxInInfo -- Initiator + (TxOutRef "" 1) + TxOut + { txOutAddress = Address (treasuries !! indx) Nothing + , txOutValue = val + , txOutDatumHash = Just (DatumHash "") + } + +outputTreasury :: Int -> Value -> TxOut +outputTreasury indx val = + TxOut + { txOutAddress = Address (treasuries !! indx) Nothing + , txOutValue = val + , txOutDatumHash = Nothing + } + +outputUser :: Int -> Value -> TxOut +outputUser indx val = + TxOut + { txOutAddress = Address (users !! indx) Nothing + , txOutValue = val + , txOutDatumHash = Nothing + } + +buildReceiversOutputFromDatum :: TreasuryWithdrawalDatum -> [TxOut] +buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs) = f <$> xs + where + f x = + TxOut + { txOutAddress = Address (fst x) Nothing + , txOutValue = snd x + , txOutDatumHash = Nothing + } -- | Effect validator instance. validator :: Validator @@ -62,62 +129,13 @@ validator = mkValidator $ treasuryWithdrawalValidator currSymbol validatorHashTN :: TokenName validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh -scriptContext1 :: ScriptContext -scriptContext1 = +buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext +buildScriptContext inputs outputs = 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 - } - ] + { txInfoInputs = inputs + , txInfoOutputs = outputs , txInfoFee = Value.singleton "" "" 2 , txInfoMint = Value.singleton currSymbol validatorHashTN (-1) , txInfoDCert = []