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

Yeah! Treasury Withdrawal Effect works with good tests

Browse source
This commit is contained in:
Seungheon Oh 2022-04-21 19:02:10 -05:00
parent 82dd53efcf
commit 7f6ccc0dee
No known key found for this signature in database
GPG key ID: 9B0E12D357369B66
3 changed files with 203 additions and 88 deletions
Download patch file Download diff file Expand all files Collapse all files

178
agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs
View file

@ -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 = []