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

offload some stuff from agora-test to agora-sample and agora-testlib

Browse source
This commit is contained in:
fanghr 2022-05-12 18:55:39 +08:00
parent 3d414b334a
commit 283edd64b7
No known key found for this signature in database
GPG key ID: 35CD9A71CD5D5870
12 changed files with 56 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

172
agora-sample/Sample/Effect/TreasuryWithdrawal.hs Normal file
View file

@ -0,0 +1,172 @@
{- |
Module : Sample.Effect.TreasuryWithdrawalEffect
Maintainer : seungheon.ooh@gmail.com
Description: Sample based testing for Treasury Withdrawal Effect
This module provides samples for Treasury Withdrawal Effect tests.
-}
module Sample.Effect.TreasuryWithdrawal (
inputTreasury,
inputUser,
inputGAT,
inputCollateral,
outputTreasury,
outputUser,
buildReceiversOutputFromDatum,
currSymbol,
users,
treasuries,
buildScriptContext,
) where
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.Char8 qualified as C
import Data.ByteString.Hash (sha2)
import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
treasuryWithdrawalValidator,
)
-- | 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 . C.pack . show <$> ([1 ..] :: [Integer])
-- | List of users who the effect will pay to.
treasuries :: [Credential]
treasuries = ScriptCredential . ValidatorHash . toBuiltin . sha2 . C.pack . show <$> ([1 ..] :: [Integer])
inputGAT :: TxInInfo
inputGAT =
TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
, txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
, txOutDatumHash = Just (DatumHash "")
}
inputTreasury :: Int -> Value -> TxInInfo
inputTreasury indx val =
TxInInfo
(TxOutRef "" 1)
TxOut
{ txOutAddress = Address (treasuries !! indx) Nothing
, txOutValue = val
, txOutDatumHash = Just (DatumHash "")
}
inputUser :: Int -> Value -> TxInInfo
inputUser indx val =
TxInInfo
(TxOutRef "" 1)
TxOut
{ txOutAddress = Address (users !! indx) Nothing
, txOutValue = val
, txOutDatumHash = Just (DatumHash "")
}
inputCollateral :: Int -> TxInInfo
inputCollateral indx =
TxInInfo -- Initiator
(TxOutRef "" 1)
TxOut
{ txOutAddress = Address (users !! indx) Nothing
, txOutValue = Value.singleton "" "" 2000000
, 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
validator = mkValidator $ treasuryWithdrawalValidator currSymbol
-- | 'TokenName' that represents the hash of the 'Stake' validator.
validatorHashTN :: TokenName
validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext
buildScriptContext inputs outputs =
ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs = inputs
, txInfoOutputs = outputs
, 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)
}

234
agora-sample/Sample/Proposal.hs Normal file
View file

@ -0,0 +1,234 @@
{- |
Module : Sample.Proposal
Maintainer : emi@haskell.fyi
Description: Sample based testing for Proposal utxos
This module tests primarily the happy path for Proposal interactions
-}
module Sample.Proposal (
-- * Script contexts
proposalCreation,
cosignProposal,
proposalRef,
stakeRef,
) where
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
validatorHash,
)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
Datum (Datum),
PubKeyHash,
ScriptContext (..),
ScriptPurpose (..),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
TxOutRef (TxOutRef),
)
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
import Agora.Governor (
GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds),
)
import Agora.Proposal (
Proposal (..),
ProposalDatum (..),
ProposalId (..),
ProposalStatus (..),
ResultTag (..),
emptyVotesFor,
)
import Agora.Stake (Stake (..), StakeDatum (StakeDatum))
import Plutarch.SafeMoney (Tagged (Tagged), untag)
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Shared
import Test.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
-- | This script context should be a valid transaction.
proposalCreation :: ScriptContext
proposalCreation =
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
effects =
AssocMap.fromList
[ (ResultTag 0, [])
, (ResultTag 1, [])
]
proposalDatum :: Datum
proposalDatum =
Datum
( toBuiltinData $
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects
}
)
govBefore :: Datum
govBefore =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 0
}
)
govAfter :: Datum
govAfter =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 1
}
)
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
, txOutValue = Value.assetClassValue proposal.governorSTAssetClass 1
, txOutDatumHash = Just (toDatumHash govBefore)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalDatum)
}
, TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
, txOutValue =
mconcat
[ Value.assetClassValue proposal.governorSTAssetClass 1
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash govAfter)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData =
[ datumPair proposalDatum
, datumPair govBefore
, datumPair govAfter
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting proposalPolicySymbol
}
proposalRef :: TxOutRef
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
stakeRef :: TxOutRef
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
-- | This script context should be a valid transaction.
cosignProposal :: [PubKeyHash] -> TxInfo
cosignProposal newSigners =
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
effects =
AssocMap.fromList
[ (ResultTag 0, [])
, (ResultTag 1, [])
]
proposalBefore :: ProposalDatum
proposalBefore =
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects
}
stakeDatum :: StakeDatum
stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []
proposalAfter :: ProposalDatum
proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners}
in TxInfo
{ txInfoInputs =
[ TxInInfo
proposalRef
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalBefore)
}
, TxInInfo
stakeRef
TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.singleton stakeSymbol "" 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
}
, TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.singleton stakeSymbol "" 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = newSigners
, txInfoData =
[ datumPair . Datum $ toBuiltinData proposalBefore
, datumPair . Datum $ toBuiltinData proposalAfter
, datumPair . Datum $ toBuiltinData stakeDatum
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}

