{- | 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, voteOnProposal, VotingParameters (..), ) where -------------------------------------------------------------------------------- import Plutarch.Api.V1 ( validatorHash, ) -------------------------------------------------------------------------------- import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), Datum (Datum), POSIXTimeRange, PubKeyHash, ScriptContext (..), ScriptPurpose (..), ToData (toBuiltinData), TxInInfo (TxInInfo), TxInfo (..), TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), TxOutRef (TxOutRef), ) import Plutus.V1.Ledger.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -------------------------------------------------------------------------------- import Agora.Governor ( GovernorDatum (..), ) import Agora.Proposal ( Proposal (..), ProposalDatum (..), ProposalId (..), ProposalStatus (..), ProposalVotes (..), ResultTag (..), emptyVotesFor, ) import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..)) import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) import Data.Tagged (Tagged (..), untag) import Sample.Shared import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap) -------------------------------------------------------------------------------- import Data.Default.Class (Default (def)) -------------------------------------------------------------------------------- -- | This script context should be a valid transaction. proposalCreation :: ScriptContext proposalCreation = let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST effects = AssocMap.fromList [ (ResultTag 0, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] proposalDatum :: Datum proposalDatum = Datum ( toBuiltinData $ ProposalDatum { proposalId = ProposalId 0 , effects = effects , status = Draft , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects , timingConfig = def , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) govBefore :: Datum govBefore = Datum ( toBuiltinData $ GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 , proposalTimings = def , createProposalTimeRangeMaxWidth = def } ) govAfter :: Datum govAfter = Datum ( toBuiltinData $ GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 1 , proposalTimings = def , createProposalTimeRangeMaxWidth = def } ) validTimeRange = closedBoundedInterval 10 15 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 = validTimeRange , 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, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] proposalBefore :: ProposalDatum proposalBefore = ProposalDatum { proposalId = ProposalId 0 , effects = effects , status = Draft , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects , timingConfig = def , startingTime = ProposalStartingTime 0 } stakeDatum :: StakeDatum stakeDatum = StakeDatum (Tagged 50_000_000) signer2 [] proposalAfter :: ProposalDatum proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners} validTimeRange :: POSIXTimeRange validTimeRange = closedBoundedInterval 10 ((def :: ProposalTimingConfig).draftTime - 10) 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.assetClassValue stakeAssetClass 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.assetClassValue stakeAssetClass 1 ] , txOutDatumHash = Just (toDatumHash stakeDatum) } ] , txInfoFee = Value.singleton "" "" 2 , txInfoMint = st , txInfoDCert = [] , txInfoWdrl = [] , txInfoValidRange = validTimeRange , txInfoSignatories = newSigners , txInfoData = [ datumPair . Datum $ toBuiltinData proposalBefore , datumPair . Datum $ toBuiltinData proposalAfter , datumPair . Datum $ toBuiltinData stakeDatum ] , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" } -------------------------------------------------------------------------------- -- | Parameters for creating a voting transaction. data VotingParameters = VotingParameters { voteFor :: ResultTag -- ^ The outcome the transaction is voting for. , voteCount :: Integer -- ^ The count of votes. } -- | Create a valid transaction that votes on a propsal, given the parameters. voteOnProposal :: VotingParameters -> TxInfo voteOnProposal params = let pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 --- stakeOwner = signer --- effects = AssocMap.fromList [ (ResultTag 0, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] --- initialVotes :: AssocMap.Map ResultTag Integer initialVotes = AssocMap.fromList [ (ResultTag 0, 42) , (ResultTag 1, 4242) ] --- proposalInputDatum' :: ProposalDatum proposalInputDatum' = ProposalDatum { proposalId = ProposalId 42 , effects = effects , status = VotingReady , cosigners = [stakeOwner] , thresholds = defaultProposalThresholds , votes = ProposalVotes initialVotes , timingConfig = def , startingTime = ProposalStartingTime 0 } proposalInputDatum :: Datum proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' proposalInput :: TxOut proposalInput = TxOut { txOutAddress = proposalValidatorAddress , txOutValue = pst , txOutDatumHash = Just $ toDatumHash proposalInputDatum } --- existingLocks :: [ProposalLock] existingLocks = [ ProposalLock (ResultTag 0) (ProposalId 0) , ProposalLock (ResultTag 2) (ProposalId 1) ] --- stakeInputDatum' :: StakeDatum stakeInputDatum' = StakeDatum { stakedAmount = Tagged params.voteCount , owner = stakeOwner , lockedBy = existingLocks } stakeInputDatum :: Datum stakeInputDatum = Datum $ toBuiltinData stakeInputDatum' stakeInput :: TxOut stakeInput = TxOut { txOutAddress = stakeAddress , txOutValue = mconcat [ sst , Value.assetClassValue (untag stake.gtClassRef) params.voteCount , minAda ] , txOutDatumHash = Just $ toDatumHash stakeInputDatum } --- updatedVotes :: AssocMap.Map ResultTag Integer updatedVotes = updateMap (Just . (+ params.voteCount)) params.voteFor initialVotes --- proposalOutputDatum' :: ProposalDatum proposalOutputDatum' = proposalInputDatum' { votes = ProposalVotes updatedVotes } proposalOutputDatum :: Datum proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum' proposalOutput :: TxOut proposalOutput = proposalInput { txOutDatumHash = Just $ toDatumHash proposalOutputDatum } --- -- Off-chain code should do exactly like this: prepend new lock to the list. updatedLocks :: [ProposalLock] updatedLocks = ProposalLock params.voteFor proposalInputDatum'.proposalId : existingLocks --- stakeOutputDatum' :: StakeDatum stakeOutputDatum' = stakeInputDatum' { lockedBy = updatedLocks } stakeOutputDatum :: Datum stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum' stakeOutput :: TxOut stakeOutput = stakeInput { txOutDatumHash = Just $ toDatumHash stakeOutputDatum } --- validTimeRange = closedBoundedInterval ((def :: ProposalTimingConfig).draftTime + 1) ((def :: ProposalTimingConfig).votingTime - 1) in TxInfo { txInfoInputs = [ TxInInfo proposalRef proposalInput , TxInInfo stakeRef stakeInput ] , txInfoOutputs = [proposalOutput, stakeOutput] , txInfoFee = Value.singleton "" "" 2 , txInfoMint = mempty , txInfoDCert = [] , txInfoWdrl = [] , txInfoValidRange = validTimeRange , txInfoSignatories = [stakeOwner] , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum] , txInfoId = "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c" }