add tests for advancement from draft phrase; refactoring
This commit is contained in:
Hongrui Fang
parent
d433ab17d6
commit
9c8d04dbc6
12 changed files with 1402 additions and 1078 deletions
|
|
@ -23,17 +23,13 @@ import Agora.Effect.TreasuryWithdrawal (
|
|||
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
|
||||
treasuryWithdrawalValidator,
|
||||
)
|
||||
import Crypto.Hash qualified as Crypto
|
||||
import Data.ByteArray qualified as BA
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.ByteString.Char8 qualified as C (pack)
|
||||
import Plutarch.Api.V1 (mkValidator, validatorHash)
|
||||
import PlutusLedgerApi.V1 (
|
||||
Address (Address),
|
||||
Credential (..),
|
||||
CurrencySymbol (CurrencySymbol),
|
||||
DatumHash (DatumHash),
|
||||
PubKeyHash (PubKeyHash),
|
||||
PubKeyHash,
|
||||
ScriptContext (..),
|
||||
ScriptPurpose (Spending),
|
||||
TokenName (TokenName),
|
||||
|
|
@ -56,10 +52,10 @@ import PlutusLedgerApi.V1 (
|
|||
Validator,
|
||||
ValidatorHash (ValidatorHash),
|
||||
Value,
|
||||
toBuiltin,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
|
||||
import Test.Util (scriptCredentials, userCredentials)
|
||||
|
||||
-- | A sample Currency Symbol.
|
||||
currSymbol :: CurrencySymbol
|
||||
|
|
@ -69,16 +65,13 @@ currSymbol = CurrencySymbol "12312099"
|
|||
signer :: PubKeyHash
|
||||
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
|
||||
|
||||
blake2b_224 :: BS.ByteString -> BS.ByteString
|
||||
blake2b_224 = BS.pack . BA.unpack . Crypto.hashWith Crypto.Blake2b_224
|
||||
|
||||
-- | List of users who the effect will pay to.
|
||||
users :: [Credential]
|
||||
users = PubKeyCredential . PubKeyHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])
|
||||
users = userCredentials
|
||||
|
||||
-- | List of users who the effect will pay to.
|
||||
treasuries :: [Credential]
|
||||
treasuries = ScriptCredential . ValidatorHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])
|
||||
treasuries = scriptCredentials
|
||||
|
||||
inputGAT :: TxInInfo
|
||||
inputGAT =
|
||||
|
|
|
|||
|
|
@ -8,17 +8,6 @@ This module tests primarily the happy path for Proposal interactions
|
|||
module Sample.Proposal (
|
||||
-- * Script contexts
|
||||
proposalCreation,
|
||||
cosignProposal,
|
||||
proposalRef,
|
||||
stakeRef,
|
||||
voteOnProposal,
|
||||
VotingParameters (..),
|
||||
advanceProposalSuccess,
|
||||
advanceProposalFailureTimeout,
|
||||
TransitionParameters (..),
|
||||
advanceFinishedProposal,
|
||||
advanceProposalInsufficientVotes,
|
||||
advanceProposalWithInvalidOutputStake,
|
||||
) where
|
||||
|
||||
import Agora.Governor (GovernorDatum (..))
|
||||
|
|
@ -27,78 +16,41 @@ import Agora.Proposal (
|
|||
ProposalDatum (..),
|
||||
ProposalId (..),
|
||||
ProposalStatus (..),
|
||||
ProposalThresholds (..),
|
||||
ProposalVotes (..),
|
||||
ResultTag (..),
|
||||
emptyVotesFor,
|
||||
)
|
||||
import Agora.Proposal.Time (
|
||||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (..),
|
||||
)
|
||||
import Agora.Stake (
|
||||
ProposalLock (ProposalLock),
|
||||
Stake (..),
|
||||
StakeDatum (..),
|
||||
)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Context (
|
||||
BaseBuilder,
|
||||
MintingBuilder,
|
||||
buildMintingUnsafe,
|
||||
buildTxInfoUnsafe,
|
||||
input,
|
||||
mint,
|
||||
output,
|
||||
script,
|
||||
signedWith,
|
||||
timeRange,
|
||||
txId,
|
||||
withDatum,
|
||||
withRefIndex,
|
||||
withTxId,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1 (
|
||||
Datum (Datum),
|
||||
DatumHash,
|
||||
POSIXTime,
|
||||
POSIXTimeRange,
|
||||
PubKeyHash,
|
||||
ScriptContext (..),
|
||||
ToData (toBuiltinData),
|
||||
TxInInfo (TxInInfo),
|
||||
TxInfo (..),
|
||||
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
|
||||
TxOutRef (..),
|
||||
ValidatorHash,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||
assetClassValue,
|
||||
singleton,
|
||||
)
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal.Shared (proposalRef, stakeRef)
|
||||
import Sample.Shared (
|
||||
govValidatorHash,
|
||||
minAda,
|
||||
proposal,
|
||||
proposalPolicySymbol,
|
||||
proposalStartingTimeFromTimeRange,
|
||||
proposalValidatorHash,
|
||||
signer,
|
||||
signer2,
|
||||
stake,
|
||||
stakeAddress,
|
||||
stakeAssetClass,
|
||||
stakeValidatorHash,
|
||||
)
|
||||
import Test.Util (
|
||||
closedBoundedInterval,
|
||||
datumPair,
|
||||
toDatumHash,
|
||||
updateMap,
|
||||
)
|
||||
|
||||
proposalCreation :: ScriptContext
|
||||
|
|
@ -160,656 +112,3 @@ proposalCreation =
|
|||
. withDatum govAfter
|
||||
]
|
||||
in buildMintingUnsafe builder
|
||||
|
||||
-- | 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 = def
|
||||
, 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)
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||
, mint st
|
||||
, mconcat $ signedWith <$> newSigners
|
||||
, timeRange validTimeRange
|
||||
, input $
|
||||
script proposalValidatorHash
|
||||
. withValue (st <> Value.singleton "" "" 10_000_000)
|
||||
. withDatum proposalBefore
|
||||
. withTxId (txOutRefId proposalRef)
|
||||
. withRefIndex (txOutRefIdx proposalRef)
|
||||
, input $
|
||||
script stakeValidatorHash
|
||||
. withValue
|
||||
( Value.singleton "" "" 10_000_000
|
||||
<> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
|
||||
<> Value.assetClassValue stakeAssetClass 1
|
||||
)
|
||||
. withDatum stakeDatum
|
||||
. withTxId (txOutRefId stakeRef)
|
||||
. withRefIndex (txOutRefIdx stakeRef)
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue (st <> Value.singleton "" "" 10_000_000)
|
||||
. withDatum proposalAfter
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue
|
||||
( Value.singleton "" "" 10_000_000
|
||||
<> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
|
||||
<> Value.assetClassValue stakeAssetClass 1
|
||||
)
|
||||
. withDatum stakeDatum
|
||||
]
|
||||
in buildTxInfoUnsafe builder
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | 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 = def
|
||||
, votes = ProposalVotes initialVotes
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
updatedVotes :: AssocMap.Map ResultTag Integer
|
||||
updatedVotes = updateMap (Just . (+ params.voteCount)) params.voteFor initialVotes
|
||||
|
||||
---
|
||||
|
||||
proposalOutputDatum :: ProposalDatum
|
||||
proposalOutputDatum =
|
||||
proposalInputDatum
|
||||
{ votes = ProposalVotes updatedVotes
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
-- Off-chain code should do exactly like this: prepend new lock toStatus the list.
|
||||
updatedLocks :: [ProposalLock]
|
||||
updatedLocks = ProposalLock params.voteFor proposalInputDatum.proposalId : existingLocks
|
||||
|
||||
---
|
||||
|
||||
stakeOutputDatum :: StakeDatum
|
||||
stakeOutputDatum =
|
||||
stakeInputDatum
|
||||
{ lockedBy = updatedLocks
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
((def :: ProposalTimingConfig).draftTime + 1)
|
||||
((def :: ProposalTimingConfig).votingTime - 1)
|
||||
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
|
||||
, signedWith stakeOwner
|
||||
, timeRange validTimeRange
|
||||
, input $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalInputDatum
|
||||
. withTxId (txOutRefId proposalRef)
|
||||
. withRefIndex (txOutRefIdx proposalRef)
|
||||
, input $
|
||||
script stakeValidatorHash
|
||||
. withValue
|
||||
( sst
|
||||
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
|
||||
<> minAda
|
||||
)
|
||||
. withDatum stakeInputDatum
|
||||
. withTxId (txOutRefId stakeRef)
|
||||
. withRefIndex (txOutRefIdx stakeRef)
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalOutputDatum
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue
|
||||
( sst
|
||||
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
|
||||
<> minAda
|
||||
)
|
||||
. withDatum stakeOutputDatum
|
||||
]
|
||||
in buildTxInfoUnsafe builder
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Parameters for state transition of proposals.
|
||||
data TransitionParameters = TransitionParameters
|
||||
{ -- The initial status of the proposal.
|
||||
initialProposalStatus :: ProposalStatus
|
||||
, -- The starting time of the proposal.
|
||||
proposalStartingTime :: ProposalStartingTime
|
||||
}
|
||||
|
||||
-- | Create a 'TxInfo' that update the status of a proposal.
|
||||
mkTransitionTxInfo ::
|
||||
-- | Initial state of the proposal.
|
||||
ProposalStatus ->
|
||||
-- | Next state of the proposal.
|
||||
ProposalStatus ->
|
||||
-- | Effects.
|
||||
AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) ->
|
||||
-- | Votes.
|
||||
ProposalVotes ->
|
||||
-- | Starting time of the proposal.
|
||||
ProposalStartingTime ->
|
||||
-- | Valid time range of the transaction.
|
||||
POSIXTimeRange ->
|
||||
-- | Whether to add an unchanged stake or not.
|
||||
Bool ->
|
||||
TxInfo
|
||||
mkTransitionTxInfo from to effects votes startingTime validTime shouldAddUnchangedStake =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
proposalInputDatum :: ProposalDatum
|
||||
proposalInputDatum =
|
||||
ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects = effects
|
||||
, status = from
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes = votes
|
||||
, timingConfig = def
|
||||
, startingTime = startingTime
|
||||
}
|
||||
|
||||
proposalOutputDatum :: ProposalDatum
|
||||
proposalOutputDatum =
|
||||
proposalInputDatum
|
||||
{ status = to
|
||||
}
|
||||
|
||||
stakeOwner = signer
|
||||
stakedAmount = 200
|
||||
|
||||
existingLocks :: [ProposalLock]
|
||||
existingLocks =
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
|
||||
stakeInputDatum :: StakeDatum
|
||||
stakeInputDatum =
|
||||
StakeDatum
|
||||
{ stakedAmount = Tagged stakedAmount
|
||||
, owner = stakeOwner
|
||||
, lockedBy = existingLocks
|
||||
}
|
||||
|
||||
stakeOutputDatum :: StakeDatum
|
||||
stakeOutputDatum = stakeInputDatum
|
||||
|
||||
stakeBuilder :: BaseBuilder
|
||||
stakeBuilder =
|
||||
if shouldAddUnchangedStake
|
||||
then
|
||||
mconcat
|
||||
[ input $
|
||||
script stakeValidatorHash
|
||||
. withValue sst
|
||||
. withDatum stakeInputDatum
|
||||
. withTxId (txOutRefId stakeRef)
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue (sst <> minAda)
|
||||
. withDatum stakeOutputDatum
|
||||
]
|
||||
else mempty
|
||||
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
|
||||
, signedWith stakeOwner
|
||||
, timeRange validTime
|
||||
, input $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalInputDatum
|
||||
. withTxId (txOutRefId proposalRef)
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue (pst <> minAda)
|
||||
. withDatum proposalOutputDatum
|
||||
]
|
||||
in buildTxInfoUnsafe $ builder <> stakeBuilder
|
||||
|
||||
-- | Wrapper around 'advanceProposalSuccess'', with valid stake.
|
||||
advanceProposalSuccess :: TransitionParameters -> TxInfo
|
||||
advanceProposalSuccess ps = advanceProposalSuccess' ps True
|
||||
|
||||
{- | Create a valid 'TxInfo' that advances a proposal, given the parameters.
|
||||
The second parameter determines wherther valid stake should be included.
|
||||
|
||||
Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'.
|
||||
-}
|
||||
advanceProposalSuccess' :: TransitionParameters -> Bool -> TxInfo
|
||||
advanceProposalSuccess' params =
|
||||
let -- Status of the output proposal.
|
||||
toStatus :: ProposalStatus
|
||||
toStatus = case params.initialProposalStatus of
|
||||
Draft -> VotingReady
|
||||
VotingReady -> Locked
|
||||
Locked -> Finished
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
|
||||
effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
emptyVotes@(ProposalVotes emptyVotes') = emptyVotesFor effects
|
||||
|
||||
-- Set the vote count of outcome 0 to @def.countingVoting + 1@,
|
||||
-- meaning that outcome 0 will be the winner.
|
||||
outcome0WinningVotes =
|
||||
ProposalVotes $
|
||||
updateMap
|
||||
(\_ -> Just $ untag (def :: ProposalThresholds).execute + 1)
|
||||
(ResultTag 0)
|
||||
emptyVotes'
|
||||
|
||||
votes :: ProposalVotes
|
||||
votes = case params.initialProposalStatus of
|
||||
Draft -> emptyVotes
|
||||
-- With sufficient votes
|
||||
_ -> outcome0WinningVotes
|
||||
|
||||
proposalStartingTime :: POSIXTime
|
||||
proposalStartingTime =
|
||||
let (ProposalStartingTime startingTime) = params.proposalStartingTime
|
||||
in startingTime
|
||||
|
||||
timeRange :: POSIXTimeRange
|
||||
timeRange = case params.initialProposalStatus of
|
||||
-- [S + 1, S + D - 1]
|
||||
Draft ->
|
||||
closedBoundedInterval
|
||||
(proposalStartingTime + 1)
|
||||
(proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1)
|
||||
-- [S + D + V + 1, S + D + V + L - 1]
|
||||
VotingReady ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
- 1
|
||||
)
|
||||
-- [S + D + V + L + 1, S + + D + V + L + E - 1]
|
||||
Locked ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime - 1
|
||||
)
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
in mkTransitionTxInfo
|
||||
params.initialProposalStatus
|
||||
toStatus
|
||||
effects
|
||||
votes
|
||||
params.proposalStartingTime
|
||||
timeRange
|
||||
|
||||
{- | Create a valid 'TxInfo' that advances a proposal to failed state, given the parameters.
|
||||
The reason why the proposal fails is the proposal has ran out of time.
|
||||
Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'.
|
||||
-}
|
||||
advanceProposalFailureTimeout :: TransitionParameters -> TxInfo
|
||||
advanceProposalFailureTimeout params =
|
||||
let effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
emptyVotes@(ProposalVotes emptyVotes') = emptyVotesFor effects
|
||||
|
||||
-- Set the vote count of outcome 0 to @def.countingVoting + 1@,
|
||||
-- meaning that outcome 0 will be the winner.
|
||||
outcome0WinningVotes =
|
||||
ProposalVotes $
|
||||
updateMap
|
||||
(\_ -> Just $ untag (def :: ProposalThresholds).vote + 1)
|
||||
(ResultTag 0)
|
||||
emptyVotes'
|
||||
|
||||
votes :: ProposalVotes
|
||||
votes = case params.initialProposalStatus of
|
||||
Draft -> emptyVotes
|
||||
-- With sufficient votes
|
||||
_ -> outcome0WinningVotes
|
||||
|
||||
proposalStartingTime :: POSIXTime
|
||||
proposalStartingTime =
|
||||
let (ProposalStartingTime startingTime) = params.proposalStartingTime
|
||||
in startingTime
|
||||
|
||||
timeRange :: POSIXTimeRange
|
||||
timeRange = case params.initialProposalStatus of
|
||||
-- [S + D + 1, S + D + V - 1]
|
||||
Draft ->
|
||||
closedBoundedInterval
|
||||
(proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime - 1
|
||||
)
|
||||
-- [S + D + V + L + 1, S + D + V + L + E -1]
|
||||
VotingReady ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
- 1
|
||||
)
|
||||
-- [S + D + V + L + E + 1, S + D + V + L + E + 100]
|
||||
Locked ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
+ 100
|
||||
)
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
in mkTransitionTxInfo
|
||||
params.initialProposalStatus
|
||||
Finished
|
||||
effects
|
||||
votes
|
||||
params.proposalStartingTime
|
||||
timeRange
|
||||
True
|
||||
|
||||
-- | An invalid 'TxInfo' that tries to advance a 'VotingReady' proposal without sufficient votes.
|
||||
advanceProposalInsufficientVotes :: TxInfo
|
||||
advanceProposalInsufficientVotes =
|
||||
let effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
-- Insufficient votes.
|
||||
votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 1)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
)
|
||||
|
||||
proposalStartingTime = 0
|
||||
|
||||
-- Valid time range.
|
||||
-- [S + D + 1, S + V + 10]
|
||||
timeRange =
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ 10
|
||||
)
|
||||
in mkTransitionTxInfo
|
||||
VotingReady
|
||||
Locked
|
||||
effects
|
||||
votes
|
||||
(ProposalStartingTime proposalStartingTime)
|
||||
timeRange
|
||||
True
|
||||
|
||||
-- | An invalid 'TxInfo' that tries to advance a 'Finished' proposal.
|
||||
advanceFinishedProposal :: TxInfo
|
||||
advanceFinishedProposal =
|
||||
let effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
-- Set the vote count of outcome 0 to @def.countingVoting + 1@,
|
||||
-- meaning that outcome 0 will be the winner.
|
||||
outcome0WinningVotes =
|
||||
ProposalVotes $
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, untag (def :: ProposalThresholds).vote + 1)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
timeRange =
|
||||
closedBoundedInterval
|
||||
((def :: ProposalTimingConfig).lockingTime + 1)
|
||||
((def :: ProposalTimingConfig).executingTime - 1)
|
||||
in mkTransitionTxInfo
|
||||
Finished
|
||||
Finished
|
||||
effects
|
||||
outcome0WinningVotes
|
||||
(ProposalStartingTime 0)
|
||||
timeRange
|
||||
True
|
||||
|
||||
{- | An illegal 'TxInfo' that tries to output a changed stake with 'AdvanceProposal'.
|
||||
From the perspective of stake validator, the transition is totally valid,
|
||||
so the proposal validator should reject this.
|
||||
-}
|
||||
advanceProposalWithInvalidOutputStake :: TxInfo
|
||||
advanceProposalWithInvalidOutputStake =
|
||||
let templateTxInfo =
|
||||
advanceProposalSuccess'
|
||||
TransitionParameters
|
||||
{ initialProposalStatus = VotingReady
|
||||
, proposalStartingTime = ProposalStartingTime 0
|
||||
}
|
||||
False
|
||||
|
||||
---
|
||||
-- Now we create a new lock on an arbitrary stake
|
||||
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
stakeOwner = signer
|
||||
stakedAmount = 200
|
||||
|
||||
---
|
||||
|
||||
existingLocks :: [ProposalLock]
|
||||
existingLocks =
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
stakeInputDatum' :: StakeDatum
|
||||
stakeInputDatum' =
|
||||
StakeDatum
|
||||
{ stakedAmount = Tagged stakedAmount
|
||||
, owner = stakeOwner
|
||||
, lockedBy = existingLocks
|
||||
}
|
||||
stakeInputDatum :: Datum
|
||||
stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
|
||||
stakeInput :: TxOut
|
||||
stakeInput =
|
||||
TxOut
|
||||
{ txOutAddress = stakeAddress
|
||||
, txOutValue =
|
||||
mconcat
|
||||
[ sst
|
||||
, Value.assetClassValue (untag stake.gtClassRef) stakedAmount
|
||||
, minAda
|
||||
]
|
||||
, txOutDatumHash = Just $ toDatumHash stakeInputDatum
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
updatedLocks :: [ProposalLock]
|
||||
updatedLocks = ProposalLock (ResultTag 42) (ProposalId 27) : existingLocks
|
||||
|
||||
---
|
||||
|
||||
stakeOutputDatum' :: StakeDatum
|
||||
stakeOutputDatum' =
|
||||
stakeInputDatum'
|
||||
{ lockedBy = updatedLocks
|
||||
}
|
||||
stakeOutputDatum :: Datum
|
||||
stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
|
||||
stakeOutput :: TxOut
|
||||
stakeOutput =
|
||||
stakeInput
|
||||
{ txOutDatumHash = Just $ toDatumHash stakeOutputDatum
|
||||
}
|
||||
in templateTxInfo
|
||||
{ txInfoInputs = TxInInfo stakeRef stakeInput : templateTxInfo.txInfoInputs
|
||||
, txInfoOutputs = stakeOutput : templateTxInfo.txInfoOutputs
|
||||
, txInfoData =
|
||||
(datumPair <$> [stakeInputDatum, stakeOutputDatum])
|
||||
<> templateTxInfo.txInfoData
|
||||
, txInfoSignatories = [stakeOwner]
|
||||
}
|
||||
|
|
|
|||
509
agora-specs/Sample/Proposal/Advance.hs
Normal file
509
agora-specs/Sample/Proposal/Advance.hs
Normal file
|
|
@ -0,0 +1,509 @@
|
|||
module Sample.Proposal.Advance (
|
||||
advanceToNextStateInTimeParameters,
|
||||
advanceToFailedStateDueToTimeoutParameters,
|
||||
insufficientVotesParameters,
|
||||
insufficientCosignsParameters,
|
||||
advanceFromFinishedParameters,
|
||||
invalidOutputStakeParameters,
|
||||
mkTestTree,
|
||||
Parameters (..),
|
||||
) where
|
||||
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
ProposalId (ProposalId),
|
||||
ProposalRedeemer (AdvanceProposal),
|
||||
ProposalStatus (..),
|
||||
ProposalThresholds (..),
|
||||
ProposalVotes (ProposalVotes),
|
||||
ResultTag (ResultTag),
|
||||
emptyVotesFor,
|
||||
)
|
||||
import Agora.Proposal.Scripts (proposalValidator)
|
||||
import Agora.Proposal.Time (
|
||||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (
|
||||
draftTime,
|
||||
executingTime,
|
||||
lockingTime,
|
||||
votingTime
|
||||
),
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
ProposalLock (ProposalLock),
|
||||
Stake (gtClassRef),
|
||||
StakeDatum (..),
|
||||
StakeRedeemer (WitnessStake),
|
||||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default (def)
|
||||
import Data.List (sort)
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Context (
|
||||
BaseBuilder,
|
||||
buildTxInfoUnsafe,
|
||||
input,
|
||||
output,
|
||||
script,
|
||||
signedWith,
|
||||
timeRange,
|
||||
txId,
|
||||
withDatum,
|
||||
withOutRef,
|
||||
withTxId,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1 (
|
||||
DatumHash,
|
||||
POSIXTime,
|
||||
POSIXTimeRange,
|
||||
PubKeyHash,
|
||||
ScriptContext (ScriptContext),
|
||||
ScriptPurpose (Spending),
|
||||
TxInfo,
|
||||
TxOutRef (TxOutRef),
|
||||
ValidatorHash,
|
||||
always,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
|
||||
import Sample.Shared (
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalValidatorHash,
|
||||
stake,
|
||||
stakeAssetClass,
|
||||
stakeValidatorHash,
|
||||
)
|
||||
import Sample.Shared qualified as Shared
|
||||
import Test.Specification (SpecificationTree, group)
|
||||
import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue, updateMap)
|
||||
|
||||
-- | Parameters for state transition of proposals.
|
||||
data Parameters = Parameters
|
||||
{ fromStatus :: ProposalStatus
|
||||
-- ^ Initial state of the proposal.
|
||||
, toStatus :: ProposalStatus
|
||||
-- ^ Next state of the proposal.
|
||||
, votes :: ProposalVotes
|
||||
-- ^ Votes.
|
||||
, includeAllStakes :: Bool
|
||||
-- ^ Whether to add an extra cosigner without stake or not.
|
||||
, validTimeRange :: POSIXTimeRange
|
||||
-- ^ Valid time range of the transaction.
|
||||
, alterOutputStakes :: Bool
|
||||
-- ^ Whether to alter th output stakes or not.
|
||||
, stakeCount :: Integer
|
||||
-- ^ The number of stakes.
|
||||
, signByAllCosigners :: Bool
|
||||
, perStakeGTs :: Tagged GTTag Integer
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
proposalRef :: TxOutRef
|
||||
proposalRef = TxOutRef proposalTxRef 1
|
||||
|
||||
mkStakeRef :: Int -> TxOutRef
|
||||
mkStakeRef = TxOutRef stakeTxRef . (+ 2) . fromIntegral
|
||||
|
||||
---
|
||||
|
||||
defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
|
||||
defEffects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
emptyVotes :: ProposalVotes
|
||||
emptyVotes = emptyVotesFor defEffects
|
||||
|
||||
proposalStartingTime :: POSIXTime
|
||||
proposalStartingTime = 0
|
||||
|
||||
---
|
||||
|
||||
mkProposalInputDatum :: Parameters -> ProposalDatum
|
||||
mkProposalInputDatum ps =
|
||||
ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects = defEffects
|
||||
, status = ps.fromStatus
|
||||
, cosigners = mkStakeOwners ps
|
||||
, thresholds = def
|
||||
, votes = ps.votes
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime proposalStartingTime
|
||||
}
|
||||
|
||||
mkStakeInputDatums :: Parameters -> [StakeDatum]
|
||||
mkStakeInputDatums ps =
|
||||
map
|
||||
( \pk ->
|
||||
StakeDatum
|
||||
{ stakedAmount = ps.perStakeGTs
|
||||
, owner = pk
|
||||
, lockedBy = existingLocks
|
||||
}
|
||||
)
|
||||
$ mkStakeOwners ps
|
||||
where
|
||||
existingLocks :: [ProposalLock]
|
||||
existingLocks =
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
proposalScriptPurpose :: ScriptPurpose
|
||||
proposalScriptPurpose = Spending proposalRef
|
||||
|
||||
mkStakeScriptPurpose :: Int -> ScriptPurpose
|
||||
mkStakeScriptPurpose = Spending . mkStakeRef
|
||||
|
||||
---
|
||||
|
||||
proposalRedeemer :: ProposalRedeemer
|
||||
proposalRedeemer = AdvanceProposal
|
||||
|
||||
stakeRedeemer :: StakeRedeemer
|
||||
stakeRedeemer = WitnessStake
|
||||
|
||||
---
|
||||
|
||||
mkStakeOwners :: Parameters -> [PubKeyHash]
|
||||
mkStakeOwners ps =
|
||||
sort $
|
||||
take
|
||||
(fromIntegral ps.stakeCount)
|
||||
pubKeyHashes
|
||||
|
||||
---
|
||||
|
||||
-- | Create a 'TxInfo' that update the status of a proposal.
|
||||
advance ::
|
||||
Parameters ->
|
||||
TxInfo
|
||||
advance ps =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
proposalInputDatum :: ProposalDatum
|
||||
proposalInputDatum =
|
||||
mkProposalInputDatum ps
|
||||
|
||||
proposalOutputDatum :: ProposalDatum
|
||||
proposalOutputDatum =
|
||||
proposalInputDatum
|
||||
{ status = ps.toStatus
|
||||
}
|
||||
|
||||
stakeInputDatums :: [StakeDatum]
|
||||
stakeInputDatums = mkStakeInputDatums ps
|
||||
|
||||
mkStakeOutputDatum :: StakeDatum -> StakeDatum
|
||||
mkStakeOutputDatum si =
|
||||
if ps.alterOutputStakes
|
||||
then
|
||||
si
|
||||
{ stakedAmount = ps.perStakeGTs + 1
|
||||
}
|
||||
else si
|
||||
|
||||
stakeValue =
|
||||
let gts =
|
||||
if ps.perStakeGTs == 0
|
||||
then mempty
|
||||
else
|
||||
Value.assetClassValue
|
||||
(untag stake.gtClassRef)
|
||||
(untag ps.perStakeGTs)
|
||||
in sortValue $
|
||||
sst <> minAda
|
||||
<> gts
|
||||
|
||||
stakeBuilder :: BaseBuilder
|
||||
stakeBuilder =
|
||||
foldMap
|
||||
( \(si, idx) ->
|
||||
let so = mkStakeOutputDatum si
|
||||
in mconcat @BaseBuilder
|
||||
[ input $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum si
|
||||
. withOutRef (mkStakeRef idx)
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum so
|
||||
]
|
||||
)
|
||||
$ let withIds = zip stakeInputDatums [0 ..]
|
||||
in if ps.includeAllStakes
|
||||
then withIds
|
||||
else [head withIds]
|
||||
|
||||
signBuilder :: BaseBuilder
|
||||
signBuilder =
|
||||
let sos = mkStakeOwners ps
|
||||
in if ps.signByAllCosigners
|
||||
then foldMap signedWith sos
|
||||
else signedWith $ head sos
|
||||
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
|
||||
, signBuilder
|
||||
, timeRange ps.validTimeRange
|
||||
, input $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalInputDatum
|
||||
. withTxId proposalTxRef
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue (pst <> minAda)
|
||||
. withDatum proposalOutputDatum
|
||||
]
|
||||
in buildTxInfoUnsafe $ builder <> stakeBuilder
|
||||
|
||||
---
|
||||
|
||||
mkInTimeTimeRange :: ProposalStatus -> POSIXTimeRange
|
||||
mkInTimeTimeRange advanceFrom =
|
||||
case advanceFrom of
|
||||
-- [S + 1, S + D - 1]
|
||||
Draft ->
|
||||
closedBoundedInterval
|
||||
(proposalStartingTime + 1)
|
||||
(proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1)
|
||||
-- [S + D + V + 1, S + D + V + L - 1]
|
||||
VotingReady ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
- 1
|
||||
)
|
||||
-- [S + D + V + L + 1, S + + D + V + L + E - 1]
|
||||
Locked ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime - 1
|
||||
)
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
|
||||
mkTooLateTimeRange :: ProposalStatus -> POSIXTimeRange
|
||||
mkTooLateTimeRange advanceFrom =
|
||||
case advanceFrom of
|
||||
-- [S + D + 1, S + D + V - 1]
|
||||
Draft ->
|
||||
closedBoundedInterval
|
||||
(proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime - 1
|
||||
)
|
||||
-- [S + D + V + L + 1, S + D + V + L + E -1]
|
||||
VotingReady ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
- 1
|
||||
)
|
||||
-- [S + D + V + L + E + 1, S + D + V + L + E + 100]
|
||||
Locked ->
|
||||
closedBoundedInterval
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
+ 1
|
||||
)
|
||||
( proposalStartingTime
|
||||
+ (def :: ProposalTimingConfig).draftTime
|
||||
+ (def :: ProposalTimingConfig).votingTime
|
||||
+ (def :: ProposalTimingConfig).lockingTime
|
||||
+ (def :: ProposalTimingConfig).executingTime
|
||||
+ 100
|
||||
)
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
|
||||
---
|
||||
|
||||
getNextState :: ProposalStatus -> ProposalStatus
|
||||
getNextState = \case
|
||||
Draft -> VotingReady
|
||||
VotingReady -> Locked
|
||||
Locked -> Finished
|
||||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
|
||||
---
|
||||
|
||||
advanceToNextStateInTimeParameters :: Int -> [Parameters]
|
||||
advanceToNextStateInTimeParameters nCosigners =
|
||||
map
|
||||
( \from ->
|
||||
let -- Set the vote count of outcome 0 to @def.countingVoting + 1@,
|
||||
-- meaning that outcome 0 will be the winner.
|
||||
outcome0WinningVotes =
|
||||
ProposalVotes $
|
||||
updateMap
|
||||
(\_ -> Just $ untag (def :: ProposalThresholds).execute + 1)
|
||||
(ResultTag 0)
|
||||
(coerce emptyVotes)
|
||||
|
||||
votes = case from of
|
||||
Draft -> emptyVotes
|
||||
-- With sufficient votes
|
||||
_ -> outcome0WinningVotes
|
||||
|
||||
includeAllStakes = case from of
|
||||
Draft -> True
|
||||
_ -> False
|
||||
|
||||
signByAllCosigners = case from of
|
||||
Draft -> True
|
||||
_ -> False
|
||||
in Parameters
|
||||
{ fromStatus = from
|
||||
, toStatus = getNextState from
|
||||
, votes = votes
|
||||
, includeAllStakes = includeAllStakes
|
||||
, validTimeRange = mkInTimeTimeRange from
|
||||
, alterOutputStakes = False
|
||||
, stakeCount = fromIntegral nCosigners
|
||||
, signByAllCosigners = signByAllCosigners
|
||||
, perStakeGTs =
|
||||
(def :: ProposalThresholds).vote
|
||||
`div` fromIntegral nCosigners + 1
|
||||
}
|
||||
)
|
||||
[Draft, VotingReady, Locked]
|
||||
|
||||
advanceToFailedStateDueToTimeoutParameters :: Int -> [Parameters]
|
||||
advanceToFailedStateDueToTimeoutParameters nCosigners =
|
||||
map
|
||||
( \from ->
|
||||
Parameters
|
||||
{ fromStatus = from
|
||||
, toStatus = Finished
|
||||
, votes = emptyVotes
|
||||
, includeAllStakes = False
|
||||
, validTimeRange = mkTooLateTimeRange from
|
||||
, alterOutputStakes = False
|
||||
, stakeCount = fromIntegral nCosigners
|
||||
, signByAllCosigners = False
|
||||
, perStakeGTs = 1
|
||||
}
|
||||
)
|
||||
[Draft, VotingReady, Locked]
|
||||
|
||||
insufficientVotesParameters :: Parameters
|
||||
insufficientVotesParameters =
|
||||
let votes = emptyVotes
|
||||
from = VotingReady
|
||||
to = getNextState from
|
||||
in Parameters
|
||||
{ fromStatus = from
|
||||
, toStatus = to
|
||||
, votes = votes
|
||||
, includeAllStakes = False
|
||||
, validTimeRange = mkInTimeTimeRange from
|
||||
, alterOutputStakes = False
|
||||
, stakeCount = 1
|
||||
, signByAllCosigners = True
|
||||
, perStakeGTs = 20
|
||||
}
|
||||
|
||||
insufficientCosignsParameters :: Int -> Parameters
|
||||
insufficientCosignsParameters nCosigners =
|
||||
(\ps -> ps {perStakeGTs = 0}) $
|
||||
head $
|
||||
advanceToNextStateInTimeParameters nCosigners
|
||||
|
||||
advanceFromFinishedParameters :: Parameters
|
||||
advanceFromFinishedParameters =
|
||||
Parameters
|
||||
{ fromStatus = Finished
|
||||
, toStatus = Finished
|
||||
, votes = emptyVotes
|
||||
, includeAllStakes = False
|
||||
, validTimeRange = always
|
||||
, alterOutputStakes = False
|
||||
, stakeCount = 1
|
||||
, signByAllCosigners = True
|
||||
, perStakeGTs = 20
|
||||
}
|
||||
|
||||
invalidOutputStakeParameters :: Int -> [Parameters]
|
||||
invalidOutputStakeParameters nCosigners =
|
||||
(\ps -> ps {alterOutputStakes = True})
|
||||
<$> advanceToNextStateInTimeParameters nCosigners
|
||||
|
||||
---
|
||||
|
||||
mkTestTree :: String -> Parameters -> Bool -> SpecificationTree
|
||||
mkTestTree name ps isValidForProposalValidator = group name [proposal, stake]
|
||||
where
|
||||
txInfo = advance ps
|
||||
|
||||
proposal =
|
||||
let proposalInputDatum = mkProposalInputDatum ps
|
||||
in testFunc
|
||||
isValidForProposalValidator
|
||||
"propsoal"
|
||||
(proposalValidator Shared.proposal)
|
||||
proposalInputDatum
|
||||
proposalRedeemer
|
||||
( ScriptContext
|
||||
txInfo
|
||||
proposalScriptPurpose
|
||||
)
|
||||
|
||||
stake =
|
||||
let idx = 0
|
||||
stakeInputDatum = mkStakeInputDatums ps !! idx
|
||||
isValid = not $ ps.alterOutputStakes
|
||||
in testFunc
|
||||
isValid
|
||||
"stake"
|
||||
(stakeValidator Shared.stake)
|
||||
stakeInputDatum
|
||||
stakeRedeemer
|
||||
( ScriptContext
|
||||
txInfo
|
||||
(mkStakeScriptPurpose idx)
|
||||
)
|
||||
344
agora-specs/Sample/Proposal/Cosign.hs
Normal file
344
agora-specs/Sample/Proposal/Cosign.hs
Normal file
|
|
@ -0,0 +1,344 @@
|
|||
module Sample.Proposal.Cosign (
|
||||
Parameters (..),
|
||||
validCosignNParameters,
|
||||
duplicateCosignersParameters,
|
||||
statusNotDraftCosignNParameters,
|
||||
invalidStakeOutputParameters,
|
||||
mkTestTree,
|
||||
) where
|
||||
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
ProposalId (ProposalId),
|
||||
ProposalRedeemer (Cosign),
|
||||
ProposalStatus (..),
|
||||
ResultTag (ResultTag),
|
||||
emptyVotesFor,
|
||||
)
|
||||
import Agora.Proposal.Scripts (proposalValidator)
|
||||
import Agora.Proposal.Time (
|
||||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (draftTime),
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
Stake (gtClassRef),
|
||||
StakeDatum (StakeDatum, owner),
|
||||
StakeRedeemer (WitnessStake),
|
||||
stakedAmount,
|
||||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default (def)
|
||||
import Data.List (sort)
|
||||
import Data.Tagged (Tagged, untag)
|
||||
import Plutarch.Context (
|
||||
BaseBuilder,
|
||||
buildTxInfoUnsafe,
|
||||
input,
|
||||
output,
|
||||
script,
|
||||
signedWith,
|
||||
timeRange,
|
||||
txId,
|
||||
withDatum,
|
||||
withRefIndex,
|
||||
withTxId,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1 (
|
||||
POSIXTimeRange,
|
||||
PubKeyHash,
|
||||
ScriptContext (ScriptContext),
|
||||
ScriptPurpose (Spending),
|
||||
TxInfo,
|
||||
TxOutRef (..),
|
||||
Value,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
|
||||
import Sample.Shared (
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalValidatorHash,
|
||||
signer,
|
||||
stake,
|
||||
stakeAssetClass,
|
||||
stakeValidatorHash,
|
||||
)
|
||||
import Sample.Shared qualified as Shared
|
||||
import Test.Specification (
|
||||
SpecificationTree,
|
||||
group,
|
||||
)
|
||||
import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue)
|
||||
|
||||
-- | Parameters for cosigning a proposal.
|
||||
data Parameters = Parameters
|
||||
{ newCosigners :: [PubKeyHash]
|
||||
-- ^ New cosigners to be added, and the owners of the generated stakes.
|
||||
, proposalStatus :: ProposalStatus
|
||||
-- ^ Current state of the proposal.
|
||||
, alterOutputStakes :: Bool
|
||||
-- ^ Whether to generate invalid stake outputs.
|
||||
-- In particular, the 'stakedAmount' of all the stake datums will be set to zero.
|
||||
}
|
||||
|
||||
-- | Owner of the creator stake, doesn't really matter in this case.
|
||||
proposalCreator :: PubKeyHash
|
||||
proposalCreator = signer
|
||||
|
||||
-- | The amount of GTs every generated stake has, doesn't really matter in this case.
|
||||
perStakedGTs :: Tagged GTTag Integer
|
||||
perStakedGTs = 5
|
||||
|
||||
{- | Create input proposal datum given the parameters.
|
||||
In particular, 'status' is set to 'proposalStstus'.
|
||||
-}
|
||||
mkProposalInputDatum :: Parameters -> ProposalDatum
|
||||
mkProposalInputDatum ps =
|
||||
let effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
in ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects = effects
|
||||
, status = ps.proposalStatus
|
||||
, cosigners = [proposalCreator]
|
||||
, thresholds = def
|
||||
, votes = emptyVotesFor effects
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
|
||||
{- | Create the output proposal datum given the parameters.
|
||||
The 'newCosigners' is added to the exisiting list of cosigners, note the said list should be sorted in
|
||||
ascending order.
|
||||
-}
|
||||
mkProposalOutputDatum :: Parameters -> ProposalDatum
|
||||
mkProposalOutputDatum ps =
|
||||
let inputDatum = mkProposalInputDatum ps
|
||||
in inputDatum
|
||||
{ cosigners = sort $ inputDatum.cosigners <> ps.newCosigners
|
||||
}
|
||||
|
||||
-- | Create all the input stakes given the parameters.
|
||||
mkStakeInputDatums :: Parameters -> [StakeDatum]
|
||||
mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk []) . newCosigners
|
||||
|
||||
-- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
|
||||
cosign :: Parameters -> TxInfo
|
||||
cosign ps = buildTxInfoUnsafe builder
|
||||
where
|
||||
pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
stakeInputDatums :: [StakeDatum]
|
||||
stakeInputDatums = mkStakeInputDatums ps
|
||||
|
||||
stakeValue :: Value
|
||||
stakeValue =
|
||||
sortValue $
|
||||
minAda
|
||||
<> Value.assetClassValue
|
||||
(untag stake.gtClassRef)
|
||||
(untag perStakedGTs)
|
||||
<> sst
|
||||
|
||||
stakeBuilder :: BaseBuilder
|
||||
stakeBuilder =
|
||||
foldMap
|
||||
( \(stakeDatum, refIdx) ->
|
||||
let stakeOutputDatum =
|
||||
if ps.alterOutputStakes
|
||||
then stakeDatum {stakedAmount = 0}
|
||||
else stakeDatum
|
||||
in mconcat @BaseBuilder
|
||||
[ input $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum stakeDatum
|
||||
. withTxId stakeTxRef
|
||||
. withRefIndex refIdx
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum stakeOutputDatum
|
||||
, signedWith stakeDatum.owner
|
||||
]
|
||||
)
|
||||
$ zip
|
||||
stakeInputDatums
|
||||
[2 ..]
|
||||
|
||||
---
|
||||
|
||||
proposalInputDatum :: ProposalDatum
|
||||
proposalInputDatum = mkProposalInputDatum ps
|
||||
|
||||
proposalOutputDatum :: ProposalDatum
|
||||
proposalOutputDatum = mkProposalOutputDatum ps
|
||||
|
||||
proposalBuilder :: BaseBuilder
|
||||
proposalBuilder =
|
||||
mconcat
|
||||
[ input $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalInputDatum
|
||||
. withTxId proposalTxRef
|
||||
. withRefIndex proposalRefIdx
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue (sortValue (pst <> minAda))
|
||||
. withDatum proposalOutputDatum
|
||||
]
|
||||
|
||||
validTimeRange :: POSIXTimeRange
|
||||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
(coerce proposalInputDatum.startingTime + 1)
|
||||
( coerce proposalInputDatum.startingTime
|
||||
+ proposalInputDatum.timingConfig.draftTime - 1
|
||||
)
|
||||
|
||||
---
|
||||
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "05c67819fc3381a2052b929ab439244b7b5fe3b3bd07f2134055bbbb21bd9e52"
|
||||
, timeRange validTimeRange
|
||||
, proposalBuilder
|
||||
, stakeBuilder
|
||||
]
|
||||
|
||||
-- | Reference index of the proposal UTXO.
|
||||
proposalRefIdx :: Integer
|
||||
proposalRefIdx = 1
|
||||
|
||||
-- | Spend the proposal ST.
|
||||
proposalScriptPurpose :: ScriptPurpose
|
||||
proposalScriptPurpose =
|
||||
Spending
|
||||
( TxOutRef
|
||||
proposalTxRef
|
||||
proposalRefIdx
|
||||
)
|
||||
|
||||
-- | Consume the given stake.
|
||||
mkStakeScriptPurpose :: Int -> ScriptPurpose
|
||||
mkStakeScriptPurpose idx =
|
||||
Spending $
|
||||
TxOutRef
|
||||
stakeTxRef
|
||||
$ proposalRefIdx + 1 + fromIntegral idx
|
||||
|
||||
-- | Create a proposal redeemer which cosigns with the new cosginers.
|
||||
mkProposalRedeemer :: Parameters -> ProposalRedeemer
|
||||
mkProposalRedeemer (sort . newCosigners -> cs) = Cosign cs
|
||||
|
||||
-- | Stake redeemer for cosuming all the stakes generated in the module.
|
||||
stakeRedeemer :: StakeRedeemer
|
||||
stakeRedeemer = WitnessStake
|
||||
|
||||
---
|
||||
|
||||
-- | Create a valid parameters that cosign the proposal with a given number of cosigners.
|
||||
validCosignNParameters :: Int -> Parameters
|
||||
validCosignNParameters n
|
||||
| n > 0 =
|
||||
Parameters
|
||||
{ newCosigners = take n pubKeyHashes
|
||||
, proposalStatus = Draft
|
||||
, alterOutputStakes = False
|
||||
}
|
||||
| otherwise = error "Number of cosigners should be positive"
|
||||
|
||||
---
|
||||
|
||||
{- | Parameters that make 'cosign' yield duplicate cosigners.
|
||||
Invalid for the ptoposal validator, perfectly valid for stake validator.
|
||||
-}
|
||||
duplicateCosignersParameters :: Parameters
|
||||
duplicateCosignersParameters =
|
||||
Parameters
|
||||
{ newCosigners = [proposalCreator]
|
||||
, proposalStatus = Draft
|
||||
, alterOutputStakes = False
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
{- | Generate a list of parameters that sets proposal status to something other than 'Draft'.
|
||||
Invalid for the ptoposal validator, perfectly valid for stake validator.
|
||||
-}
|
||||
statusNotDraftCosignNParameters :: Int -> [Parameters]
|
||||
statusNotDraftCosignNParameters n =
|
||||
map
|
||||
( \st ->
|
||||
Parameters
|
||||
{ newCosigners = take n pubKeyHashes
|
||||
, proposalStatus = st
|
||||
, alterOutputStakes = False
|
||||
}
|
||||
)
|
||||
[VotingReady, Locked, Finished]
|
||||
|
||||
---
|
||||
|
||||
{- | Parameters thet change the output stake datums.
|
||||
Invalid for both proposal validator and stake validator.
|
||||
-}
|
||||
invalidStakeOutputParameters :: Parameters
|
||||
invalidStakeOutputParameters =
|
||||
(validCosignNParameters 2)
|
||||
{ alterOutputStakes = True
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
-- | Create a test tree given the parameters. Both the proposal validator and stake validator will be run.
|
||||
mkTestTree ::
|
||||
-- | The name of the test group.
|
||||
String ->
|
||||
Parameters ->
|
||||
-- | Are the parameters valid for the proposal validator?
|
||||
Bool ->
|
||||
SpecificationTree
|
||||
mkTestTree name ps isValid = group name [proposal, stake]
|
||||
where
|
||||
txInfo = cosign ps
|
||||
|
||||
proposal =
|
||||
let proposalInputDatum = mkProposalInputDatum ps
|
||||
in testFunc
|
||||
isValid
|
||||
"propsoal"
|
||||
(proposalValidator Shared.proposal)
|
||||
proposalInputDatum
|
||||
(mkProposalRedeemer ps)
|
||||
( ScriptContext
|
||||
txInfo
|
||||
proposalScriptPurpose
|
||||
)
|
||||
|
||||
stake =
|
||||
let idx = 0
|
||||
stakeInputDatum = mkStakeInputDatums ps !! idx
|
||||
isValid = not ps.alterOutputStakes
|
||||
in testFunc
|
||||
isValid
|
||||
"stake"
|
||||
(stakeValidator Shared.stake)
|
||||
stakeInputDatum
|
||||
stakeRedeemer
|
||||
( ScriptContext
|
||||
txInfo
|
||||
(mkStakeScriptPurpose idx)
|
||||
)
|
||||
|
|
@ -1,9 +1,39 @@
|
|||
module Sample.Proposal.Shared (proposalRef, stakeRef) where
|
||||
module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) where
|
||||
|
||||
import PlutusLedgerApi.V1 (TxOutRef (..))
|
||||
import Plutarch.Api.V1 (PValidator)
|
||||
import Plutarch.Lift (PUnsafeLiftDecl (..))
|
||||
import PlutusLedgerApi.V1 (ScriptContext, ToData, TxId)
|
||||
import Test.Specification (
|
||||
SpecificationTree,
|
||||
validatorFailsWith,
|
||||
validatorSucceedsWith,
|
||||
)
|
||||
|
||||
proposalRef :: TxOutRef
|
||||
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
|
||||
-- | 'TxId' of all the propsoal inputs in the samples.
|
||||
proposalTxRef :: TxId
|
||||
proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||
|
||||
stakeRef :: TxOutRef
|
||||
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
|
||||
-- | 'TxId' of all the stake inputs in the samples.
|
||||
stakeTxRef :: TxId
|
||||
stakeTxRef = "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15"
|
||||
|
||||
-- | Get the test function given whether a test case is valid.
|
||||
testFunc ::
|
||||
forall {datum :: PType} {redeemer :: PType}.
|
||||
( PUnsafeLiftDecl datum
|
||||
, PUnsafeLiftDecl redeemer
|
||||
, ToData (PLifted datum)
|
||||
, ToData (PLifted redeemer)
|
||||
) =>
|
||||
-- | Should the validator pass?
|
||||
Bool ->
|
||||
String ->
|
||||
ClosedTerm PValidator ->
|
||||
PLifted datum ->
|
||||
PLifted redeemer ->
|
||||
ScriptContext ->
|
||||
SpecificationTree
|
||||
testFunc isValid =
|
||||
if isValid
|
||||
then validatorSucceedsWith
|
||||
else validatorFailsWith
|
||||
|
|
|
|||
|
|
@ -11,6 +11,33 @@ module Sample.Proposal.UnlockStake (
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
ProposalId (..),
|
||||
ProposalRedeemer (Unlock),
|
||||
ProposalStatus (..),
|
||||
ProposalVotes (..),
|
||||
ResultTag (..),
|
||||
)
|
||||
import Agora.Proposal.Scripts (proposalValidator)
|
||||
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
|
||||
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
|
||||
import Control.Monad (join)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Context (
|
||||
BaseBuilder,
|
||||
buildTxInfoUnsafe,
|
||||
input,
|
||||
output,
|
||||
script,
|
||||
txId,
|
||||
withDatum,
|
||||
withRefIndex,
|
||||
withTxId,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1 (
|
||||
DatumHash,
|
||||
ScriptContext (..),
|
||||
|
|
@ -21,19 +48,7 @@ import PlutusLedgerApi.V1 (
|
|||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
ProposalId (..),
|
||||
ProposalRedeemer (Unlock),
|
||||
ProposalStatus (..),
|
||||
ProposalVotes (..),
|
||||
ResultTag (..),
|
||||
)
|
||||
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
|
||||
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
|
||||
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
|
||||
import Sample.Shared (
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
|
|
@ -43,19 +58,9 @@ import Sample.Shared (
|
|||
stakeAssetClass,
|
||||
stakeValidatorHash,
|
||||
)
|
||||
import Test.Util (sortValue, updateMap)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Agora.Proposal.Scripts (proposalValidator)
|
||||
import Control.Monad (join)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Context (BaseBuilder, buildTxInfoUnsafe, input, output, script, txId, withDatum, withRefIndex, withTxId, withValue)
|
||||
import Sample.Proposal.Shared (proposalRef, stakeRef)
|
||||
import Sample.Shared qualified as Shared
|
||||
import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith)
|
||||
import Test.Specification (SpecificationTree)
|
||||
import Test.Util (sortValue, updateMap)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -223,8 +228,8 @@ unlockStake p =
|
|||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum i
|
||||
. withTxId (txOutRefId proposalRef)
|
||||
. withRefIndex (txOutRefIdx proposalRef + coerce i.proposalId)
|
||||
. withTxId proposalTxRef
|
||||
. withRefIndex (coerce i.proposalId + 2)
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue (sortValue $ pst <> minAda)
|
||||
|
|
@ -249,8 +254,8 @@ unlockStake p =
|
|||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum sInDatum
|
||||
. withTxId (txOutRefId stakeRef)
|
||||
. withRefIndex (txOutRefIdx stakeRef)
|
||||
. withTxId stakeTxRef
|
||||
. withRefIndex 1
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
|
|
@ -271,6 +276,14 @@ mkProposalValidatorTestCase p shouldSucceed =
|
|||
let datum = mkProposalInputDatum p $ ProposalId 0
|
||||
redeemer = Unlock (ResultTag 0)
|
||||
name = show p
|
||||
scriptContext = ScriptContext (unlockStake p) (Spending proposalRef)
|
||||
f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith
|
||||
in f name (proposalValidator Shared.proposal) datum redeemer scriptContext
|
||||
scriptContext =
|
||||
ScriptContext
|
||||
(unlockStake p)
|
||||
(Spending (TxOutRef proposalTxRef 2))
|
||||
in testFunc
|
||||
shouldSucceed
|
||||
name
|
||||
(proposalValidator Shared.proposal)
|
||||
datum
|
||||
redeemer
|
||||
scriptContext
|
||||
|
|
|
|||
249
agora-specs/Sample/Proposal/Vote.hs
Normal file
249
agora-specs/Sample/Proposal/Vote.hs
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
module Sample.Proposal.Vote (
|
||||
validVoteParameters,
|
||||
mkTestTree,
|
||||
) where
|
||||
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
ProposalId (ProposalId),
|
||||
ProposalRedeemer (Vote),
|
||||
ProposalStatus (VotingReady),
|
||||
ProposalVotes (ProposalVotes),
|
||||
ResultTag (ResultTag),
|
||||
)
|
||||
import Agora.Proposal.Scripts (proposalValidator)
|
||||
import Agora.Proposal.Time (
|
||||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (draftTime, votingTime),
|
||||
)
|
||||
import Agora.Stake (
|
||||
ProposalLock (ProposalLock),
|
||||
Stake (gtClassRef),
|
||||
StakeDatum (..),
|
||||
StakeRedeemer (PermitVote),
|
||||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Data.Default (Default (def))
|
||||
import Data.Tagged (Tagged (Tagged), untag)
|
||||
import Plutarch.Context (
|
||||
BaseBuilder,
|
||||
buildTxInfoUnsafe,
|
||||
input,
|
||||
output,
|
||||
script,
|
||||
signedWith,
|
||||
timeRange,
|
||||
txId,
|
||||
withDatum,
|
||||
withOutRef,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1 (
|
||||
PubKeyHash,
|
||||
ScriptContext (..),
|
||||
ScriptPurpose (Spending),
|
||||
TxInfo,
|
||||
TxOutRef (TxOutRef),
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
|
||||
import Sample.Shared (
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalValidatorHash,
|
||||
signer,
|
||||
stake,
|
||||
stakeAssetClass,
|
||||
stakeValidatorHash,
|
||||
)
|
||||
import Sample.Shared qualified as Shared
|
||||
import Test.Specification (
|
||||
SpecificationTree,
|
||||
group,
|
||||
validatorSucceedsWith,
|
||||
)
|
||||
import Test.Util (closedBoundedInterval, sortValue, updateMap)
|
||||
|
||||
proposalRef :: TxOutRef
|
||||
proposalRef = TxOutRef proposalTxRef 0
|
||||
|
||||
stakeRef :: TxOutRef
|
||||
stakeRef = TxOutRef stakeTxRef 1
|
||||
|
||||
-- | Parameters for creating a voting transaction.
|
||||
data Parameters = Parameters
|
||||
{ voteFor :: ResultTag
|
||||
-- ^ The outcome the transaction is voting for.
|
||||
, voteCount :: Integer
|
||||
-- ^ The count of votes.
|
||||
}
|
||||
|
||||
stakeOwner :: PubKeyHash
|
||||
stakeOwner = signer
|
||||
|
||||
initialVotes :: AssocMap.Map ResultTag Integer
|
||||
initialVotes =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 4242)
|
||||
]
|
||||
|
||||
proposalInputDatum :: ProposalDatum
|
||||
proposalInputDatum =
|
||||
ProposalDatum
|
||||
{ proposalId = ProposalId 42
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = VotingReady
|
||||
, cosigners = [stakeOwner]
|
||||
, thresholds = def
|
||||
, votes = ProposalVotes initialVotes
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
|
||||
existingLocks :: [ProposalLock]
|
||||
existingLocks =
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
|
||||
mkStakeInputDatum :: Parameters -> StakeDatum
|
||||
mkStakeInputDatum params =
|
||||
StakeDatum
|
||||
{ stakedAmount = Tagged params.voteCount
|
||||
, owner = stakeOwner
|
||||
, lockedBy = existingLocks
|
||||
}
|
||||
|
||||
mkProposalRedeemer :: Parameters -> ProposalRedeemer
|
||||
mkProposalRedeemer = Vote . voteFor
|
||||
|
||||
mkNewLock :: Parameters -> ProposalLock
|
||||
mkNewLock ps = ProposalLock ps.voteFor proposalInputDatum.proposalId
|
||||
|
||||
mkStakeRedeemer :: Parameters -> StakeRedeemer
|
||||
mkStakeRedeemer = PermitVote . mkNewLock
|
||||
|
||||
-- | Create a valid transaction that votes on a propsal, given the parameters.
|
||||
vote :: Parameters -> TxInfo
|
||||
vote params =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
stakeInputDatum = mkStakeInputDatum params
|
||||
|
||||
---
|
||||
|
||||
updatedVotes :: AssocMap.Map ResultTag Integer
|
||||
updatedVotes = updateMap (Just . (+ params.voteCount)) params.voteFor initialVotes
|
||||
|
||||
---
|
||||
|
||||
proposalOutputDatum :: ProposalDatum
|
||||
proposalOutputDatum =
|
||||
proposalInputDatum
|
||||
{ votes = ProposalVotes updatedVotes
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
-- Off-chain code should do exactly like this: prepend new lock toStatus the list.
|
||||
updatedLocks :: [ProposalLock]
|
||||
updatedLocks = mkNewLock params : existingLocks
|
||||
|
||||
---
|
||||
|
||||
stakeOutputDatum :: StakeDatum
|
||||
stakeOutputDatum =
|
||||
stakeInputDatum
|
||||
{ lockedBy = updatedLocks
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
((def :: ProposalTimingConfig).draftTime + 1)
|
||||
((def :: ProposalTimingConfig).votingTime - 1)
|
||||
|
||||
---
|
||||
|
||||
stakeValue =
|
||||
sortValue $
|
||||
sst
|
||||
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
|
||||
<> minAda
|
||||
|
||||
builder :: BaseBuilder
|
||||
builder =
|
||||
mconcat
|
||||
[ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
|
||||
, signedWith stakeOwner
|
||||
, timeRange validTimeRange
|
||||
, input $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalInputDatum
|
||||
. withOutRef proposalRef
|
||||
, input $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum stakeInputDatum
|
||||
. withOutRef stakeRef
|
||||
, output $
|
||||
script proposalValidatorHash
|
||||
. withValue pst
|
||||
. withDatum proposalOutputDatum
|
||||
, output $
|
||||
script stakeValidatorHash
|
||||
. withValue stakeValue
|
||||
. withDatum stakeOutputDatum
|
||||
]
|
||||
in buildTxInfoUnsafe builder
|
||||
|
||||
---
|
||||
|
||||
validVoteParameters :: Parameters
|
||||
validVoteParameters =
|
||||
Parameters
|
||||
{ voteFor = ResultTag 0
|
||||
, voteCount = 27
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
mkTestTree :: String -> Parameters -> Bool -> SpecificationTree
|
||||
mkTestTree name ps isValid = group name [proposal, stake]
|
||||
where
|
||||
txInfo = vote ps
|
||||
|
||||
proposal =
|
||||
testFunc
|
||||
isValid
|
||||
"propsoal"
|
||||
(proposalValidator Shared.proposal)
|
||||
proposalInputDatum
|
||||
(mkProposalRedeemer ps)
|
||||
( ScriptContext
|
||||
txInfo
|
||||
(Spending proposalRef)
|
||||
)
|
||||
|
||||
stake =
|
||||
let stakeInputDatum = mkStakeInputDatum ps
|
||||
in validatorSucceedsWith
|
||||
"stake"
|
||||
(stakeValidator Shared.stake)
|
||||
stakeInputDatum
|
||||
(mkStakeRedeemer ps)
|
||||
( ScriptContext
|
||||
txInfo
|
||||
(Spending stakeRef)
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue