Merge pull request #136 from Liqwid-Labs/connor/draft-phrase
This commit is contained in:
方泓睿
GitHub
commit
0c61cbc5ed
16 changed files with 2150 additions and 1664 deletions
|
|
@ -23,17 +23,13 @@ import Agora.Effect.TreasuryWithdrawal (
|
||||||
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
|
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
|
||||||
treasuryWithdrawalValidator,
|
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 Plutarch.Api.V1 (mkValidator, validatorHash)
|
||||||
import PlutusLedgerApi.V1 (
|
import PlutusLedgerApi.V1 (
|
||||||
Address (Address),
|
Address (Address),
|
||||||
Credential (..),
|
Credential (..),
|
||||||
CurrencySymbol (CurrencySymbol),
|
CurrencySymbol (CurrencySymbol),
|
||||||
DatumHash (DatumHash),
|
DatumHash (DatumHash),
|
||||||
PubKeyHash (PubKeyHash),
|
PubKeyHash,
|
||||||
ScriptContext (..),
|
ScriptContext (..),
|
||||||
ScriptPurpose (Spending),
|
ScriptPurpose (Spending),
|
||||||
TokenName (TokenName),
|
TokenName (TokenName),
|
||||||
|
|
@ -56,10 +52,10 @@ import PlutusLedgerApi.V1 (
|
||||||
Validator,
|
Validator,
|
||||||
ValidatorHash (ValidatorHash),
|
ValidatorHash (ValidatorHash),
|
||||||
Value,
|
Value,
|
||||||
toBuiltin,
|
|
||||||
)
|
)
|
||||||
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
|
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
|
||||||
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
|
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
|
||||||
|
import Test.Util (scriptCredentials, userCredentials)
|
||||||
|
|
||||||
-- | A sample Currency Symbol.
|
-- | A sample Currency Symbol.
|
||||||
currSymbol :: CurrencySymbol
|
currSymbol :: CurrencySymbol
|
||||||
|
|
@ -69,16 +65,13 @@ currSymbol = CurrencySymbol "12312099"
|
||||||
signer :: PubKeyHash
|
signer :: PubKeyHash
|
||||||
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
|
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.
|
-- | List of users who the effect will pay to.
|
||||||
users :: [Credential]
|
users :: [Credential]
|
||||||
users = PubKeyCredential . PubKeyHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])
|
users = userCredentials
|
||||||
|
|
||||||
-- | List of users who the effect will pay to.
|
-- | List of users who the effect will pay to.
|
||||||
treasuries :: [Credential]
|
treasuries :: [Credential]
|
||||||
treasuries = ScriptCredential . ValidatorHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])
|
treasuries = scriptCredentials
|
||||||
|
|
||||||
inputGAT :: TxInInfo
|
inputGAT :: TxInInfo
|
||||||
inputGAT =
|
inputGAT =
|
||||||
|
|
|
||||||
|
|
@ -8,17 +8,6 @@ This module tests primarily the happy path for Proposal interactions
|
||||||
module Sample.Proposal (
|
module Sample.Proposal (
|
||||||
-- * Script contexts
|
-- * Script contexts
|
||||||
proposalCreation,
|
proposalCreation,
|
||||||
cosignProposal,
|
|
||||||
proposalRef,
|
|
||||||
stakeRef,
|
|
||||||
voteOnProposal,
|
|
||||||
VotingParameters (..),
|
|
||||||
advanceProposalSuccess,
|
|
||||||
advanceProposalFailureTimeout,
|
|
||||||
TransitionParameters (..),
|
|
||||||
advanceFinishedProposal,
|
|
||||||
advanceProposalInsufficientVotes,
|
|
||||||
advanceProposalWithInvalidOutputStake,
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Agora.Governor (GovernorDatum (..))
|
import Agora.Governor (GovernorDatum (..))
|
||||||
|
|
@ -27,78 +16,41 @@ import Agora.Proposal (
|
||||||
ProposalDatum (..),
|
ProposalDatum (..),
|
||||||
ProposalId (..),
|
ProposalId (..),
|
||||||
ProposalStatus (..),
|
ProposalStatus (..),
|
||||||
ProposalThresholds (..),
|
|
||||||
ProposalVotes (..),
|
|
||||||
ResultTag (..),
|
ResultTag (..),
|
||||||
emptyVotesFor,
|
emptyVotesFor,
|
||||||
)
|
)
|
||||||
import Agora.Proposal.Time (
|
|
||||||
ProposalStartingTime (ProposalStartingTime),
|
|
||||||
ProposalTimingConfig (..),
|
|
||||||
)
|
|
||||||
import Agora.Stake (
|
|
||||||
ProposalLock (ProposalLock),
|
|
||||||
Stake (..),
|
|
||||||
StakeDatum (..),
|
|
||||||
)
|
|
||||||
import Data.Default.Class (Default (def))
|
import Data.Default.Class (Default (def))
|
||||||
import Data.Tagged (Tagged (..), untag)
|
|
||||||
import Plutarch.Context (
|
import Plutarch.Context (
|
||||||
BaseBuilder,
|
|
||||||
MintingBuilder,
|
MintingBuilder,
|
||||||
buildMintingUnsafe,
|
buildMintingUnsafe,
|
||||||
buildTxInfoUnsafe,
|
|
||||||
input,
|
input,
|
||||||
mint,
|
mint,
|
||||||
output,
|
output,
|
||||||
script,
|
script,
|
||||||
signedWith,
|
signedWith,
|
||||||
timeRange,
|
|
||||||
txId,
|
txId,
|
||||||
withDatum,
|
withDatum,
|
||||||
withRefIndex,
|
|
||||||
withTxId,
|
withTxId,
|
||||||
withValue,
|
withValue,
|
||||||
)
|
)
|
||||||
import PlutusLedgerApi.V1 (
|
import PlutusLedgerApi.V1 (
|
||||||
Datum (Datum),
|
|
||||||
DatumHash,
|
|
||||||
POSIXTime,
|
|
||||||
POSIXTimeRange,
|
|
||||||
PubKeyHash,
|
|
||||||
ScriptContext (..),
|
ScriptContext (..),
|
||||||
ToData (toBuiltinData),
|
|
||||||
TxInInfo (TxInInfo),
|
|
||||||
TxInfo (..),
|
|
||||||
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
|
|
||||||
TxOutRef (..),
|
|
||||||
ValidatorHash,
|
|
||||||
)
|
)
|
||||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||||
assetClassValue,
|
assetClassValue,
|
||||||
singleton,
|
singleton,
|
||||||
)
|
)
|
||||||
import PlutusTx.AssocMap qualified as AssocMap
|
import PlutusTx.AssocMap qualified as AssocMap
|
||||||
import Sample.Proposal.Shared (proposalRef, stakeRef)
|
|
||||||
import Sample.Shared (
|
import Sample.Shared (
|
||||||
govValidatorHash,
|
govValidatorHash,
|
||||||
minAda,
|
|
||||||
proposal,
|
proposal,
|
||||||
proposalPolicySymbol,
|
proposalPolicySymbol,
|
||||||
proposalStartingTimeFromTimeRange,
|
proposalStartingTimeFromTimeRange,
|
||||||
proposalValidatorHash,
|
proposalValidatorHash,
|
||||||
signer,
|
signer,
|
||||||
signer2,
|
|
||||||
stake,
|
|
||||||
stakeAddress,
|
|
||||||
stakeAssetClass,
|
|
||||||
stakeValidatorHash,
|
|
||||||
)
|
)
|
||||||
import Test.Util (
|
import Test.Util (
|
||||||
closedBoundedInterval,
|
closedBoundedInterval,
|
||||||
datumPair,
|
|
||||||
toDatumHash,
|
|
||||||
updateMap,
|
|
||||||
)
|
)
|
||||||
|
|
||||||
proposalCreation :: ScriptContext
|
proposalCreation :: ScriptContext
|
||||||
|
|
@ -160,656 +112,3 @@ proposalCreation =
|
||||||
. withDatum govAfter
|
. withDatum govAfter
|
||||||
]
|
]
|
||||||
in buildMintingUnsafe builder
|
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
|
-- | 'TxId' of all the propsoal inputs in the samples.
|
||||||
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
|
proposalTxRef :: TxId
|
||||||
|
proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||||
|
|
||||||
stakeRef :: TxOutRef
|
-- | 'TxId' of all the stake inputs in the samples.
|
||||||
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
|
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 (
|
import PlutusLedgerApi.V1 (
|
||||||
DatumHash,
|
DatumHash,
|
||||||
ScriptContext (..),
|
ScriptContext (..),
|
||||||
|
|
@ -21,19 +48,7 @@ import PlutusLedgerApi.V1 (
|
||||||
)
|
)
|
||||||
import PlutusLedgerApi.V1.Value qualified as Value
|
import PlutusLedgerApi.V1.Value qualified as Value
|
||||||
import PlutusTx.AssocMap qualified as AssocMap
|
import PlutusTx.AssocMap qualified as AssocMap
|
||||||
|
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
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.Shared (
|
import Sample.Shared (
|
||||||
minAda,
|
minAda,
|
||||||
proposalPolicySymbol,
|
proposalPolicySymbol,
|
||||||
|
|
@ -43,19 +58,9 @@ import Sample.Shared (
|
||||||
stakeAssetClass,
|
stakeAssetClass,
|
||||||
stakeValidatorHash,
|
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 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
|
script proposalValidatorHash
|
||||||
. withValue pst
|
. withValue pst
|
||||||
. withDatum i
|
. withDatum i
|
||||||
. withTxId (txOutRefId proposalRef)
|
. withTxId proposalTxRef
|
||||||
. withRefIndex (txOutRefIdx proposalRef + coerce i.proposalId)
|
. withRefIndex (coerce i.proposalId + 2)
|
||||||
, output $
|
, output $
|
||||||
script proposalValidatorHash
|
script proposalValidatorHash
|
||||||
. withValue (sortValue $ pst <> minAda)
|
. withValue (sortValue $ pst <> minAda)
|
||||||
|
|
@ -249,8 +254,8 @@ unlockStake p =
|
||||||
script stakeValidatorHash
|
script stakeValidatorHash
|
||||||
. withValue stakeValue
|
. withValue stakeValue
|
||||||
. withDatum sInDatum
|
. withDatum sInDatum
|
||||||
. withTxId (txOutRefId stakeRef)
|
. withTxId stakeTxRef
|
||||||
. withRefIndex (txOutRefIdx stakeRef)
|
. withRefIndex 1
|
||||||
, output $
|
, output $
|
||||||
script stakeValidatorHash
|
script stakeValidatorHash
|
||||||
. withValue stakeValue
|
. withValue stakeValue
|
||||||
|
|
@ -271,6 +276,14 @@ mkProposalValidatorTestCase p shouldSucceed =
|
||||||
let datum = mkProposalInputDatum p $ ProposalId 0
|
let datum = mkProposalInputDatum p $ ProposalId 0
|
||||||
redeemer = Unlock (ResultTag 0)
|
redeemer = Unlock (ResultTag 0)
|
||||||
name = show p
|
name = show p
|
||||||
scriptContext = ScriptContext (unlockStake p) (Spending proposalRef)
|
scriptContext =
|
||||||
f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith
|
ScriptContext
|
||||||
in f name (proposalValidator Shared.proposal) datum redeemer 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)
|
||||||
|
)
|
||||||
|
|
@ -1,5 +1,3 @@
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
|
|
||||||
{- |
|
{- |
|
||||||
Module : Spec.Proposal
|
Module : Spec.Proposal
|
||||||
Maintainer : emi@haskell.fyi
|
Maintainer : emi@haskell.fyi
|
||||||
|
|
@ -11,45 +9,19 @@ module Spec.Proposal (specs) where
|
||||||
|
|
||||||
import Agora.Proposal (
|
import Agora.Proposal (
|
||||||
Proposal (..),
|
Proposal (..),
|
||||||
ProposalDatum (..),
|
|
||||||
ProposalId (ProposalId),
|
|
||||||
ProposalRedeemer (..),
|
|
||||||
ProposalStatus (..),
|
ProposalStatus (..),
|
||||||
ProposalThresholds (..),
|
|
||||||
ProposalVotes (ProposalVotes),
|
|
||||||
ResultTag (ResultTag),
|
|
||||||
cosigners,
|
|
||||||
effects,
|
|
||||||
emptyVotesFor,
|
|
||||||
proposalId,
|
|
||||||
status,
|
|
||||||
thresholds,
|
|
||||||
votes,
|
|
||||||
)
|
)
|
||||||
import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
|
import Agora.Proposal.Scripts (proposalPolicy)
|
||||||
import Agora.Proposal.Time (
|
|
||||||
ProposalStartingTime (ProposalStartingTime),
|
|
||||||
)
|
|
||||||
import Agora.Stake (
|
|
||||||
ProposalLock (ProposalLock),
|
|
||||||
StakeDatum (StakeDatum),
|
|
||||||
StakeRedeemer (PermitVote, WitnessStake),
|
|
||||||
)
|
|
||||||
import Agora.Stake.Scripts (stakeValidator)
|
|
||||||
import Data.Default.Class (Default (def))
|
|
||||||
import Data.Tagged (Tagged (Tagged), untag)
|
|
||||||
import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..))
|
|
||||||
import PlutusTx.AssocMap qualified as AssocMap
|
|
||||||
import Sample.Proposal qualified as Proposal
|
import Sample.Proposal qualified as Proposal
|
||||||
|
import Sample.Proposal.Advance qualified as Advance
|
||||||
|
import Sample.Proposal.Cosign qualified as Cosign
|
||||||
import Sample.Proposal.UnlockStake qualified as UnlockStake
|
import Sample.Proposal.UnlockStake qualified as UnlockStake
|
||||||
import Sample.Shared (signer, signer2)
|
import Sample.Proposal.Vote qualified as Vote
|
||||||
import Sample.Shared qualified as Shared (proposal, stake)
|
import Sample.Shared qualified as Shared (proposal)
|
||||||
import Test.Specification (
|
import Test.Specification (
|
||||||
SpecificationTree,
|
SpecificationTree,
|
||||||
group,
|
group,
|
||||||
policySucceedsWith,
|
policySucceedsWith,
|
||||||
validatorFailsWith,
|
|
||||||
validatorSucceedsWith,
|
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Stake specs.
|
-- | Stake specs.
|
||||||
|
|
@ -67,279 +39,133 @@ specs =
|
||||||
"validator"
|
"validator"
|
||||||
[ group
|
[ group
|
||||||
"cosignature"
|
"cosignature"
|
||||||
[ validatorSucceedsWith
|
$ let cosignerCases = [1, 5, 10]
|
||||||
"proposal"
|
|
||||||
(proposalValidator Shared.proposal)
|
mkLegalGroup nCosigners =
|
||||||
( ProposalDatum
|
Cosign.mkTestTree
|
||||||
{ proposalId = ProposalId 0
|
("with " <> show nCosigners <> " cosigners")
|
||||||
, effects =
|
(Cosign.validCosignNParameters nCosigners)
|
||||||
AssocMap.fromList
|
True
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
legalGroup =
|
||||||
, (ResultTag 1, AssocMap.empty)
|
group "legal" $
|
||||||
]
|
map mkLegalGroup cosignerCases
|
||||||
, status = Draft
|
|
||||||
, cosigners = [signer]
|
mkIllegalStatusNotDraftGroup nCosigners =
|
||||||
, thresholds = def
|
group ("with " <> show nCosigners <> " cosigners") $
|
||||||
, votes =
|
map
|
||||||
emptyVotesFor $
|
( \ps ->
|
||||||
AssocMap.fromList
|
Cosign.mkTestTree
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
("status: " <> show ps.proposalStatus)
|
||||||
, (ResultTag 1, AssocMap.empty)
|
ps
|
||||||
]
|
False
|
||||||
, timingConfig = def
|
)
|
||||||
, startingTime = ProposalStartingTime 0
|
(Cosign.statusNotDraftCosignNParameters nCosigners)
|
||||||
}
|
illegalStatusNotDraftGroup =
|
||||||
)
|
group "proposal status not Draft" $
|
||||||
(Cosign [signer2])
|
map mkIllegalStatusNotDraftGroup cosignerCases
|
||||||
(ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.proposalRef))
|
|
||||||
, validatorSucceedsWith
|
illegalGroup =
|
||||||
"stake"
|
group
|
||||||
(stakeValidator Shared.stake)
|
"illegal"
|
||||||
(StakeDatum (Tagged 50_000_000) signer2 [])
|
[ Cosign.mkTestTree
|
||||||
WitnessStake
|
"duplicate cosigners"
|
||||||
(ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.stakeRef))
|
Cosign.duplicateCosignersParameters
|
||||||
]
|
False
|
||||||
|
, Cosign.mkTestTree
|
||||||
|
"altered output stake"
|
||||||
|
Cosign.invalidStakeOutputParameters
|
||||||
|
False
|
||||||
|
, illegalStatusNotDraftGroup
|
||||||
|
]
|
||||||
|
in [legalGroup, illegalGroup]
|
||||||
, group
|
, group
|
||||||
"voting"
|
"voting"
|
||||||
[ validatorSucceedsWith
|
[ Vote.mkTestTree "legal" Vote.validVoteParameters True
|
||||||
"proposal"
|
-- TODO: add negative test cases
|
||||||
(proposalValidator Shared.proposal)
|
]
|
||||||
( ProposalDatum
|
, group "advancing" $
|
||||||
{ proposalId = ProposalId 42
|
let mkFromDraft nCosigners =
|
||||||
, effects =
|
let name = "with " <> show nCosigners <> " cosigner(s)"
|
||||||
AssocMap.fromList
|
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
legalGroup =
|
||||||
, (ResultTag 1, AssocMap.empty)
|
group
|
||||||
|
"legal"
|
||||||
|
[ Advance.mkTestTree
|
||||||
|
"to next state"
|
||||||
|
( head $
|
||||||
|
Advance.advanceToNextStateInTimeParameters
|
||||||
|
nCosigners
|
||||||
|
)
|
||||||
|
True
|
||||||
|
, Advance.mkTestTree
|
||||||
|
"to failed state"
|
||||||
|
( head $
|
||||||
|
Advance.advanceToFailedStateDueToTimeoutParameters
|
||||||
|
nCosigners
|
||||||
|
)
|
||||||
|
True
|
||||||
]
|
]
|
||||||
, status = VotingReady
|
|
||||||
, cosigners = [signer]
|
illegalGroup =
|
||||||
, thresholds = def
|
group
|
||||||
, votes =
|
"illegal"
|
||||||
ProposalVotes
|
[ Advance.mkTestTree
|
||||||
( AssocMap.fromList
|
"insufficient cosigns"
|
||||||
[ (ResultTag 0, 42)
|
(Advance.insufficientCosignsParameters nCosigners)
|
||||||
, (ResultTag 1, 4242)
|
False
|
||||||
]
|
, Advance.mkTestTree
|
||||||
|
"invalid stake output"
|
||||||
|
(head $ Advance.invalidOutputStakeParameters nCosigners)
|
||||||
|
False
|
||||||
|
]
|
||||||
|
in group name [legalGroup, illegalGroup]
|
||||||
|
|
||||||
|
draftGroup = group "from draft" $ map mkFromDraft [1, 5, 10]
|
||||||
|
|
||||||
|
legalGroup =
|
||||||
|
group
|
||||||
|
"legal"
|
||||||
|
[ group "advance to next state" $
|
||||||
|
map
|
||||||
|
( \ps ->
|
||||||
|
let name = "from: " <> show ps.fromStatus
|
||||||
|
in Advance.mkTestTree name ps True
|
||||||
)
|
)
|
||||||
, timingConfig = def
|
(tail $ Advance.advanceToNextStateInTimeParameters 1)
|
||||||
, startingTime = ProposalStartingTime 0
|
, group "advance to failed state" $
|
||||||
}
|
map
|
||||||
)
|
( \ps ->
|
||||||
(Vote (ResultTag 0))
|
let name = "from: " <> show ps.fromStatus
|
||||||
( ScriptContext
|
in Advance.mkTestTree name ps True
|
||||||
( Proposal.voteOnProposal
|
)
|
||||||
Proposal.VotingParameters
|
(tail $ Advance.advanceToFailedStateDueToTimeoutParameters 1)
|
||||||
{ Proposal.voteFor = ResultTag 0
|
|
||||||
, Proposal.voteCount = 27
|
|
||||||
}
|
|
||||||
)
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
, validatorSucceedsWith
|
|
||||||
"stake"
|
|
||||||
(stakeValidator Shared.stake)
|
|
||||||
( StakeDatum
|
|
||||||
(Tagged 27)
|
|
||||||
signer
|
|
||||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
|
||||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
|
||||||
]
|
]
|
||||||
)
|
|
||||||
(PermitVote $ ProposalLock (ResultTag 0) (ProposalId 42))
|
illegalGroup =
|
||||||
( ScriptContext
|
group
|
||||||
( Proposal.voteOnProposal
|
"illegal"
|
||||||
Proposal.VotingParameters
|
[ Advance.mkTestTree
|
||||||
{ Proposal.voteFor = ResultTag 0
|
"insufficient votes"
|
||||||
, Proposal.voteCount = 27
|
Advance.insufficientVotesParameters
|
||||||
}
|
False
|
||||||
)
|
, Advance.mkTestTree
|
||||||
(Spending Proposal.stakeRef)
|
"initial state is Finished"
|
||||||
)
|
Advance.advanceFromFinishedParameters
|
||||||
]
|
False
|
||||||
, group
|
, group
|
||||||
"advancing"
|
"invalid stake output"
|
||||||
[ group "successfully advance to next state" $
|
$ do
|
||||||
map
|
nStake <- [1, 5]
|
||||||
( \(name, initialState) ->
|
ps <- tail $ Advance.invalidOutputStakeParameters nStake
|
||||||
validatorSucceedsWith
|
|
||||||
name
|
let name =
|
||||||
(proposalValidator Shared.proposal)
|
"from " <> show ps.fromStatus <> "with "
|
||||||
( ProposalDatum
|
<> show nStake
|
||||||
{ proposalId = ProposalId 0
|
<> " stakes"
|
||||||
, effects =
|
|
||||||
AssocMap.fromList
|
pure $ Advance.mkTestTree name ps False
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
]
|
||||||
, (ResultTag 1, AssocMap.empty)
|
in [draftGroup, legalGroup, illegalGroup]
|
||||||
]
|
|
||||||
, status = initialState
|
|
||||||
, cosigners = [signer]
|
|
||||||
, thresholds = def
|
|
||||||
, votes =
|
|
||||||
ProposalVotes
|
|
||||||
( AssocMap.fromList
|
|
||||||
[
|
|
||||||
( ResultTag 0
|
|
||||||
, case initialState of
|
|
||||||
Draft -> 0
|
|
||||||
_ -> untag (def :: ProposalThresholds).execute + 1
|
|
||||||
)
|
|
||||||
, (ResultTag 1, 0)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, timingConfig = def
|
|
||||||
, startingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
AdvanceProposal
|
|
||||||
( ScriptContext
|
|
||||||
( Proposal.advanceProposalSuccess
|
|
||||||
Proposal.TransitionParameters
|
|
||||||
{ Proposal.initialProposalStatus = initialState
|
|
||||||
, Proposal.proposalStartingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
[ ("Draft -> VotringReady", Draft)
|
|
||||||
, ("VotingReady -> Locked", VotingReady)
|
|
||||||
, ("Locked -> Finished", Locked)
|
|
||||||
]
|
|
||||||
, group "successfully advance to failed state: timeout" $
|
|
||||||
map
|
|
||||||
( \(name, initialState) ->
|
|
||||||
validatorSucceedsWith
|
|
||||||
name
|
|
||||||
(proposalValidator Shared.proposal)
|
|
||||||
( ProposalDatum
|
|
||||||
{ proposalId = ProposalId 0
|
|
||||||
, effects =
|
|
||||||
AssocMap.fromList
|
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
|
||||||
, (ResultTag 1, AssocMap.empty)
|
|
||||||
]
|
|
||||||
, status = initialState
|
|
||||||
, cosigners = [signer]
|
|
||||||
, thresholds = def
|
|
||||||
, votes =
|
|
||||||
ProposalVotes
|
|
||||||
( AssocMap.fromList
|
|
||||||
[
|
|
||||||
( ResultTag 0
|
|
||||||
, case initialState of
|
|
||||||
Draft -> 0
|
|
||||||
_ -> untag (def :: ProposalThresholds).vote + 1
|
|
||||||
)
|
|
||||||
, (ResultTag 1, 0)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, timingConfig = def
|
|
||||||
, startingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
AdvanceProposal
|
|
||||||
( ScriptContext
|
|
||||||
( Proposal.advanceProposalFailureTimeout
|
|
||||||
Proposal.TransitionParameters
|
|
||||||
{ Proposal.initialProposalStatus = initialState
|
|
||||||
, Proposal.proposalStartingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
[ ("Draft -> Finished", Draft)
|
|
||||||
, ("VotingReady -> Finished", VotingReady)
|
|
||||||
, ("Locked -> Finished", Locked)
|
|
||||||
]
|
|
||||||
, validatorFailsWith
|
|
||||||
"illegal: insufficient votes"
|
|
||||||
(proposalValidator Shared.proposal)
|
|
||||||
( ProposalDatum
|
|
||||||
{ proposalId = ProposalId 0
|
|
||||||
, effects =
|
|
||||||
AssocMap.fromList
|
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
|
||||||
, (ResultTag 1, AssocMap.empty)
|
|
||||||
]
|
|
||||||
, status = VotingReady
|
|
||||||
, cosigners = [signer]
|
|
||||||
, thresholds = def
|
|
||||||
, votes =
|
|
||||||
ProposalVotes
|
|
||||||
( AssocMap.fromList
|
|
||||||
[ (ResultTag 0, 1)
|
|
||||||
, (ResultTag 1, 0)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, timingConfig = def
|
|
||||||
, startingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
AdvanceProposal
|
|
||||||
( ScriptContext
|
|
||||||
Proposal.advanceProposalInsufficientVotes
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
, validatorFailsWith
|
|
||||||
"illegal: initial state is Finished"
|
|
||||||
(proposalValidator Shared.proposal)
|
|
||||||
( ProposalDatum
|
|
||||||
{ proposalId = ProposalId 0
|
|
||||||
, effects =
|
|
||||||
AssocMap.fromList
|
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
|
||||||
, (ResultTag 1, AssocMap.empty)
|
|
||||||
]
|
|
||||||
, status = Finished
|
|
||||||
, cosigners = [signer]
|
|
||||||
, thresholds = def
|
|
||||||
, votes =
|
|
||||||
ProposalVotes
|
|
||||||
( AssocMap.fromList
|
|
||||||
[ (ResultTag 0, untag (def :: ProposalThresholds).vote + 1)
|
|
||||||
, (ResultTag 1, 0)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, timingConfig = def
|
|
||||||
, startingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
AdvanceProposal
|
|
||||||
( ScriptContext
|
|
||||||
Proposal.advanceFinishedProposal
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
, validatorFailsWith
|
|
||||||
"illegal: with stake input"
|
|
||||||
(proposalValidator Shared.proposal)
|
|
||||||
( ProposalDatum
|
|
||||||
{ proposalId = ProposalId 0
|
|
||||||
, effects =
|
|
||||||
AssocMap.fromList
|
|
||||||
[ (ResultTag 0, AssocMap.empty)
|
|
||||||
, (ResultTag 1, AssocMap.empty)
|
|
||||||
]
|
|
||||||
, status = VotingReady
|
|
||||||
, cosigners = [signer]
|
|
||||||
, thresholds = def
|
|
||||||
, votes =
|
|
||||||
ProposalVotes
|
|
||||||
( AssocMap.fromList
|
|
||||||
[ (ResultTag 0, 0)
|
|
||||||
, (ResultTag 1, 0)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
, timingConfig = def
|
|
||||||
, startingTime = ProposalStartingTime 0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
AdvanceProposal
|
|
||||||
( ScriptContext
|
|
||||||
Proposal.advanceProposalWithInvalidOutputStake
|
|
||||||
(Spending Proposal.proposalRef)
|
|
||||||
)
|
|
||||||
]
|
|
||||||
, group "unlocking" $ do
|
, group "unlocking" $ do
|
||||||
proposalCount <- [1, 42]
|
proposalCount <- [1, 42]
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -13,22 +13,24 @@ module Test.Util (
|
||||||
updateMap,
|
updateMap,
|
||||||
sortMap,
|
sortMap,
|
||||||
sortValue,
|
sortValue,
|
||||||
|
blake2b_224,
|
||||||
|
pubKeyHashes,
|
||||||
|
userCredentials,
|
||||||
|
scriptCredentials,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Prelude
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
import Codec.Serialise (serialise)
|
import Codec.Serialise (serialise)
|
||||||
import Data.ByteString.Lazy qualified as ByteString.Lazy
|
import Crypto.Hash qualified as Crypto
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
import Data.Bifunctor (second)
|
import Data.Bifunctor (second)
|
||||||
|
import Data.ByteArray qualified as BA
|
||||||
|
import Data.ByteString qualified as BS
|
||||||
|
import Data.ByteString.Char8 qualified as C
|
||||||
|
import Data.ByteString.Lazy qualified as ByteString.Lazy
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
import Plutarch.Crypto (pblake2b_256)
|
import Plutarch.Crypto (pblake2b_256)
|
||||||
|
import PlutusLedgerApi.V1 (Credential (PubKeyCredential, ScriptCredential), PubKeyHash (..), ValidatorHash (ValidatorHash))
|
||||||
import PlutusLedgerApi.V1.Interval qualified as PlutusTx
|
import PlutusLedgerApi.V1.Interval qualified as PlutusTx
|
||||||
import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
|
import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
|
||||||
import PlutusLedgerApi.V1.Value (Value (..))
|
import PlutusLedgerApi.V1.Value (Value (..))
|
||||||
|
|
@ -36,6 +38,7 @@ import PlutusTx.AssocMap qualified as AssocMap
|
||||||
import PlutusTx.Builtins qualified as PlutusTx
|
import PlutusTx.Builtins qualified as PlutusTx
|
||||||
import PlutusTx.IsData qualified as PlutusTx
|
import PlutusTx.IsData qualified as PlutusTx
|
||||||
import PlutusTx.Ord qualified as PlutusTx
|
import PlutusTx.Ord qualified as PlutusTx
|
||||||
|
import Prelude
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
@ -106,3 +109,25 @@ sortValue =
|
||||||
. fmap (second sortMap)
|
. fmap (second sortMap)
|
||||||
. AssocMap.toList
|
. AssocMap.toList
|
||||||
. getValue
|
. getValue
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Compute the hash of a given byte string using blake2b_224 algorithm.
|
||||||
|
blake2b_224 :: BS.ByteString -> BS.ByteString
|
||||||
|
blake2b_224 = BS.pack . BA.unpack . Crypto.hashWith Crypto.Blake2b_224
|
||||||
|
|
||||||
|
-- | An infinite list of blake2b_224 hashes.
|
||||||
|
blake2b_224Hashes :: [BS.ByteString]
|
||||||
|
blake2b_224Hashes = blake2b_224 . C.pack . show @Integer <$> [0 ..]
|
||||||
|
|
||||||
|
-- | An infinite list of *valid* 'PubKeyHash'.
|
||||||
|
pubKeyHashes :: [PubKeyHash]
|
||||||
|
pubKeyHashes = PubKeyHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
|
||||||
|
|
||||||
|
-- | An infinite list of *valid* user credentials.
|
||||||
|
userCredentials :: [Credential]
|
||||||
|
userCredentials = PubKeyCredential <$> pubKeyHashes
|
||||||
|
|
||||||
|
-- | An infinite list of *valid* script credentials.
|
||||||
|
scriptCredentials :: [Credential]
|
||||||
|
scriptCredentials = ScriptCredential . ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
|
||||||
|
|
|
||||||
|
|
@ -16,7 +16,7 @@ common lang
|
||||||
-Wno-unused-do-bind -Wno-partial-type-signatures
|
-Wno-unused-do-bind -Wno-partial-type-signatures
|
||||||
-Wmissing-export-lists -Wincomplete-record-updates
|
-Wmissing-export-lists -Wincomplete-record-updates
|
||||||
-Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls
|
-Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls
|
||||||
-fprint-explicit-foralls -fprint-explicit-kinds
|
-fprint-explicit-foralls -fprint-explicit-kinds -Wunused-do-bind
|
||||||
|
|
||||||
mixins:
|
mixins:
|
||||||
base hiding (Prelude),
|
base hiding (Prelude),
|
||||||
|
|
@ -189,8 +189,11 @@ library agora-specs
|
||||||
Sample.Effect.TreasuryWithdrawal
|
Sample.Effect.TreasuryWithdrawal
|
||||||
Sample.Governor
|
Sample.Governor
|
||||||
Sample.Proposal
|
Sample.Proposal
|
||||||
|
Sample.Proposal.Advance
|
||||||
|
Sample.Proposal.Cosign
|
||||||
Sample.Proposal.Shared
|
Sample.Proposal.Shared
|
||||||
Sample.Proposal.UnlockStake
|
Sample.Proposal.UnlockStake
|
||||||
|
Sample.Proposal.Vote
|
||||||
Sample.Shared
|
Sample.Shared
|
||||||
Sample.Stake
|
Sample.Stake
|
||||||
Sample.Treasury
|
Sample.Treasury
|
||||||
|
|
|
||||||
|
|
@ -283,6 +283,8 @@ data ProposalDatum = ProposalDatum
|
||||||
-- ^ The status the proposal is in.
|
-- ^ The status the proposal is in.
|
||||||
, cosigners :: [PubKeyHash]
|
, cosigners :: [PubKeyHash]
|
||||||
-- ^ Who created the proposal initially, and who cosigned it later.
|
-- ^ Who created the proposal initially, and who cosigned it later.
|
||||||
|
--
|
||||||
|
-- This list should be sorted in **ascending** order.
|
||||||
, thresholds :: ProposalThresholds
|
, thresholds :: ProposalThresholds
|
||||||
-- ^ Thresholds copied over on initialization.
|
-- ^ Thresholds copied over on initialization.
|
||||||
, votes :: ProposalVotes
|
, votes :: ProposalVotes
|
||||||
|
|
@ -321,7 +323,9 @@ data ProposalRedeemer
|
||||||
--
|
--
|
||||||
-- This is particularly used in the 'Draft' 'ProposalStatus',
|
-- This is particularly used in the 'Draft' 'ProposalStatus',
|
||||||
-- where matching 'Agora.Stake.Stake's can be called to advance the proposal,
|
-- where matching 'Agora.Stake.Stake's can be called to advance the proposal,
|
||||||
-- provided enough GT is shared among them.
|
-- provided enough GT is shared among them.
|
||||||
|
--
|
||||||
|
-- This list should be sorted in ascending order.
|
||||||
Cosign [PubKeyHash]
|
Cosign [PubKeyHash]
|
||||||
| -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
|
| -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
|
||||||
Unlock ResultTag
|
Unlock ResultTag
|
||||||
|
|
|
||||||
|
|
@ -30,34 +30,38 @@ import Agora.Stake (
|
||||||
PProposalLock (..),
|
PProposalLock (..),
|
||||||
PStakeDatum (..),
|
PStakeDatum (..),
|
||||||
PStakeUsage (..),
|
PStakeUsage (..),
|
||||||
findStakeOwnedBy,
|
|
||||||
pgetStakeUsage,
|
pgetStakeUsage,
|
||||||
)
|
)
|
||||||
import Agora.Utils (
|
import Agora.Utils (
|
||||||
getMintingPolicySymbol,
|
getMintingPolicySymbol,
|
||||||
mustBePJust,
|
mustBePJust,
|
||||||
mustFindDatum',
|
mustFindDatum',
|
||||||
|
pisUniq',
|
||||||
|
pltAsData,
|
||||||
)
|
)
|
||||||
import Plutarch.Api.V1 (
|
import Plutarch.Api.V1 (
|
||||||
|
PDatumHash,
|
||||||
PMintingPolicy,
|
PMintingPolicy,
|
||||||
|
PPubKeyHash,
|
||||||
PScriptContext (PScriptContext),
|
PScriptContext (PScriptContext),
|
||||||
PScriptPurpose (PMinting, PSpending),
|
PScriptPurpose (PMinting, PSpending),
|
||||||
PTxInfo (PTxInfo),
|
PTxInfo (PTxInfo),
|
||||||
|
PTxOut,
|
||||||
PValidator,
|
PValidator,
|
||||||
)
|
)
|
||||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
|
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
|
||||||
import Plutarch.Api.V1.ScriptContext (
|
import Plutarch.Api.V1.ScriptContext (
|
||||||
pfindTxInByTxOutRef,
|
pfindTxInByTxOutRef,
|
||||||
pisTokenSpent,
|
pisTokenSpent,
|
||||||
|
ptryFindDatum,
|
||||||
ptxSignedBy,
|
ptxSignedBy,
|
||||||
pvalueSpent,
|
|
||||||
)
|
)
|
||||||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
||||||
import Plutarch.Extra.Comonad (pextract)
|
import Plutarch.Extra.Comonad (pextract)
|
||||||
import Plutarch.Extra.IsData (pmatchEnum)
|
import Plutarch.Extra.IsData (pmatchEnum)
|
||||||
import Plutarch.Extra.List (pisUniqBy)
|
import Plutarch.Extra.List (pmapMaybe, pmergeBy, pmsortBy)
|
||||||
import Plutarch.Extra.Map (plookup, pupdate)
|
import Plutarch.Extra.Map (plookup, pupdate)
|
||||||
import Plutarch.Extra.Maybe (pisJust)
|
import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust)
|
||||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||||
import Plutarch.Extra.TermCont (
|
import Plutarch.Extra.TermCont (
|
||||||
pguardC,
|
pguardC,
|
||||||
|
|
@ -191,9 +195,12 @@ proposalValidator proposal =
|
||||||
|
|
||||||
ownAddress <- pletC $ txOutF.address
|
ownAddress <- pletC $ txOutF.address
|
||||||
|
|
||||||
|
thresholdsF <- pletFieldsC @'["execute", "create", "vote"] proposalF.thresholds
|
||||||
|
|
||||||
|
currentStatus <- pletC $ pfromData $ proposalF.status
|
||||||
|
|
||||||
let stCurrencySymbol =
|
let stCurrencySymbol =
|
||||||
pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass)
|
pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass)
|
||||||
valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
|
|
||||||
|
|
||||||
signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
|
signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
|
||||||
|
|
||||||
|
|
@ -236,339 +243,460 @@ proposalValidator proposal =
|
||||||
# txInfoF.datums
|
# txInfoF.datums
|
||||||
|
|
||||||
proposalUnchanged <- pletC $ proposalOut #== proposalDatum
|
proposalUnchanged <- pletC $ proposalOut #== proposalDatum
|
||||||
|
|
||||||
|
proposalOutStatus <-
|
||||||
|
pletC $
|
||||||
|
pfromData $
|
||||||
|
pfield @"status" # proposalOut
|
||||||
|
|
||||||
|
onlyStatusChanged <-
|
||||||
|
pletC $
|
||||||
|
-- Only the status of proposals is updated.
|
||||||
|
|
||||||
|
-- Only the status of proposals is updated.
|
||||||
|
proposalOut
|
||||||
|
#== mkRecordConstr
|
||||||
|
PProposalDatum
|
||||||
|
( #proposalId .= proposalF.proposalId
|
||||||
|
.& #effects .= proposalF.effects
|
||||||
|
.& #status .= pdata proposalOutStatus
|
||||||
|
.& #cosigners .= proposalF.cosigners
|
||||||
|
.& #thresholds .= proposalF.thresholds
|
||||||
|
.& #votes .= proposalF.votes
|
||||||
|
.& #timingConfig .= proposalF.timingConfig
|
||||||
|
.& #startingTime .= proposalF.startingTime
|
||||||
|
)
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
-- Find the stake input and stake output by SST.
|
|
||||||
|
-- Find the stake inputs/outputs by SST.
|
||||||
|
|
||||||
let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
|
let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
|
||||||
stakeSTAssetClass <-
|
stakeSTAssetClass <-
|
||||||
pletC $ passetClass # pconstant stakeSym # pconstant stakeTn
|
pletC $ passetClass # pconstant stakeSym # pconstant stakeTn
|
||||||
spentStakeST <-
|
|
||||||
pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass
|
|
||||||
|
|
||||||
let stakeInput =
|
|
||||||
pfield @"resolved"
|
|
||||||
#$ mustBePJust
|
|
||||||
# "Stake input should be present"
|
|
||||||
#$ pfind
|
|
||||||
# plam
|
|
||||||
( \(pfromData . (pfield @"value" #) . (pfield @"resolved" #) -> value) ->
|
|
||||||
passetClassValueOf # value # stakeSTAssetClass #== 1
|
|
||||||
)
|
|
||||||
# pfromData txInfoF.inputs
|
|
||||||
|
|
||||||
stakeIn <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeInput) # txInfoF.datums
|
|
||||||
stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
|
|
||||||
|
|
||||||
let stakeOutput =
|
|
||||||
mustBePJust # "Stake output should be present"
|
|
||||||
#$ pfind
|
|
||||||
# plam
|
|
||||||
( \(pfromData . (pfield @"value" #) -> value) ->
|
|
||||||
passetClassValueOf # value # stakeSTAssetClass #== 1
|
|
||||||
)
|
|
||||||
# pfromData txInfoF.outputs
|
|
||||||
|
|
||||||
stakeOut <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeOutput) # txInfoF.datums
|
|
||||||
|
|
||||||
stakeUnchanged <- pletC $ stakeIn #== stakeOut
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
|
||||||
|
|
||||||
pure $
|
|
||||||
pmatch proposalRedeemer $ \case
|
|
||||||
PVote r -> unTermCont $ do
|
|
||||||
pguardC "Input proposal must be in VotingReady state" $
|
|
||||||
proposalF.status #== pconstant VotingReady
|
|
||||||
|
|
||||||
pguardC "Proposal time should be wthin the voting period" $
|
|
||||||
isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
|
||||||
|
|
||||||
-- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
|
|
||||||
PProposalVotes voteMap <- pmatchC proposalF.votes
|
|
||||||
voteFor <- pletC $ pfromData $ pfield @"resultTag" # r
|
|
||||||
|
|
||||||
pguardC "Vote option should be valid" $
|
|
||||||
pisJust #$ plookup # voteFor # voteMap
|
|
||||||
|
|
||||||
-- Ensure that no lock with the current proposal id has been put on the stake.
|
|
||||||
pguardC "Same stake shouldn't vote on the same proposal twice" $
|
|
||||||
pnot #$ pany
|
|
||||||
# plam
|
|
||||||
( \((pfield @"proposalTag" #) . pfromData -> pid) ->
|
|
||||||
pid #== proposalF.proposalId
|
|
||||||
)
|
|
||||||
# pfromData stakeInF.lockedBy
|
|
||||||
|
|
||||||
let -- The amount of new votes should be the 'stakedAmount'.
|
|
||||||
-- Update the vote counter of the proposal, and leave other stuff as is.
|
|
||||||
expectedNewVotes = pmatch (pfromData proposalF.votes) $ \(PProposalVotes m) ->
|
|
||||||
pcon $
|
|
||||||
PProposalVotes $
|
|
||||||
pupdate
|
|
||||||
# plam
|
|
||||||
( \votes -> unTermCont $ do
|
|
||||||
PDiscrete v <- pmatchC stakeInF.stakedAmount
|
|
||||||
pure $ pcon $ PJust $ votes + (pextract # v)
|
|
||||||
)
|
|
||||||
# voteFor
|
|
||||||
# m
|
|
||||||
expectedProposalOut =
|
|
||||||
mkRecordConstr
|
|
||||||
PProposalDatum
|
|
||||||
( #proposalId .= proposalF.proposalId
|
|
||||||
.& #effects .= proposalF.effects
|
|
||||||
.& #status .= proposalF.status
|
|
||||||
.& #cosigners .= proposalF.cosigners
|
|
||||||
.& #thresholds .= proposalF.thresholds
|
|
||||||
.& #votes .= pdata expectedNewVotes
|
|
||||||
.& #timingConfig .= proposalF.timingConfig
|
|
||||||
.& #startingTime .= proposalF.startingTime
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
|
|
||||||
|
|
||||||
-- We validate the output stake datum here as well: We need the vote option
|
|
||||||
-- to create a valid 'ProposalLock', however the vote option is encoded
|
|
||||||
-- in the proposal redeemer, which is invisible for the stake validator.
|
|
||||||
|
|
||||||
let newProposalLock =
|
|
||||||
mkRecordConstr
|
|
||||||
PProposalLock
|
|
||||||
( #vote .= pdata voteFor
|
|
||||||
.& #proposalTag .= proposalF.proposalId
|
|
||||||
)
|
|
||||||
-- Prepend the new lock to existing locks
|
|
||||||
expectedProposalLocks =
|
|
||||||
pcons
|
|
||||||
# pdata newProposalLock
|
|
||||||
# pfromData stakeInF.lockedBy
|
|
||||||
expectedStakeOut =
|
|
||||||
mkRecordConstr
|
|
||||||
PStakeDatum
|
|
||||||
( #stakedAmount .= stakeInF.stakedAmount
|
|
||||||
.& #owner .= stakeInF.owner
|
|
||||||
.& #lockedBy .= pdata expectedProposalLocks
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
--------------------------------------------------------------------------
|
|
||||||
PCosign r -> unTermCont $ do
|
|
||||||
pguardC "Stake should not change" stakeUnchanged
|
|
||||||
|
|
||||||
newSigs <- pletC $ pfield @"newCosigners" # r
|
|
||||||
|
|
||||||
pguardC "Cosigners are unique" $
|
|
||||||
pisUniqBy
|
|
||||||
# phoistAcyclic (plam (#==))
|
|
||||||
# phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y)
|
|
||||||
# newSigs
|
|
||||||
|
|
||||||
pguardC "Signed by all new cosigners" $
|
|
||||||
pall # signedBy # newSigs
|
|
||||||
|
|
||||||
pguardC "As many new cosigners as Stake datums" $
|
|
||||||
spentStakeST #== plength # newSigs
|
|
||||||
|
|
||||||
pguardC "All new cosigners are witnessed by their Stake datums" $
|
|
||||||
pall
|
|
||||||
# plam
|
|
||||||
( \sig ->
|
|
||||||
pmatch
|
|
||||||
( findStakeOwnedBy # stakeSTAssetClass
|
|
||||||
# pfromData sig
|
|
||||||
# txInfoF.datums
|
|
||||||
# txInfoF.inputs
|
|
||||||
)
|
|
||||||
$ \case
|
|
||||||
PNothing -> pcon PFalse
|
|
||||||
PJust _ -> pcon PTrue
|
|
||||||
)
|
|
||||||
# newSigs
|
|
||||||
|
|
||||||
let updatedSigs = pconcat # newSigs # proposalF.cosigners
|
|
||||||
expectedDatum =
|
|
||||||
mkRecordConstr
|
|
||||||
PProposalDatum
|
|
||||||
( #proposalId .= proposalF.proposalId
|
|
||||||
.& #effects .= proposalF.effects
|
|
||||||
.& #status .= proposalF.status
|
|
||||||
.& #cosigners .= pdata updatedSigs
|
|
||||||
.& #thresholds .= proposalF.thresholds
|
|
||||||
.& #votes .= proposalF.votes
|
|
||||||
.& #timingConfig .= proposalF.timingConfig
|
|
||||||
.& #startingTime .= proposalF.startingTime
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "Signatures are correctly added to cosignature list" $
|
|
||||||
proposalOut #== expectedDatum
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
--------------------------------------------------------------------------
|
|
||||||
PUnlock r -> unTermCont $ do
|
|
||||||
-- At draft stage, the votes should be empty.
|
|
||||||
pguardC "Shouldn't retract votes from a draft proposal" $
|
|
||||||
pnot #$ proposalF.status #== pconstantData Draft
|
|
||||||
|
|
||||||
-- This is the vote option we're retracting from.
|
|
||||||
retractFrom <- pletC $ pfield @"resultTag" # r
|
|
||||||
|
|
||||||
-- Determine if the input stake is actually locked by this proposal.
|
|
||||||
stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
|
|
||||||
|
|
||||||
pguardC "Stake input relevant" $
|
|
||||||
pmatch stakeUsage $ \case
|
|
||||||
PDidNothing ->
|
|
||||||
ptraceIfFalse "Stake should be relevant" $
|
|
||||||
pconstant False
|
|
||||||
PCreated ->
|
|
||||||
ptraceIfFalse "Removing creator's locks means status is Finished" $
|
|
||||||
proposalF.status #== pconstantData Finished
|
|
||||||
PVotedFor rt ->
|
|
||||||
ptraceIfFalse "Result tag should match the one given in the redeemer" $
|
|
||||||
rt #== retractFrom
|
|
||||||
|
|
||||||
-- The count of removing votes is equal to the 'stakeAmount' of input stake.
|
|
||||||
retractCount <-
|
|
||||||
pletC $
|
|
||||||
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
|
|
||||||
|
|
||||||
-- The votes can only change when the proposal still allows voting.
|
|
||||||
let shouldUpdateVotes =
|
|
||||||
proposalF.status #== pconstantData VotingReady
|
|
||||||
#&& pnot # (pcon PCreated #== stakeUsage)
|
|
||||||
|
|
||||||
pguardC "Proposal output correct" $
|
|
||||||
pif
|
|
||||||
shouldUpdateVotes
|
|
||||||
( let -- Remove votes and leave other parts of the proposal as it.
|
|
||||||
expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
|
|
||||||
|
|
||||||
expectedProposalOut =
|
|
||||||
mkRecordConstr
|
|
||||||
PProposalDatum
|
|
||||||
( #proposalId .= proposalF.proposalId
|
|
||||||
.& #effects .= proposalF.effects
|
|
||||||
.& #status .= proposalF.status
|
|
||||||
.& #cosigners .= proposalF.cosigners
|
|
||||||
.& #thresholds .= proposalF.thresholds
|
|
||||||
.& #votes .= pdata expectedVotes
|
|
||||||
.& #timingConfig .= proposalF.timingConfig
|
|
||||||
.& #startingTime .= proposalF.startingTime
|
|
||||||
)
|
|
||||||
in ptraceIfFalse "Update votes" $
|
|
||||||
expectedProposalOut #== proposalOut
|
|
||||||
)
|
|
||||||
-- No change to the proposal is allowed.
|
|
||||||
$ ptraceIfFalse "Proposal unchanged" proposalUnchanged
|
|
||||||
|
|
||||||
-- At last, we ensure that all locks belong to this proposal will be removed.
|
|
||||||
stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
|
|
||||||
|
|
||||||
let templateStakeOut =
|
|
||||||
mkRecordConstr
|
|
||||||
PStakeDatum
|
|
||||||
( #stakedAmount .= stakeInF.stakedAmount
|
|
||||||
.& #owner .= stakeInF.owner
|
|
||||||
.& #lockedBy .= stakeOutputLocks
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "Only locks updated in the output stake" $
|
|
||||||
templateStakeOut #== stakeOut
|
|
||||||
|
|
||||||
pguardC "All relevant locks removed from the stake" $
|
|
||||||
pgetStakeUsage # pfromData stakeOutputLocks
|
|
||||||
# proposalF.proposalId #== pcon PDidNothing
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
--------------------------------------------------------------------------
|
|
||||||
PAdvanceProposal _r -> unTermCont $ do
|
|
||||||
pguardC "Stake should not change" stakeUnchanged
|
|
||||||
|
|
||||||
proposalOutStatus <- pletC $ pfield @"status" # proposalOut
|
|
||||||
|
|
||||||
let -- Only the status of proposals should be updated in this case.
|
|
||||||
templateProposalOut =
|
|
||||||
mkRecordConstr
|
|
||||||
PProposalDatum
|
|
||||||
( #proposalId .= proposalF.proposalId
|
|
||||||
.& #effects .= proposalF.effects
|
|
||||||
.& #status .= proposalOutStatus
|
|
||||||
.& #cosigners .= proposalF.cosigners
|
|
||||||
.& #thresholds .= proposalF.thresholds
|
|
||||||
.& #votes .= proposalF.votes
|
|
||||||
.& #timingConfig .= proposalF.timingConfig
|
|
||||||
.& #startingTime .= proposalF.startingTime
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "Only status changes in the output proposal" $
|
|
||||||
templateProposalOut #== proposalOut
|
|
||||||
|
|
||||||
inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
|
||||||
inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
|
||||||
inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
|
||||||
inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
|
||||||
|
|
||||||
proposalStatus <- pletC $ pto $ pfromData proposalF.status
|
|
||||||
|
|
||||||
-- Check the timings.
|
|
||||||
let isFinished = proposalF.status #== pconstantData Finished
|
|
||||||
|
|
||||||
notTooLate = pmatchEnum proposalStatus $ \case
|
|
||||||
Draft -> inDraftPeriod
|
|
||||||
-- Can only advance after the voting period is over.
|
|
||||||
VotingReady -> inLockedPeriod
|
|
||||||
Locked -> inExecutionPeriod
|
|
||||||
_ -> pconstant False
|
|
||||||
|
|
||||||
notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case
|
|
||||||
VotingReady -> pnot # inVotingPeriod
|
|
||||||
Locked -> pnot # inLockedPeriod
|
|
||||||
_ -> pconstant True
|
|
||||||
|
|
||||||
pguardC "Cannot advance ahead of time" notTooEarly
|
|
||||||
pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
|
|
||||||
|
|
||||||
thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds
|
|
||||||
|
|
||||||
|
filterStakeDatumHash :: Term _ (PAsData PTxOut :--> PMaybe (PAsData PDatumHash)) <-
|
||||||
|
pletC $
|
||||||
|
plam $ \(pfromData -> txOut) -> unTermCont $ do
|
||||||
|
txOutF <- pletFieldsC @'["value", "datumHash"] txOut
|
||||||
pure $
|
pure $
|
||||||
pif
|
pif
|
||||||
notTooLate
|
(passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1)
|
||||||
-- On time: advance to next status.
|
( let datumHash = pfromDJust # txOutF.datumHash
|
||||||
( pmatchEnum proposalStatus $ \case
|
in pcon $ PJust $ pdata datumHash
|
||||||
Draft -> unTermCont $ do
|
|
||||||
-- TODO: Perform other necessary checks.
|
|
||||||
|
|
||||||
-- 'Draft' -> 'VotingReady'
|
|
||||||
pguardC "Proposal status set to VotingReady" $
|
|
||||||
proposalOutStatus #== pconstantData VotingReady
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
VotingReady -> unTermCont $ do
|
|
||||||
-- 'VotingReady' -> 'Locked'
|
|
||||||
pguardC "Proposal status set to Locked" $
|
|
||||||
proposalOutStatus #== pconstantData Locked
|
|
||||||
|
|
||||||
pguardC "Winner outcome not found" $
|
|
||||||
pisJust #$ pwinner' # proposalF.votes
|
|
||||||
#$ punsafeCoerce
|
|
||||||
$ pfromData thresholdsF.execute
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
Locked -> unTermCont $ do
|
|
||||||
-- 'Locked' -> 'Finished'
|
|
||||||
pguardC "Proposal status set to Finished" $
|
|
||||||
proposalOutStatus #== pconstantData Finished
|
|
||||||
|
|
||||||
-- TODO: Perform other necessary checks.
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
_ -> popaque (pconstant ())
|
|
||||||
)
|
|
||||||
-- Too late: failed proposal, status set to 'Finished'.
|
|
||||||
( popaque $
|
|
||||||
ptraceIfFalse "Proposal should fail: not on time" $
|
|
||||||
proposalOutStatus #== pconstantData Finished
|
|
||||||
-- TODO: Should check that the GST is not moved
|
|
||||||
-- if the proposal is in 'Locked' state.
|
|
||||||
)
|
)
|
||||||
|
(pcon PNothing)
|
||||||
|
|
||||||
|
stakeInputDatumHashes <-
|
||||||
|
pletC $
|
||||||
|
pmapMaybe @PBuiltinList
|
||||||
|
# plam ((filterStakeDatumHash #) . (pfield @"resolved" #))
|
||||||
|
# txInfoF.inputs
|
||||||
|
|
||||||
|
stakeOutputDatumHashes <-
|
||||||
|
pletC $
|
||||||
|
pmapMaybe @PBuiltinList
|
||||||
|
# filterStakeDatumHash
|
||||||
|
# txInfoF.outputs
|
||||||
|
|
||||||
|
stakeInputNum <- pletC $ plength # stakeInputDatumHashes
|
||||||
|
|
||||||
|
pguardC "Every stake input should have a correspoding output" $
|
||||||
|
stakeInputNum #== plength # stakeOutputDatumHashes
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
withMultipleStakes' ::
|
||||||
|
Term
|
||||||
|
_
|
||||||
|
( ( PInteger
|
||||||
|
:--> PBuiltinList (PAsData PPubKeyHash)
|
||||||
|
:--> PUnit
|
||||||
|
)
|
||||||
|
:--> PUnit
|
||||||
|
) <-
|
||||||
|
pletC $
|
||||||
|
plam $ \validationLogic -> unTermCont $ do
|
||||||
|
-- The following code ensures that all the stake datums are not
|
||||||
|
-- changed.
|
||||||
|
--
|
||||||
|
-- TODO: This is quite inefficient (O(nlogn)) but for now we don't
|
||||||
|
-- have a nice way to check this. In plutus v2 we'll have map of
|
||||||
|
-- (Script -> Redeemer) in ScriptContext, which should be the
|
||||||
|
-- straight up solution.
|
||||||
|
let sortDatumHashes = phoistAcyclic $ pmsortBy # pltAsData
|
||||||
|
|
||||||
|
sortedStakeInputDatumHashes =
|
||||||
|
sortDatumHashes # stakeInputDatumHashes
|
||||||
|
|
||||||
|
sortedStakeOutputDatumHashes =
|
||||||
|
sortDatumHashes # stakeOutputDatumHashes
|
||||||
|
|
||||||
|
pguardC "All stake datum are unchanged" $
|
||||||
|
plistEquals
|
||||||
|
# sortedStakeInputDatumHashes
|
||||||
|
# sortedStakeOutputDatumHashes
|
||||||
|
|
||||||
|
PPair totalStakedAmount stakeOwners <-
|
||||||
|
pmatchC $
|
||||||
|
pfoldl
|
||||||
|
# plam
|
||||||
|
( \l dh -> unTermCont $ do
|
||||||
|
let stake =
|
||||||
|
pfromData $
|
||||||
|
pfromJust
|
||||||
|
#$ ptryFindDatum
|
||||||
|
@(PAsData PStakeDatum)
|
||||||
|
# pfromData dh
|
||||||
|
# txInfoF.datums
|
||||||
|
|
||||||
|
stakeF <- pletFieldsC @'["stakedAmount", "owner"] stake
|
||||||
|
|
||||||
|
PPair amount owners <- pmatchC l
|
||||||
|
|
||||||
|
let newAmount = amount + punsafeCoerce (pfromData stakeF.stakedAmount)
|
||||||
|
updatedOwners = pcons # stakeF.owner # owners
|
||||||
|
|
||||||
|
pure $ pcon $ PPair newAmount updatedOwners
|
||||||
|
)
|
||||||
|
# pcon (PPair (0 :: Term _ PInteger) (pnil @PBuiltinList))
|
||||||
|
# stakeInputDatumHashes
|
||||||
|
|
||||||
|
sortedStakeOwners <- pletC $ pmsortBy # pltAsData # stakeOwners
|
||||||
|
|
||||||
|
pure $ validationLogic # totalStakedAmount # sortedStakeOwners
|
||||||
|
|
||||||
|
withSingleStake' ::
|
||||||
|
Term
|
||||||
|
_
|
||||||
|
( ( PStakeDatum :--> PStakeDatum :--> PBool :--> PUnit
|
||||||
|
)
|
||||||
|
:--> PUnit
|
||||||
|
) <- pletC $
|
||||||
|
plam $ \validationLogic -> unTermCont $ do
|
||||||
|
pguardC "Can only deal with one stake" $
|
||||||
|
stakeInputNum #== 1
|
||||||
|
|
||||||
|
stakeInputHash <- pletC $ pfromData $ phead # stakeInputDatumHashes
|
||||||
|
stakeOutputHash <- pletC $ pfromData $ phead # stakeOutputDatumHashes
|
||||||
|
|
||||||
|
stakeIn :: Term _ PStakeDatum <-
|
||||||
|
pletC $
|
||||||
|
pfromData $
|
||||||
|
pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
|
||||||
|
|
||||||
|
stakeOut :: Term _ PStakeDatum <-
|
||||||
|
pletC $
|
||||||
|
pfromData $
|
||||||
|
pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
|
||||||
|
|
||||||
|
stakeUnchanged <- pletC $ stakeInputHash #== stakeOutputHash
|
||||||
|
|
||||||
|
pure $ validationLogic # stakeIn # stakeOut # stakeUnchanged
|
||||||
|
|
||||||
|
let withMultipleStakes val =
|
||||||
|
withMultipleStakes' #$ plam $
|
||||||
|
\totalStakedAmount
|
||||||
|
sortedStakeOwner ->
|
||||||
|
unTermCont $
|
||||||
|
val totalStakedAmount sortedStakeOwner
|
||||||
|
|
||||||
|
withSingleStake val =
|
||||||
|
withSingleStake' #$ plam $ \stakeIn stakeOut stakeUnchange -> unTermCont $ do
|
||||||
|
stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
|
||||||
|
|
||||||
|
val stakeInF stakeOut stakeUnchange
|
||||||
|
|
||||||
|
pure $
|
||||||
|
popaque $
|
||||||
|
pmatch proposalRedeemer $ \case
|
||||||
|
PCosign r -> withMultipleStakes $ \_ sortedStakeOwners -> do
|
||||||
|
pguardC "Should be in draft state" $
|
||||||
|
currentStatus #== pconstant Draft
|
||||||
|
|
||||||
|
newSigs <- pletC $ pfield @"newCosigners" # r
|
||||||
|
|
||||||
|
pguardC "Signed by all new cosigners" $
|
||||||
|
pall # signedBy # newSigs
|
||||||
|
|
||||||
|
updatedSigs <-
|
||||||
|
pletC $
|
||||||
|
pmergeBy # pltAsData
|
||||||
|
# newSigs
|
||||||
|
# proposalF.cosigners
|
||||||
|
|
||||||
|
pguardC "Cosigners are unique" $
|
||||||
|
pisUniq' # updatedSigs
|
||||||
|
|
||||||
|
pguardC "All new cosigners are witnessed by their Stake datums" $
|
||||||
|
plistEquals # sortedStakeOwners # newSigs
|
||||||
|
|
||||||
|
let expectedDatum =
|
||||||
|
mkRecordConstr
|
||||||
|
PProposalDatum
|
||||||
|
( #proposalId .= proposalF.proposalId
|
||||||
|
.& #effects .= proposalF.effects
|
||||||
|
.& #status .= proposalF.status
|
||||||
|
.& #cosigners .= pdata updatedSigs
|
||||||
|
.& #thresholds .= proposalF.thresholds
|
||||||
|
.& #votes .= proposalF.votes
|
||||||
|
.& #timingConfig .= proposalF.timingConfig
|
||||||
|
.& #startingTime .= proposalF.startingTime
|
||||||
|
)
|
||||||
|
|
||||||
|
pguardC "Signatures are correctly added to cosignature list" $
|
||||||
|
proposalOut #== expectedDatum
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
PVote r -> withSingleStake $ \stakeInF stakeOut _ -> do
|
||||||
|
pguardC "Input proposal must be in VotingReady state" $
|
||||||
|
currentStatus #== pconstant VotingReady
|
||||||
|
|
||||||
|
pguardC "Proposal time should be wthin the voting period" $
|
||||||
|
isVotingPeriod # proposalF.timingConfig
|
||||||
|
# proposalF.startingTime
|
||||||
|
# currentTime
|
||||||
|
|
||||||
|
-- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
|
||||||
|
PProposalVotes voteMap <- pmatchC proposalF.votes
|
||||||
|
voteFor <- pletC $ pfromData $ pfield @"resultTag" # r
|
||||||
|
|
||||||
|
pguardC "Vote option should be valid" $
|
||||||
|
pisJust #$ plookup # voteFor # voteMap
|
||||||
|
|
||||||
|
-- Ensure that no lock with the current proposal id has been put on the stake.
|
||||||
|
pguardC "Same stake shouldn't vote on the same proposal twice" $
|
||||||
|
pnot #$ pany
|
||||||
|
# plam
|
||||||
|
( \((pfield @"proposalTag" #) . pfromData -> pid) ->
|
||||||
|
pid #== proposalF.proposalId
|
||||||
|
)
|
||||||
|
# pfromData stakeInF.lockedBy
|
||||||
|
|
||||||
|
let -- The amount of new votes should be the 'stakedAmount'.
|
||||||
|
-- Update the vote counter of the proposal, and leave other stuff as is.
|
||||||
|
expectedNewVotes = pmatch (pfromData proposalF.votes) $ \(PProposalVotes m) ->
|
||||||
|
pcon $
|
||||||
|
PProposalVotes $
|
||||||
|
pupdate
|
||||||
|
# plam
|
||||||
|
( \votes -> unTermCont $ do
|
||||||
|
PDiscrete v <- pmatchC stakeInF.stakedAmount
|
||||||
|
pure $ pcon $ PJust $ votes + (pextract # v)
|
||||||
|
)
|
||||||
|
# voteFor
|
||||||
|
# m
|
||||||
|
expectedProposalOut =
|
||||||
|
mkRecordConstr
|
||||||
|
PProposalDatum
|
||||||
|
( #proposalId .= proposalF.proposalId
|
||||||
|
.& #effects .= proposalF.effects
|
||||||
|
.& #status .= proposalF.status
|
||||||
|
.& #cosigners .= proposalF.cosigners
|
||||||
|
.& #thresholds .= proposalF.thresholds
|
||||||
|
.& #votes .= pdata expectedNewVotes
|
||||||
|
.& #timingConfig .= proposalF.timingConfig
|
||||||
|
.& #startingTime .= proposalF.startingTime
|
||||||
|
)
|
||||||
|
|
||||||
|
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
|
||||||
|
|
||||||
|
-- We validate the output stake datum here as well: We need the vote option
|
||||||
|
-- to create a valid 'ProposalLock', however the vote option is encoded
|
||||||
|
-- in the proposal redeemer, which is invisible for the stake validator.
|
||||||
|
|
||||||
|
let newProposalLock =
|
||||||
|
mkRecordConstr
|
||||||
|
PProposalLock
|
||||||
|
( #vote .= pdata voteFor
|
||||||
|
.& #proposalTag .= proposalF.proposalId
|
||||||
|
)
|
||||||
|
-- Prepend the new lock to existing locks
|
||||||
|
expectedProposalLocks =
|
||||||
|
pcons
|
||||||
|
# pdata newProposalLock
|
||||||
|
# pfromData stakeInF.lockedBy
|
||||||
|
expectedStakeOut =
|
||||||
|
mkRecordConstr
|
||||||
|
PStakeDatum
|
||||||
|
( #stakedAmount .= stakeInF.stakedAmount
|
||||||
|
.& #owner .= stakeInF.owner
|
||||||
|
.& #lockedBy .= pdata expectedProposalLocks
|
||||||
|
)
|
||||||
|
|
||||||
|
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
PUnlock r -> withSingleStake $ \stakeInF stakeOut _ -> do
|
||||||
|
-- At draft stage, the votes should be empty.
|
||||||
|
pguardC "Shouldn't retract votes from a draft proposal" $
|
||||||
|
pnot #$ currentStatus #== pconstant Draft
|
||||||
|
|
||||||
|
-- This is the vote option we're retracting from.
|
||||||
|
retractFrom <- pletC $ pfield @"resultTag" # r
|
||||||
|
|
||||||
|
-- Determine if the input stake is actually locked by this proposal.
|
||||||
|
stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
|
||||||
|
|
||||||
|
pguardC "Stake input relevant" $
|
||||||
|
pmatch stakeUsage $ \case
|
||||||
|
PDidNothing ->
|
||||||
|
ptraceIfFalse "Stake should be relevant" $
|
||||||
|
pconstant False
|
||||||
|
PCreated ->
|
||||||
|
ptraceIfFalse "Removing creator's locks means status is Finished" $
|
||||||
|
currentStatus #== pconstant Finished
|
||||||
|
PVotedFor rt ->
|
||||||
|
ptraceIfFalse "Result tag should match the one given in the redeemer" $
|
||||||
|
rt #== retractFrom
|
||||||
|
|
||||||
|
-- The count of removing votes is equal to the 'stakeAmount' of input stake.
|
||||||
|
retractCount <-
|
||||||
|
pletC $
|
||||||
|
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
|
||||||
|
|
||||||
|
-- The votes can only change when the proposal still allows voting.
|
||||||
|
let shouldUpdateVotes =
|
||||||
|
currentStatus #== pconstant VotingReady
|
||||||
|
#&& pnot # (pcon PCreated #== stakeUsage)
|
||||||
|
|
||||||
|
pguardC "Proposal output correct" $
|
||||||
|
pif
|
||||||
|
shouldUpdateVotes
|
||||||
|
( let -- Remove votes and leave other parts of the proposal as it.
|
||||||
|
expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
|
||||||
|
|
||||||
|
expectedProposalOut =
|
||||||
|
mkRecordConstr
|
||||||
|
PProposalDatum
|
||||||
|
( #proposalId .= proposalF.proposalId
|
||||||
|
.& #effects .= proposalF.effects
|
||||||
|
.& #status .= proposalF.status
|
||||||
|
.& #cosigners .= proposalF.cosigners
|
||||||
|
.& #thresholds .= proposalF.thresholds
|
||||||
|
.& #votes .= pdata expectedVotes
|
||||||
|
.& #timingConfig .= proposalF.timingConfig
|
||||||
|
.& #startingTime .= proposalF.startingTime
|
||||||
|
)
|
||||||
|
in ptraceIfFalse "Update votes" $
|
||||||
|
expectedProposalOut #== proposalOut
|
||||||
|
)
|
||||||
|
-- No change to the proposal is allowed.
|
||||||
|
$ ptraceIfFalse "Proposal unchanged" proposalUnchanged
|
||||||
|
|
||||||
|
-- At last, we ensure that all locks belong to this proposal will be removed.
|
||||||
|
stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
|
||||||
|
|
||||||
|
let templateStakeOut =
|
||||||
|
mkRecordConstr
|
||||||
|
PStakeDatum
|
||||||
|
( #stakedAmount .= stakeInF.stakedAmount
|
||||||
|
.& #owner .= stakeInF.owner
|
||||||
|
.& #lockedBy .= stakeOutputLocks
|
||||||
|
)
|
||||||
|
|
||||||
|
pguardC "Only locks updated in the output stake" $
|
||||||
|
templateStakeOut #== stakeOut
|
||||||
|
|
||||||
|
pguardC "All relevant locks removed from the stake" $
|
||||||
|
pgetStakeUsage # pfromData stakeOutputLocks
|
||||||
|
# proposalF.proposalId #== pcon PDidNothing
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
PAdvanceProposal _ ->
|
||||||
|
let fromDraft = withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
|
||||||
|
pmatchC (isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime) >>= \case
|
||||||
|
PTrue -> do
|
||||||
|
pguardC "More cosigns than minimum amount" $
|
||||||
|
punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
|
||||||
|
|
||||||
|
pguardC "All new cosigners are witnessed by their Stake datums" $
|
||||||
|
plistEquals # sortedStakeOwners # proposalF.cosigners
|
||||||
|
|
||||||
|
-- 'Draft' -> 'VotingReady'
|
||||||
|
pguardC "Proposal status set to VotingReady" $
|
||||||
|
proposalOutStatus #== pconstant VotingReady
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
PFalse -> do
|
||||||
|
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
fromOther = withSingleStake $ \_ _ stakeUnchanged -> do
|
||||||
|
pguardC "Stake should not change" stakeUnchanged
|
||||||
|
|
||||||
|
pguardC
|
||||||
|
"Only status changes in the output proposal"
|
||||||
|
onlyStatusChanged
|
||||||
|
|
||||||
|
inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
||||||
|
inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
||||||
|
inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
||||||
|
|
||||||
|
proposalStatus <- pletC $ pto $ pfromData proposalF.status
|
||||||
|
|
||||||
|
-- Check the timings.
|
||||||
|
let isFinished = currentStatus #== pconstant Finished
|
||||||
|
|
||||||
|
notTooLate = pmatchEnum proposalStatus $ \case
|
||||||
|
-- Can only advance after the voting period is over.
|
||||||
|
VotingReady -> inLockedPeriod
|
||||||
|
Locked -> inExecutionPeriod
|
||||||
|
_ -> pconstant False
|
||||||
|
|
||||||
|
notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case
|
||||||
|
VotingReady -> pnot # inVotingPeriod
|
||||||
|
Locked -> pnot # inLockedPeriod
|
||||||
|
_ -> pconstant True
|
||||||
|
|
||||||
|
pguardC "Cannot advance ahead of time" notTooEarly
|
||||||
|
pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
|
||||||
|
|
||||||
|
let toFailedState = unTermCont $ do
|
||||||
|
pguardC "Proposal should fail: not on time" $
|
||||||
|
proposalOutStatus #== pconstant Finished
|
||||||
|
|
||||||
|
-- TODO: Should check that the GST is not moved
|
||||||
|
-- if the proposal is in 'Locked' state.
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
toNextState = pmatchEnum proposalStatus $ \case
|
||||||
|
VotingReady -> unTermCont $ do
|
||||||
|
-- 'VotingReady' -> 'Locked'
|
||||||
|
pguardC "Proposal status set to Locked" $
|
||||||
|
proposalOutStatus #== pconstant Locked
|
||||||
|
|
||||||
|
pguardC "Winner outcome not found" $
|
||||||
|
pisJust #$ pwinner' # proposalF.votes
|
||||||
|
#$ punsafeCoerce
|
||||||
|
$ pfromData thresholdsF.execute
|
||||||
|
|
||||||
|
pure $ pconstant ()
|
||||||
|
Locked -> unTermCont $ do
|
||||||
|
-- 'Locked' -> 'Finished'
|
||||||
|
pguardC "Proposal status set to Finished" $
|
||||||
|
proposalOutStatus #== pconstant Finished
|
||||||
|
|
||||||
|
-- TODO: Perform other necessary checks.
|
||||||
|
pure $ pconstant ()
|
||||||
|
_ -> pconstant ()
|
||||||
|
|
||||||
|
pure $
|
||||||
|
pif
|
||||||
|
notTooLate
|
||||||
|
-- On time: advance to next status.
|
||||||
|
toNextState
|
||||||
|
-- Too late: failed proposal, status set to 'Finished'.
|
||||||
|
toFailedState
|
||||||
|
in pif (currentStatus #== pconstant Draft) fromDraft fromOther
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,6 @@ module Agora.Stake (
|
||||||
|
|
||||||
-- * Utility functions
|
-- * Utility functions
|
||||||
stakeLocked,
|
stakeLocked,
|
||||||
findStakeOwnedBy,
|
|
||||||
pgetStakeUsage,
|
pgetStakeUsage,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
@ -33,16 +32,8 @@ import Data.Tagged (Tagged (..))
|
||||||
import GHC.Generics qualified as GHC
|
import GHC.Generics qualified as GHC
|
||||||
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
|
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
|
||||||
import Plutarch.Api.V1 (
|
import Plutarch.Api.V1 (
|
||||||
PDatum,
|
|
||||||
PDatumHash,
|
|
||||||
PMaybeData (PDJust, PDNothing),
|
|
||||||
PPubKeyHash,
|
PPubKeyHash,
|
||||||
PTuple,
|
|
||||||
PTxInInfo (PTxInInfo),
|
|
||||||
PTxOut (PTxOut),
|
|
||||||
)
|
)
|
||||||
import Plutarch.Api.V1.AssetClass (PAssetClass, passetClassValueOf)
|
|
||||||
import Plutarch.Api.V1.ScriptContext (ptryFindDatum)
|
|
||||||
import Plutarch.DataRepr (
|
import Plutarch.DataRepr (
|
||||||
DerivePConstantViaData (..),
|
DerivePConstantViaData (..),
|
||||||
PDataFields,
|
PDataFields,
|
||||||
|
|
@ -54,8 +45,7 @@ import Plutarch.Extra.IsData (
|
||||||
)
|
)
|
||||||
import Plutarch.Extra.List (pmapMaybe, pnotNull)
|
import Plutarch.Extra.List (pmapMaybe, pnotNull)
|
||||||
import Plutarch.Extra.Other (DerivePNewtype' (..))
|
import Plutarch.Extra.Other (DerivePNewtype' (..))
|
||||||
import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC)
|
import Plutarch.Extra.TermCont (pletFieldsC)
|
||||||
import Plutarch.Internal (punsafeCoerce)
|
|
||||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||||
import Plutarch.SafeMoney (PDiscrete)
|
import Plutarch.SafeMoney (PDiscrete)
|
||||||
import PlutusLedgerApi.V1 (PubKeyHash)
|
import PlutusLedgerApi.V1 (PubKeyHash)
|
||||||
|
|
@ -327,73 +317,6 @@ stakeLocked = phoistAcyclic $
|
||||||
locks = pfield @"lockedBy" # stakeDatum
|
locks = pfield @"lockedBy" # stakeDatum
|
||||||
in pnotNull # locks
|
in pnotNull # locks
|
||||||
|
|
||||||
{- | Find a stake owned by a particular PK.
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
findStakeOwnedBy ::
|
|
||||||
Term
|
|
||||||
s
|
|
||||||
( PAssetClass
|
|
||||||
:--> PPubKeyHash
|
|
||||||
:--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
|
|
||||||
:--> PBuiltinList (PAsData PTxInInfo)
|
|
||||||
:--> PMaybe (PAsData PStakeDatum)
|
|
||||||
)
|
|
||||||
findStakeOwnedBy = phoistAcyclic $
|
|
||||||
plam $ \ac pk datums inputs ->
|
|
||||||
pmatch (pfind # (isInputStakeOwnedBy # ac # pk # datums) # inputs) $ \case
|
|
||||||
PNothing -> pcon PNothing
|
|
||||||
PJust (pfromData -> v) -> unTermCont $ do
|
|
||||||
let txOut = pfield @"resolved" # pto v
|
|
||||||
txOutF <- pletFieldsC @'["datumHash"] $ txOut
|
|
||||||
pure $
|
|
||||||
pmatch txOutF.datumHash $ \case
|
|
||||||
PDNothing _ -> pcon PNothing
|
|
||||||
PDJust ((pfield @"_0" #) -> dh) ->
|
|
||||||
ptryFindDatum @(PAsData PStakeDatum) # dh # datums
|
|
||||||
|
|
||||||
{- | Check if a StakeDatum is owned by a particular public key.
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
stakeDatumOwnedBy :: Term _ (PPubKeyHash :--> PStakeDatum :--> PBool)
|
|
||||||
stakeDatumOwnedBy =
|
|
||||||
phoistAcyclic $
|
|
||||||
plam $ \pk stakeDatum ->
|
|
||||||
pletFields @'["owner"] (pto stakeDatum) $ \stakeDatumF ->
|
|
||||||
stakeDatumF.owner #== pdata pk
|
|
||||||
|
|
||||||
{- | Does the input have a `Stake` owned by a particular PK?
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
isInputStakeOwnedBy ::
|
|
||||||
Term
|
|
||||||
_
|
|
||||||
( PAssetClass :--> PPubKeyHash
|
|
||||||
:--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
|
|
||||||
:--> PAsData PTxInInfo
|
|
||||||
:--> PBool
|
|
||||||
)
|
|
||||||
isInputStakeOwnedBy =
|
|
||||||
plam $ \ac ss datums txInInfo' -> unTermCont $ do
|
|
||||||
PTxInInfo ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfromData txInInfo'
|
|
||||||
PTxOut txOut' <- pmatchC txOut
|
|
||||||
txOutF <- pletFieldsC @'["value", "datumHash"] txOut'
|
|
||||||
outStakeST <- pletC $ passetClassValueOf # txOutF.value # ac
|
|
||||||
pure $
|
|
||||||
pmatch txOutF.datumHash $ \case
|
|
||||||
PDNothing _ -> pcon PFalse
|
|
||||||
PDJust ((pfield @"_0" #) -> datumHash) ->
|
|
||||||
pif
|
|
||||||
(outStakeST #== 1)
|
|
||||||
( pmatch (ptryFindDatum @(PAsData PStakeDatum) # datumHash # datums) $ \case
|
|
||||||
PNothing -> pcon PFalse
|
|
||||||
PJust v -> stakeDatumOwnedBy # ss # pfromData (punsafeCoerce v)
|
|
||||||
)
|
|
||||||
(pcon PFalse)
|
|
||||||
|
|
||||||
{- | Represent the usage of a stake on a particular proposal.
|
{- | Represent the usage of a stake on a particular proposal.
|
||||||
A stake can be used to either create or vote on a proposal.
|
A stake can be used to either create or vote on a proposal.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -8,28 +8,44 @@ Plutus Scripts for Stakes.
|
||||||
module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
|
module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
|
||||||
|
|
||||||
import Agora.SafeMoney (GTTag)
|
import Agora.SafeMoney (GTTag)
|
||||||
import Agora.Stake
|
import Agora.Stake (
|
||||||
|
PStakeDatum (PStakeDatum),
|
||||||
|
PStakeRedeemer (
|
||||||
|
PDepositWithdraw,
|
||||||
|
PDestroy,
|
||||||
|
PPermitVote,
|
||||||
|
PRetractVotes
|
||||||
|
),
|
||||||
|
Stake (gtClassRef, proposalSTClass),
|
||||||
|
StakeRedeemer (WitnessStake),
|
||||||
|
stakeLocked,
|
||||||
|
)
|
||||||
import Agora.Utils (
|
import Agora.Utils (
|
||||||
mustBePJust,
|
mustBePJust,
|
||||||
mustFindDatum',
|
mustFindDatum',
|
||||||
pvalidatorHashToTokenName,
|
pvalidatorHashToTokenName,
|
||||||
)
|
)
|
||||||
|
import Data.Function (on)
|
||||||
import Data.Tagged (Tagged (..), untag)
|
import Data.Tagged (Tagged (..), untag)
|
||||||
import Plutarch.Api.V1 (
|
import Plutarch.Api.V1 (
|
||||||
AmountGuarantees (Positive),
|
AmountGuarantees (Positive),
|
||||||
PCredential (PPubKeyCredential, PScriptCredential),
|
PCredential (PPubKeyCredential, PScriptCredential),
|
||||||
|
PDatumHash,
|
||||||
PMintingPolicy,
|
PMintingPolicy,
|
||||||
PScriptPurpose (PMinting, PSpending),
|
PScriptPurpose (PMinting, PSpending),
|
||||||
PTokenName,
|
PTokenName,
|
||||||
PTxInfo,
|
PTxInfo,
|
||||||
|
PTxOut,
|
||||||
PValidator,
|
PValidator,
|
||||||
PValue,
|
PValue,
|
||||||
mintingPolicySymbol,
|
mintingPolicySymbol,
|
||||||
mkMintingPolicy,
|
mkMintingPolicy,
|
||||||
)
|
)
|
||||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
|
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
|
||||||
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisTokenSpent, ptxSignedBy, pvalueSpent)
|
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
|
||||||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
|
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
|
||||||
|
import Plutarch.Extra.List (pmapMaybe, pmsortBy)
|
||||||
|
import Plutarch.Extra.Maybe (pfromDJust)
|
||||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||||
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
|
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
|
||||||
import Plutarch.Internal (punsafeCoerce)
|
import Plutarch.Internal (punsafeCoerce)
|
||||||
|
|
@ -208,7 +224,15 @@ stakeValidator stake =
|
||||||
plam $ \datum redeemer ctx' -> unTermCont $ do
|
plam $ \datum redeemer ctx' -> unTermCont $ do
|
||||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||||
txInfo <- pletC $ pfromData ctx.txInfo
|
txInfo <- pletC $ pfromData ctx.txInfo
|
||||||
txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "signatories", "datums"] txInfo
|
txInfoF <-
|
||||||
|
pletFieldsC
|
||||||
|
@'[ "mint"
|
||||||
|
, "inputs"
|
||||||
|
, "outputs"
|
||||||
|
, "signatories"
|
||||||
|
, "datums"
|
||||||
|
]
|
||||||
|
txInfo
|
||||||
|
|
||||||
(pfromData -> stakeRedeemer, _) <- ptryFromC redeemer
|
(pfromData -> stakeRedeemer, _) <- ptryFromC redeemer
|
||||||
|
|
||||||
|
|
@ -219,23 +243,25 @@ stakeValidator stake =
|
||||||
|
|
||||||
PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
|
PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
|
||||||
|
|
||||||
PJust txInInfo <- pmatchC $ pfindTxInByTxOutRef # (pfield @"_0" # txOutRef) # txInfoF.inputs
|
PJust ((pfield @"resolved" #) -> resolved) <-
|
||||||
ownAddress <- pletC $ pfield @"address" #$ pfield @"resolved" # txInInfo
|
pmatchC $
|
||||||
let continuingValue :: Term _ (PValue _ _)
|
pfindTxInByTxOutRef
|
||||||
continuingValue = pfield @"value" #$ pfield @"resolved" # txInInfo
|
# (pfield @"_0" # txOutRef)
|
||||||
|
# txInfoF.inputs
|
||||||
|
resolvedF <- pletFieldsC @'["address", "value", "datumHash"] resolved
|
||||||
|
|
||||||
-- Whether the owner signs this transaction or not.
|
-- Whether the owner signs this transaction or not.
|
||||||
ownerSignsTransaction <- pletC $ ptxSignedBy # txInfoF.signatories # stakeDatum.owner
|
ownerSignsTransaction <- pletC $ ptxSignedBy # txInfoF.signatories # stakeDatum.owner
|
||||||
|
|
||||||
stCurrencySymbol <- pletC $ pconstant $ mintingPolicySymbol $ mkMintingPolicy (stakePolicy stake.gtClassRef)
|
stCurrencySymbol <-
|
||||||
|
pletC $
|
||||||
|
pconstant $
|
||||||
|
mintingPolicySymbol $
|
||||||
|
mkMintingPolicy (stakePolicy stake.gtClassRef)
|
||||||
mintedST <- pletC $ psymbolValueOf # stCurrencySymbol # txInfoF.mint
|
mintedST <- pletC $ psymbolValueOf # stCurrencySymbol # txInfoF.mint
|
||||||
valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
|
valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
|
||||||
spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
|
spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
|
||||||
|
|
||||||
let AssetClass (propCs, propTn) = stake.proposalSTClass
|
|
||||||
proposalSTClass = passetClass # pconstant propCs # pconstant propTn
|
|
||||||
spentProposalST <- pletC $ passetClassValueOf # valueSpent # proposalSTClass
|
|
||||||
|
|
||||||
-- Is the stake currently locked?
|
-- Is the stake currently locked?
|
||||||
stakeIsLocked <- pletC $ stakeLocked # stakeDatum'
|
stakeIsLocked <- pletC $ stakeLocked # stakeDatum'
|
||||||
|
|
||||||
|
|
@ -253,196 +279,229 @@ stakeValidator stake =
|
||||||
pguardC "Owner signs this transaction" ownerSignsTransaction
|
pguardC "Owner signs this transaction" ownerSignsTransaction
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
pure $ popaque (pconstant ())
|
||||||
--------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
-- Handle redeemers that require own stake output.
|
-- Handle redeemers that require own stake output.
|
||||||
|
|
||||||
_ -> unTermCont $ do
|
_ -> unTermCont $ do
|
||||||
-- Filter out own output with own address and PST.
|
let AssetClass (propCs, propTn) = stake.proposalSTClass
|
||||||
ownOutput <-
|
proposalSTClass = passetClass # pconstant propCs # pconstant propTn
|
||||||
|
spentProposalST = passetClassValueOf # valueSpent # proposalSTClass
|
||||||
|
|
||||||
|
proposalTokenMoved <- pletC $ spentProposalST #== 1
|
||||||
|
|
||||||
|
-- Filter out own outputs using own address and ST.
|
||||||
|
ownOutputs <-
|
||||||
pletC $
|
pletC $
|
||||||
mustBePJust # "Own output should be present" #$ pfind
|
pfilter
|
||||||
# plam
|
# plam
|
||||||
( \input -> unTermCont $ do
|
( \output -> unTermCont $ do
|
||||||
inputF <- pletFieldsC @'["address", "value"] input
|
outputF <- pletFieldsC @'["address", "value"] output
|
||||||
|
|
||||||
pure $
|
pure $
|
||||||
inputF.address #== ownAddress
|
outputF.address #== resolvedF.address
|
||||||
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
|
#&& psymbolValueOf # stCurrencySymbol # outputF.value #== 1
|
||||||
)
|
)
|
||||||
# pfromData txInfoF.outputs
|
# pfromData txInfoF.outputs
|
||||||
|
|
||||||
stakeOut <-
|
let witnessStake = unTermCont $ do
|
||||||
pletC $
|
pguardC "Either owner signs the transaction or proposal token moved" $
|
||||||
mustFindDatum' @PStakeDatum
|
ownerSignsTransaction #|| proposalTokenMoved
|
||||||
# (pfield @"datumHash" # ownOutput)
|
|
||||||
# txInfoF.datums
|
|
||||||
|
|
||||||
ownOutputValue <-
|
-- FIXME: remove this once we have reference input.
|
||||||
pletC $
|
--
|
||||||
pfield @"value" # ownOutput
|
-- Our goal here is to allow multiple input stakes, and also ensure that every the input stakes has a
|
||||||
|
-- corresponding output stake, which carries the same value and the same datum as the input stake.
|
||||||
ownOutputValueUnchanged <-
|
--
|
||||||
pletC $
|
-- Validation strategy I have tried/considered so far:
|
||||||
pdata continuingValue #== pdata ownOutputValue
|
-- 1. Check that the number of input stakes equals to the number of output stakes, and verify
|
||||||
|
-- that there's an output stake with the exact same value and datum hash as the stake being
|
||||||
stakeOutUnchanged <-
|
-- validated , However this approach has a fatal vulnerability: let's say we have two totally
|
||||||
pletC $
|
-- identical stakes, a malicious user can comsume these two stakes and remove GTs from one of them.
|
||||||
pdata stakeOut #== pdata stakeDatum'
|
-- 2. Perform the same checks as the last approch does, while also checking that every output stake is
|
||||||
|
-- valid(stakedAmount == actual value). However this requires that all the output stake datum are
|
||||||
pure $
|
-- included in the transaction, and we have to find and go through them one by one to access the
|
||||||
pmatch stakeRedeemer $ \case
|
-- 'stakedAmount' fields, meaning that computationally this approach is *very* expensive.
|
||||||
PRetractVotes l -> unTermCont $ do
|
-- 3. The one implemented below. Find all the continuous input/output, sort them by 'datumHash', and
|
||||||
pguardC
|
-- ensure that the two sorted lists are equal.
|
||||||
"Owner signs this transaction"
|
let ownInputs =
|
||||||
ownerSignsTransaction
|
pmapMaybe
|
||||||
|
# plam
|
||||||
pguardC "ST at inputs must be 1" $
|
( \input -> plet (pfield @"resolved" # input) $ \resolvedInput ->
|
||||||
spentST #== 1
|
let value = pfield @"value" # resolvedInput
|
||||||
|
in pif
|
||||||
-- This puts trust into the Proposal. The Proposal must necessarily check
|
(psymbolValueOf # stCurrencySymbol # value #== 1)
|
||||||
-- that this is not abused.
|
(pcon $ PJust resolvedInput)
|
||||||
pguardC "Proposal ST spent" $
|
(pcon PNothing)
|
||||||
spentProposalST #== 1
|
|
||||||
|
|
||||||
pguardC "A UTXO must exist with the correct output" $
|
|
||||||
let expectedLocks = pfield @"locks" # l
|
|
||||||
|
|
||||||
expectedDatum =
|
|
||||||
mkRecordConstr
|
|
||||||
PStakeDatum
|
|
||||||
( #stakedAmount .= stakeDatum.stakedAmount
|
|
||||||
.& #owner .= stakeDatum.owner
|
|
||||||
.& #lockedBy .= expectedLocks
|
|
||||||
)
|
)
|
||||||
|
# pfromData txInfoF.inputs
|
||||||
|
|
||||||
valueCorrect = ownOutputValueUnchanged
|
sortTxOuts :: Term _ (PBuiltinList (PAsData PTxOut) :--> PBuiltinList (PAsData PTxOut))
|
||||||
outputDatumCorrect = stakeOut #== expectedDatum
|
sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #)
|
||||||
in foldl1
|
where
|
||||||
(#&&)
|
getDatumHash :: Term _ (PAsData PTxOut :--> PDatumHash)
|
||||||
[ ptraceIfFalse "valueCorrect" valueCorrect
|
getDatumHash = phoistAcyclic $ plam ((pfromDJust #) . pfromData . (pfield @"datumHash" #))
|
||||||
, ptraceIfFalse "datumCorrect" outputDatumCorrect
|
|
||||||
]
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
sortedOwnInputs = sortTxOuts # ownInputs
|
||||||
--------------------------------------------------------------------------
|
sortedOwnOutputs = sortTxOuts # ownOutputs
|
||||||
PPermitVote l -> unTermCont $ do
|
|
||||||
pguardC
|
|
||||||
"Owner signs this transaction"
|
|
||||||
ownerSignsTransaction
|
|
||||||
|
|
||||||
-- This puts trust into the Proposal. The Proposal must necessarily check
|
pguardC "Every stake inputs has a corresponding unchanged output" $
|
||||||
-- that this is not abused.
|
plistEquals # sortedOwnInputs # sortedOwnOutputs
|
||||||
pguardC "Proposal ST spent" $
|
|
||||||
spentProposalST #== 1
|
|
||||||
|
|
||||||
-- Update the stake datum, but only the 'lockedBy' field.
|
pure $ popaque $ pconstant ()
|
||||||
|
|
||||||
let -- We actually don't know whether the given lock is valid or not.
|
----------------------------------------------------------------------
|
||||||
-- This is checked in the proposal validator.
|
|
||||||
newLock = pfield @"lock" # l
|
|
||||||
-- Prepend the new lock to the existing locks.
|
|
||||||
expectedLocks = pcons # newLock # stakeDatum.lockedBy
|
|
||||||
|
|
||||||
expectedDatum <-
|
let onlyAcceptOneStake = unTermCont $ do
|
||||||
|
pguardC "ST at inputs must be 1" $
|
||||||
|
spentST #== 1
|
||||||
|
|
||||||
|
ownOutput <- pletC $ pfromData $ phead # ownOutputs
|
||||||
|
|
||||||
|
stakeOut <-
|
||||||
pletC $
|
pletC $
|
||||||
mkRecordConstr
|
mustFindDatum' @PStakeDatum
|
||||||
PStakeDatum
|
# (pfield @"datumHash" # ownOutput)
|
||||||
( #stakedAmount .= stakeDatum.stakedAmount
|
# txInfoF.datums
|
||||||
.& #owner .= stakeDatum.owner
|
|
||||||
.& #lockedBy .= pdata expectedLocks
|
|
||||||
)
|
|
||||||
|
|
||||||
pguardC "A UTXO must exist with the correct output" $
|
ownOutputValue <-
|
||||||
let correctOutputDatum = stakeOut #== expectedDatum
|
pletC $
|
||||||
valueCorrect = ownOutputValueUnchanged
|
pfield @"value" # ownOutput
|
||||||
in foldl1
|
|
||||||
(#&&)
|
|
||||||
[ ptraceIfFalse "valueCorrect" valueCorrect
|
|
||||||
, ptraceIfFalse "datumCorrect" correctOutputDatum
|
|
||||||
]
|
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
ownOutputValueUnchanged <-
|
||||||
--------------------------------------------------------------------------
|
pletC $
|
||||||
PWitnessStake _ -> unTermCont $ do
|
pdata resolvedF.value #== pdata ownOutputValue
|
||||||
pguardC "ST at inputs must be 1" $
|
|
||||||
spentST #== 1
|
|
||||||
|
|
||||||
let AssetClass (propCs, propTn) = stake.proposalSTClass
|
pure $
|
||||||
propAssetClass = passetClass # pconstant propCs # pconstant propTn
|
pmatch stakeRedeemer $ \case
|
||||||
proposalTokenMoved =
|
PRetractVotes l -> unTermCont $ do
|
||||||
pisTokenSpent
|
pguardC
|
||||||
# propAssetClass
|
"Owner signs this transaction"
|
||||||
# txInfoF.inputs
|
ownerSignsTransaction
|
||||||
|
|
||||||
-- In order for cosignature to be witnessed, it must be possible for a
|
-- This puts trust into the Proposal. The Proposal must necessarily check
|
||||||
-- proposal to allow this transaction to happen. This puts trust into the Proposal.
|
-- that this is not abused.
|
||||||
-- The Proposal must necessarily check that this is not abused.
|
pguardC "Proposal ST spent" proposalTokenMoved
|
||||||
pguardC
|
|
||||||
"Owner signs this transaction OR proposal token is spent"
|
|
||||||
(ownerSignsTransaction #|| proposalTokenMoved)
|
|
||||||
|
|
||||||
pguardC "A UTXO must exist with the correct output" $
|
pguardC "A UTXO must exist with the correct output" $
|
||||||
let correctOutputDatum = stakeOutUnchanged
|
let expectedLocks = pfield @"locks" # l
|
||||||
valueCorrect = ownOutputValueUnchanged
|
|
||||||
in foldl1
|
|
||||||
(#&&)
|
|
||||||
[ ptraceIfFalse "valueCorrect" valueCorrect
|
|
||||||
, ptraceIfFalse "correctOutputDatum" correctOutputDatum
|
|
||||||
]
|
|
||||||
pure $ popaque (pconstant ())
|
|
||||||
--------------------------------------------------------------------------
|
|
||||||
PDepositWithdraw r -> unTermCont $ do
|
|
||||||
pguardC "ST at inputs must be 1" $
|
|
||||||
spentST #== 1
|
|
||||||
pguardC "Stake unlocked" $
|
|
||||||
pnot #$ stakeIsLocked
|
|
||||||
pguardC
|
|
||||||
"Owner signs this transaction"
|
|
||||||
ownerSignsTransaction
|
|
||||||
pguardC "A UTXO must exist with the correct output" $
|
|
||||||
unTermCont $ do
|
|
||||||
let oldStakedAmount = pfromData $ stakeDatum.stakedAmount
|
|
||||||
delta = pfromData $ pfield @"delta" # r
|
|
||||||
|
|
||||||
newStakedAmount <- pletC $ oldStakedAmount + delta
|
expectedDatum =
|
||||||
|
mkRecordConstr
|
||||||
|
PStakeDatum
|
||||||
|
( #stakedAmount .= stakeDatum.stakedAmount
|
||||||
|
.& #owner .= stakeDatum.owner
|
||||||
|
.& #lockedBy .= expectedLocks
|
||||||
|
)
|
||||||
|
|
||||||
pguardC "New staked amount shoudl be greater than or equal to 0" $
|
valueCorrect = ownOutputValueUnchanged
|
||||||
zero #<= newStakedAmount
|
outputDatumCorrect = stakeOut #== expectedDatum
|
||||||
|
in foldl1
|
||||||
|
(#&&)
|
||||||
|
[ ptraceIfFalse "valueCorrect" valueCorrect
|
||||||
|
, ptraceIfFalse "datumCorrect" outputDatumCorrect
|
||||||
|
]
|
||||||
|
|
||||||
let expectedDatum =
|
pure $ popaque (pconstant ())
|
||||||
|
|
||||||
|
------------------------------------------------------------
|
||||||
|
|
||||||
|
PPermitVote l -> unTermCont $ do
|
||||||
|
pguardC
|
||||||
|
"Owner signs this transaction"
|
||||||
|
ownerSignsTransaction
|
||||||
|
|
||||||
|
-- This puts trust into the Proposal. The Proposal must necessarily check
|
||||||
|
-- that this is not abused.
|
||||||
|
pguardC "Proposal ST spent" proposalTokenMoved
|
||||||
|
|
||||||
|
-- Update the stake datum, but only the 'lockedBy' field.
|
||||||
|
|
||||||
|
let -- We actually don't know whether the given lock is valid or not.
|
||||||
|
-- This is checked in the proposal validator.
|
||||||
|
newLock = pfield @"lock" # l
|
||||||
|
-- Prepend the new lock to the existing locks.
|
||||||
|
expectedLocks = pcons # newLock # stakeDatum.lockedBy
|
||||||
|
|
||||||
|
expectedDatum <-
|
||||||
|
pletC $
|
||||||
mkRecordConstr
|
mkRecordConstr
|
||||||
PStakeDatum
|
PStakeDatum
|
||||||
( #stakedAmount .= pdata newStakedAmount
|
( #stakedAmount .= stakeDatum.stakedAmount
|
||||||
.& #owner .= stakeDatum.owner
|
.& #owner .= stakeDatum.owner
|
||||||
.& #lockedBy .= stakeDatum.lockedBy
|
.& #lockedBy .= pdata expectedLocks
|
||||||
)
|
)
|
||||||
datumCorrect = stakeOut #== expectedDatum
|
|
||||||
|
|
||||||
let valueDelta :: Term _ (PValue _ 'Positive)
|
pguardC "A UTXO must exist with the correct output" $
|
||||||
valueDelta = pdiscreteValue' stake.gtClassRef # delta
|
let correctOutputDatum = stakeOut #== expectedDatum
|
||||||
|
valueCorrect = ownOutputValueUnchanged
|
||||||
|
in foldl1
|
||||||
|
(#&&)
|
||||||
|
[ ptraceIfFalse "valueCorrect" valueCorrect
|
||||||
|
, ptraceIfFalse "datumCorrect" correctOutputDatum
|
||||||
|
]
|
||||||
|
|
||||||
expectedValue =
|
pure $ popaque (pconstant ())
|
||||||
continuingValue <> valueDelta
|
|
||||||
|
|
||||||
valueCorrect =
|
------------------------------------------------------------
|
||||||
foldr1
|
|
||||||
(#&&)
|
PDepositWithdraw r -> unTermCont $ do
|
||||||
[ pgeqByClass' (AssetClass ("", ""))
|
pguardC "Stake unlocked" $
|
||||||
# ownOutputValue
|
pnot #$ stakeIsLocked
|
||||||
# expectedValue
|
pguardC
|
||||||
, pgeqByClass' (untag stake.gtClassRef)
|
"Owner signs this transaction"
|
||||||
# ownOutputValue
|
ownerSignsTransaction
|
||||||
# expectedValue
|
pguardC "A UTXO must exist with the correct output" $
|
||||||
, pgeqBySymbol
|
unTermCont $ do
|
||||||
# stCurrencySymbol
|
let oldStakedAmount = pfromData $ stakeDatum.stakedAmount
|
||||||
# ownOutputValue
|
delta = pfromData $ pfield @"delta" # r
|
||||||
# expectedValue
|
|
||||||
]
|
newStakedAmount <- pletC $ oldStakedAmount + delta
|
||||||
--
|
|
||||||
pure $
|
pguardC "New staked amount should be greater than or equal to 0" $
|
||||||
foldl1
|
zero #<= newStakedAmount
|
||||||
(#&&)
|
|
||||||
[ ptraceIfFalse "valueCorrect" valueCorrect
|
let expectedDatum =
|
||||||
, ptraceIfFalse "datumCorrect" datumCorrect
|
mkRecordConstr
|
||||||
]
|
PStakeDatum
|
||||||
--
|
( #stakedAmount .= pdata newStakedAmount
|
||||||
pure $ popaque (pconstant ())
|
.& #owner .= stakeDatum.owner
|
||||||
_ -> popaque (pconstant ())
|
.& #lockedBy .= stakeDatum.lockedBy
|
||||||
|
)
|
||||||
|
datumCorrect = stakeOut #== expectedDatum
|
||||||
|
|
||||||
|
let valueDelta :: Term _ (PValue _ 'Positive)
|
||||||
|
valueDelta = pdiscreteValue' stake.gtClassRef # delta
|
||||||
|
|
||||||
|
expectedValue =
|
||||||
|
resolvedF.value <> valueDelta
|
||||||
|
|
||||||
|
valueCorrect =
|
||||||
|
foldr1
|
||||||
|
(#&&)
|
||||||
|
[ pgeqByClass' (AssetClass ("", ""))
|
||||||
|
# ownOutputValue
|
||||||
|
# expectedValue
|
||||||
|
, pgeqByClass' (untag stake.gtClassRef)
|
||||||
|
# ownOutputValue
|
||||||
|
# expectedValue
|
||||||
|
, pgeqBySymbol
|
||||||
|
# stCurrencySymbol
|
||||||
|
# ownOutputValue
|
||||||
|
# expectedValue
|
||||||
|
]
|
||||||
|
--
|
||||||
|
pure $
|
||||||
|
foldl1
|
||||||
|
(#&&)
|
||||||
|
[ ptraceIfFalse "valueCorrect" valueCorrect
|
||||||
|
, ptraceIfFalse "datumCorrect" datumCorrect
|
||||||
|
]
|
||||||
|
--
|
||||||
|
pure $ popaque (pconstant ())
|
||||||
|
_ -> popaque (pconstant ())
|
||||||
|
|
||||||
|
pure $
|
||||||
|
pif
|
||||||
|
(pdata stakeRedeemer #== pconstantData WitnessStake)
|
||||||
|
witnessStake
|
||||||
|
onlyAcceptOneStake
|
||||||
|
|
|
||||||
|
|
@ -19,6 +19,9 @@ module Agora.Utils (
|
||||||
validatorHashToAddress,
|
validatorHashToAddress,
|
||||||
isScriptAddress,
|
isScriptAddress,
|
||||||
isPubKey,
|
isPubKey,
|
||||||
|
pltAsData,
|
||||||
|
pisUniqBy',
|
||||||
|
pisUniq',
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Plutarch.Api.V1 (
|
import Plutarch.Api.V1 (
|
||||||
|
|
@ -193,3 +196,48 @@ mustBePDJust = phoistAcyclic $
|
||||||
-}
|
-}
|
||||||
validatorHashToAddress :: ValidatorHash -> Address
|
validatorHashToAddress :: ValidatorHash -> Address
|
||||||
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing
|
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing
|
||||||
|
|
||||||
|
{- | Compare two 'PAsData' value, return true if the first one is less than the second one.
|
||||||
|
|
||||||
|
@since 0.2.0
|
||||||
|
-}
|
||||||
|
pltAsData ::
|
||||||
|
forall (a :: PType) (s :: S).
|
||||||
|
(POrd a, PIsData a) =>
|
||||||
|
Term s (PAsData a :--> PAsData a :--> PBool)
|
||||||
|
pltAsData = phoistAcyclic $
|
||||||
|
plam $
|
||||||
|
\(pfromData -> l) (pfromData -> r) -> l #< r
|
||||||
|
|
||||||
|
{- | Special version of 'pisUniq'', the list elements should have 'PEq' instance.
|
||||||
|
|
||||||
|
@since 0.2.0
|
||||||
|
-}
|
||||||
|
pisUniq' ::
|
||||||
|
forall (l :: PType -> PType) (a :: PType) (s :: S).
|
||||||
|
(PEq a, PIsListLike l a) =>
|
||||||
|
Term s (l a :--> PBool)
|
||||||
|
pisUniq' = phoistAcyclic $ pisUniqBy' # phoistAcyclic (plam (#==))
|
||||||
|
|
||||||
|
{- | Return true if all the elements in the given list are unique, given the equalator function.
|
||||||
|
The list is assumed to be ordered.
|
||||||
|
|
||||||
|
@since 0.2.0
|
||||||
|
-}
|
||||||
|
pisUniqBy' ::
|
||||||
|
forall (l :: PType -> PType) (a :: PType) (s :: S).
|
||||||
|
(PIsListLike l a) =>
|
||||||
|
Term s ((a :--> a :--> PBool) :--> l a :--> PBool)
|
||||||
|
pisUniqBy' = phoistAcyclic $
|
||||||
|
plam $ \eq l ->
|
||||||
|
pif (pnull # l) (pconstant True) $
|
||||||
|
go # eq # (phead # l) # (ptail # l)
|
||||||
|
where
|
||||||
|
go :: Term _ ((a :--> a :--> PBool) :--> a :--> l a :--> PBool)
|
||||||
|
go = phoistAcyclic $
|
||||||
|
pfix #$ plam $ \self' eq x xs ->
|
||||||
|
plet (self' # eq) $ \self ->
|
||||||
|
pif (pnull # xs) (pconstant True) $
|
||||||
|
plet (phead # xs) $ \x' ->
|
||||||
|
pif (eq # x # x') (pconstant False) $
|
||||||
|
self # x' #$ ptail # xs
|
||||||
|
|
|
||||||
73
bench.csv
73
bench.csv
|
|
@ -5,27 +5,60 @@ Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,456007605,1104500,3
|
||||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,87839169,243032,8561
|
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,87839169,243032,8561
|
||||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,106082031,292993,3609
|
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,106082031,292993,3609
|
||||||
Agora/Stake/policy/stakeCreation,50939580,148729,2387
|
Agora/Stake/policy/stakeCreation,50939580,148729,2387
|
||||||
Agora/Stake/validator/stakeDepositWithdraw deposit,181581435,493259,4413
|
Agora/Stake/validator/stakeDepositWithdraw deposit,150745141,416137,4995
|
||||||
Agora/Stake/validator/stakeDepositWithdraw withdraw,181581435,493259,4401
|
Agora/Stake/validator/stakeDepositWithdraw withdraw,150745141,416137,4983
|
||||||
Agora/Proposal/policy/proposalCreation,23140177,69194,1515
|
Agora/Proposal/policy/proposalCreation,23140177,69194,1515
|
||||||
Agora/Proposal/validator/cosignature/proposal,312261341,886430,8188
|
Agora/Proposal/validator/cosignature/legal/with 1 cosigners/propsoal,235408912,657765,8097
|
||||||
Agora/Proposal/validator/cosignature/stake,125315872,312659,4942
|
Agora/Proposal/validator/cosignature/legal/with 1 cosigners/stake,125665131,316762,5462
|
||||||
Agora/Proposal/validator/voting/proposal,268025219,751750,8106
|
Agora/Proposal/validator/cosignature/legal/with 5 cosigners/propsoal,680441047,1897008,10727
|
||||||
Agora/Proposal/validator/voting/stake,120122971,320497,4899
|
Agora/Proposal/validator/cosignature/legal/with 5 cosigners/stake,576106975,1490610,7972
|
||||||
Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,263397893,738746,8013
|
Agora/Proposal/validator/cosignature/legal/with 10 cosigners/propsoal,1351073436,3706315,14015
|
||||||
Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,278686368,780686,8022
|
Agora/Proposal/validator/cosignature/legal/with 10 cosigners/stake,1148637636,2982695,11109
|
||||||
Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,267078383,746859,8022
|
Agora/Proposal/validator/cosignature/illegal/duplicate cosigners/stake,125665131,316762,5462
|
||||||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,262901404,737844,8015
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: VotingReady/stake,125665131,316762,5462
|
||||||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,264319938,741149,8016
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: Locked/stake,125665131,316762,5462
|
||||||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,265450916,743553,8016
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: Finished/stake,125665131,316762,5462
|
||||||
"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",276198245,772878,8066
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: VotingReady/stake,576106975,1490610,7972
|
||||||
"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",246477596,697110,8068
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: Locked/stake,576106975,1490610,7972
|
||||||
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",242771264,688789,8070
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: Finished/stake,576106975,1490610,7972
|
||||||
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",242771264,688789,8070
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: VotingReady/stake,1148637636,2982695,11109
|
||||||
"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",2814657239,7934307,29173
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: Locked/stake,1148637636,2982695,11109
|
||||||
"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2488302451,7053012,29357
|
Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: Finished/stake,1148637636,2982695,11109
|
||||||
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2379658464,6713247,29341
|
Agora/Proposal/validator/voting/legal/propsoal,246896882,688919,8069
|
||||||
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2379658464,6713247,29341
|
Agora/Proposal/validator/voting/legal/stake,141234659,368136,5481
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to next state/propsoal,222376736,631090,8052
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to next state/stake,125665131,316762,5459
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to failed state/propsoal,217322044,620369,8054
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to failed state/stake,125665131,316762,5461
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/illegal/insufficient cosigns/stake,118020743,304972,5389
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to next state/propsoal,614587307,1766683,10875
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to next state/stake,548619697,1410656,8162
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to failed state/propsoal,239691392,682433,8415
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to failed state/stake,125665131,316762,5702
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/illegal/insufficient cosigns/stake,446252055,1166812,7811
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to next state/propsoal,1196289192,3454898,14404
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to next state/stake,1201388310,3136405,11540
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to failed state/propsoal,267653077,760013,8868
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to failed state/stake,125665131,316762,6004
|
||||||
|
Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/illegal/insufficient cosigns/stake,1025012867,2732083,10837
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to next state/from: VotingReady/propsoal,250229153,709227,8061
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to next state/from: VotingReady/stake,125665131,316762,5466
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to next state/from: Locked/propsoal,238990044,676396,8061
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to next state/from: Locked/stake,125665131,316762,5466
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to failed state/from: VotingReady/propsoal,236162599,670386,8055
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to failed state/from: VotingReady/stake,125665131,316762,5462
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to failed state/from: Locked/propsoal,237293577,672790,8055
|
||||||
|
Agora/Proposal/validator/advancing/legal/advance to failed state/from: Locked/stake,125665131,316762,5462
|
||||||
|
Agora/Proposal/validator/advancing/illegal/insufficient votes/stake,125665131,316762,5462
|
||||||
|
Agora/Proposal/validator/advancing/illegal/initial state is Finished/stake,125665131,316762,5454
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",245855872,689807,8029
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",215131610,613807,8031
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",212428891,605718,8033
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",212428891,605718,8033
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1775520444,5200586,29137
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1448162043,4319059,29321
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1340521669,3979526,29305
|
||||||
|
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1340521669,3979526,29305
|
||||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
|
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
|
||||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
|
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
|
||||||
Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452
|
Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452
|
||||||
|
|
|
||||||
|
Loading…
Add table
Add a link
Reference in a new issue