55defea912
- Removed `Utils.Value` -- not being used/better is provided with liqwid-plutarch-extra - uses `Liqwid-Labs/plutarch` - uses `Liqwid-Labs/plutarch-numeric` - uses `Liqwid-Labs/plutarch-safemoney` - uses `Liqwid-Labs/liqwid-plutarch-extra`
417 lines
13 KiB
Haskell
417 lines
13 KiB
Haskell
{- |
|
|
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"
|
|
}
|