193
agora-sample/Sample/Shared.hs Normal file
View file

@ -0,0 +1,193 @@
{- |
Module : Sample.Shared
Maintainer : emi@haskell.fyi
Description: Shared useful values for creating Samples for testing.
Shared useful values for creating Samples for testing.
-}
module Sample.Shared (
-- * Misc
signer,
signer2,
minAda,
-- * Components
-- ** Stake
stake,
stakeSymbol,
stakeValidatorHash,
stakeAddress,
-- ** Governor
governor,
govPolicy,
govValidator,
govSymbol,
-- ** Proposal
defaultProposalThresholds,
proposal,
proposalPolicySymbol,
proposalValidatorHash,
proposalValidatorAddress,
-- ** Treasury
treasuryOut,
gatTn,
gatCs,
mockTrEffect,
trCredential,
wrongEffHash,
) where
import Agora.Effect.NoOp (noOpValidator)
import Agora.Governor (
Governor (Governor),
governorPolicy,
governorValidator,
)
import Agora.Proposal (
Proposal (..),
ProposalThresholds (..),
)
import Agora.Proposal.Scripts (
proposalPolicy,
proposalValidator,
)
import Agora.Stake (Stake (..))
import Agora.Stake.Scripts (stakePolicy, stakeValidator)
import Agora.Treasury (treasuryValidator)
import Agora.Utils (validatorHashToTokenName)
import Plutarch.Api.V1 (
mintingPolicySymbol,
mkMintingPolicy,
mkValidator,
validatorHash,
)
import Plutarch.SafeMoney
import Plutus.V1.Ledger.Address (scriptHashAddress)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
CurrencySymbol,
MintingPolicy (..),
PubKeyHash,
)
import Plutus.V1.Ledger.Contexts (
TxOut (..),
)
import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash (..))
import Plutus.V1.Ledger.Value (TokenName, Value)
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
stake :: Stake
stake =
Stake
{ gtClassRef =
Tagged $
Value.assetClass
"da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
"LQ"
, proposalSTClass = Value.assetClass proposalPolicySymbol ""
}
stakeSymbol :: CurrencySymbol
stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef
stakeValidatorHash :: ValidatorHash
stakeValidatorHash = validatorHash $ mkValidator (stakeValidator stake)
stakeAddress :: Address
stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing
governor :: Governor
governor = Governor
govPolicy :: MintingPolicy
govPolicy = mkMintingPolicy (governorPolicy governor)
govValidator :: Validator
govValidator = mkValidator (governorValidator governor)
govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy
proposal :: Proposal
proposal =
Proposal
{ governorSTAssetClass = Value.assetClass govSymbol ""
, stakeSTAssetClass = Value.assetClass stakeSymbol ""
, maximumCosigners = 6
}
proposalPolicySymbol :: CurrencySymbol
proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal)
-- | A sample 'PubKeyHash'.
signer :: PubKeyHash
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
-- | Another sample 'PubKeyHash'.
signer2 :: PubKeyHash
signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
proposalValidatorHash :: ValidatorHash
proposalValidatorHash = validatorHash (mkValidator $ proposalValidator proposal)
proposalValidatorAddress :: Address
proposalValidatorAddress = scriptHashAddress proposalValidatorHash
defaultProposalThresholds :: ProposalThresholds
defaultProposalThresholds =
ProposalThresholds
{ countVoting = Tagged 1000
, create = Tagged 1
, startVoting = Tagged 10
}
------------------------------------------------------------------
treasuryOut :: TxOut
treasuryOut =
TxOut
{ txOutAddress = Address trCredential Nothing
, txOutValue = minAda
, txOutDatumHash = Nothing
}
{- | Arbitrary 'CurrencySymbol', representing the 'CurrencySymbol'
of a valid governance authority token (GAT).
-}
gatCs :: CurrencySymbol
gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
trValidator :: Validator
trValidator = mkValidator (treasuryValidator gatCs)
-- | `ScriptCredential` used for the dummy treasury validator.
trCredential :: Credential
trCredential = ScriptCredential $ validatorHash trValidator
-- | `TokenName` for GAT generated from address of `mockTrEffect`.
gatTn :: TokenName
gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
-- | Mock treasury effect script, used for testing.
mockTrEffect :: Validator
mockTrEffect = mkValidator $ noOpValidator gatCs
{- | A SHA-256 hash which (in all certainty) should not match the
hash of the dummy effect script.
-}
wrongEffHash :: ValidatorHash
wrongEffHash =
ValidatorHash
"a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b"
------------------------------------------------------------------
minAda :: Value
minAda = Value.singleton "" "" 10_000_000

161
agora-sample/Sample/Stake.hs Normal file
View file

@ -0,0 +1,161 @@
{- |
Module : Sample.Stake
Maintainer : emi@haskell.fyi
Description: Sample based testing for Stake utxos
This module tests primarily the happy path for Stake creation
-}
module Sample.Stake (
stake,
stakeSymbol,
validatorHashTN,
signer,
-- * Script contexts
stakeCreation,
stakeCreationWrongDatum,
stakeCreationUnsigned,
stakeDepositWithdraw,
DepositWithdrawExample (..),
) where
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
mkValidator,
validatorHash,
)
import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
Datum (Datum),
DatumHash (DatumHash),
ScriptContext (..),
ScriptPurpose (..),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (txOutAddress, txOutDatumHash, txOutValue),
ValidatorHash (ValidatorHash),
)
import Plutus.V1.Ledger.Contexts (TxOut (TxOut), TxOutRef (TxOutRef))
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Value (TokenName (TokenName))
import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
import Agora.SafeMoney (GTTag)
import Agora.Stake
import Agora.Stake.Scripts (stakeValidator)
import Plutarch.SafeMoney
import Sample.Shared
import Test.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
-- | 'TokenName' that represents the hash of the 'Stake' validator.
validatorHashTN :: TokenName
validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValidator stake) in TokenName vh
-- | This script context should be a valid transaction.
stakeCreation :: ScriptContext
stakeCreation =
let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer [])
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs = []
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue = st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242
, txOutDatumHash = Just (DatumHash "")
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData = [("", datum)]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting stakeSymbol
}
-- | This ScriptContext should fail because the datum has too much GT.
stakeCreationWrongDatum :: ScriptContext
stakeCreationWrongDatum =
let datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer []) -- Too much GT
in ScriptContext
{ scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]}
, scriptContextPurpose = Minting stakeSymbol
}
-- | This ScriptContext should fail because the datum has too much GT.
stakeCreationUnsigned :: ScriptContext
stakeCreationUnsigned =
ScriptContext
{ scriptContextTxInfo =
stakeCreation.scriptContextTxInfo
{ txInfoSignatories = []
}
, scriptContextPurpose = Minting stakeSymbol
}
--------------------------------------------------------------------------------
-- | Config for creating a ScriptContext that deposits or withdraws.
data DepositWithdrawExample = DepositWithdrawExample
{ startAmount :: Tagged GTTag Integer
-- ^ The amount of GT stored before the transaction.
, delta :: Tagged GTTag Integer
-- ^ The amount of GT deposited or withdrawn from the Stake.
}
-- | Create a ScriptContext that deposits or withdraws, given the config for it.
stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
stakeDepositWithdraw config =
let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
stakeBefore :: StakeDatum
stakeBefore = StakeDatum config.startAmount signer []
stakeAfter :: StakeDatum
stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta}
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st
<> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)
, txOutDatumHash = Just (toDatumHash stakeAfter)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)
, txOutDatumHash = Just (toDatumHash stakeAfter)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData = [datumPair stakeAfter]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
}

163
agora-sample/Sample/Treasury.hs Normal file
View file

@ -0,0 +1,163 @@
{-# LANGUAGE TemplateHaskell #-}
{- |
Module: Sample.Treasury
Description: Sample data for `Spec.Treasury`.
Maintainer: jack@mlabs.city
This module contains sample data, used in the tests written in
`Spec.Treasury`.
-}
module Sample.Treasury (
gatCs,
validCtx,
treasuryRef,
gatTn,
walletIn,
trCtxGATNameNotAddress,
) where
import Plutarch.Api.V1 (validatorHash)
import Plutus.V1.Ledger.Address (Address (..))
import Plutus.V1.Ledger.Api (
BuiltinByteString,
Credential (PubKeyCredential),
PubKeyHash (PubKeyHash),
)
import Plutus.V1.Ledger.Contexts (
ScriptContext (..),
ScriptPurpose (Minting),
TxInInfo (..),
TxInfo (..),
TxOut (..),
TxOutRef (..),
)
import Plutus.V1.Ledger.Credential (Credential (ScriptCredential))
import Plutus.V1.Ledger.Interval qualified as Interval
import Plutus.V1.Ledger.Scripts (
ValidatorHash (ValidatorHash),
)
import Plutus.V1.Ledger.Value qualified as Value
import Sample.Shared (
gatCs,
gatTn,
minAda,
mockTrEffect,
signer,
treasuryOut,
wrongEffHash,
)
import Test.Util (datumPair)
{- | A `ScriptContext` that should be compatible with treasury
transactions.
-}
validCtx :: ScriptContext
validCtx =
ScriptContext
{ scriptContextPurpose = Minting gatCs
, scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ treasuryIn
, effectIn
]
, txInfoOutputs =
[ treasuryOut
]
, -- Ensure sufficient ADA for transaction costs.
txInfoFee = Value.singleton "" "" 2 -- 2 ADA.
, -- Burn the GAT.
txInfoMint = Value.singleton gatCs gatTn (-1)
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData =
[ datumPair treasuryIn
, datumPair treasuryOut
, datumPair effectIn
]
, txInfoId =
"73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
}
}
where
treasuryIn =
TxInInfo
{ txInInfoOutRef = treasuryRef
, txInInfoResolved = treasuryOut
}
effectIn =
TxInInfo
{ txInInfoOutRef = effectRef
, txInInfoResolved =
TxOut
{ txOutAddress =
Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
, txOutValue =
mconcat
[ Value.singleton gatCs gatTn 1
, minAda
]
, txOutDatumHash = Nothing
}
}
-- | Reference to treasury output.
treasuryRef :: TxOutRef
treasuryRef =
TxOutRef
"73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
1
-- | Reference to dummy effect output.
effectRef :: TxOutRef
effectRef =
TxOutRef
"52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
0
-- | Input representing a user wallet with a valid GAT.
walletIn :: TxInInfo
walletIn =
TxInInfo
{ txInInfoOutRef =
TxOutRef
"cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
0
, txInInfoResolved =
TxOut
{ txOutDatumHash = Nothing
, txOutValue = Value.singleton gatCs gatTn 1
, txOutAddress =
Address
(PubKeyCredential $ PubKeyHash addressBs)
Nothing
}
}
addressBs :: BuiltinByteString
(ValidatorHash addressBs) = validatorHash mockTrEffect
trCtxGATNameNotAddress :: ScriptContext
trCtxGATNameNotAddress =
let txInfo = validCtx.scriptContextTxInfo
inputs = txInfo.txInfoInputs
effectIn = inputs !! 1
invalidEff =
effectIn
{ txInInfoResolved =
effectIn.txInInfoResolved
{ txOutAddress = Address (ScriptCredential wrongEffHash) Nothing
}
}
in validCtx
{ scriptContextTxInfo =
txInfo
{ txInfoInputs =
[ head inputs
, invalidEff
]
}
}