apply Emily's suggestions
This commit is contained in:
Hongrui Fang
parent
9c8d04dbc6
commit
f00cc62476
3 changed files with 334 additions and 328 deletions
|
|
@ -42,6 +42,7 @@ import Agora.Utils (
|
|||
import Plutarch.Api.V1 (
|
||||
PDatumHash,
|
||||
PMintingPolicy,
|
||||
PPubKeyHash,
|
||||
PScriptContext (PScriptContext),
|
||||
PScriptPurpose (PMinting, PSpending),
|
||||
PTxInfo (PTxInfo),
|
||||
|
|
@ -305,198 +306,272 @@ proposalValidator proposal =
|
|||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
let acceptMultipleStakes = pmatch proposalRedeemer $ \case
|
||||
PCosign _ -> pconstant True
|
||||
PAdvanceProposal _ ->
|
||||
currentStatus #== pconstant Draft
|
||||
_ -> pconstant False
|
||||
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 $
|
||||
pif
|
||||
acceptMultipleStakes
|
||||
( 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
|
||||
pmatch proposalRedeemer $ \case
|
||||
PCosign r -> withMultipleStakes $ \_ sortedStakeOwners -> do
|
||||
pguardC "Should be in draft state" $
|
||||
currentStatus #== pconstant Draft
|
||||
|
||||
sortedStakeInputDatumHashes =
|
||||
sortDatumHashes # stakeInputDatumHashes
|
||||
newSigs <- pletC $ pfield @"newCosigners" # r
|
||||
|
||||
sortedStakeOutputDatumHashes =
|
||||
sortDatumHashes # stakeOutputDatumHashes
|
||||
pguardC "Signed by all new cosigners" $
|
||||
pall # signedBy # newSigs
|
||||
|
||||
pguardC "All stake datum are unchanged" $
|
||||
plistEquals
|
||||
# sortedStakeInputDatumHashes
|
||||
# sortedStakeOutputDatumHashes
|
||||
updatedSigs <-
|
||||
pletC $
|
||||
pmergeBy # pltAsData
|
||||
# newSigs
|
||||
# proposalF.cosigners
|
||||
|
||||
PPair totalStakedAmount stakeOwners <-
|
||||
pmatchC $
|
||||
pfoldl
|
||||
# plam
|
||||
( \l dh -> unTermCont $ do
|
||||
let stake =
|
||||
pfromData $
|
||||
pfromJust
|
||||
#$ ptryFindDatum
|
||||
@(PAsData PStakeDatum)
|
||||
# pfromData dh
|
||||
# txInfoF.datums
|
||||
pguardC "Cosigners are unique" $
|
||||
pisUniq' # updatedSigs
|
||||
|
||||
stakeF <- pletFieldsC @'["stakedAmount", "owner"] stake
|
||||
pguardC "All new cosigners are witnessed by their Stake datums" $
|
||||
plistEquals # sortedStakeOwners # newSigs
|
||||
|
||||
PPair amount owners <- pmatchC l
|
||||
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
|
||||
)
|
||||
|
||||
let newAmount = amount + punsafeCoerce (pfromData stakeF.stakedAmount)
|
||||
updatedOwners = pcons # stakeF.owner # owners
|
||||
pguardC "Signatures are correctly added to cosignature list" $
|
||||
proposalOut #== expectedDatum
|
||||
|
||||
pure $ pcon $ PPair newAmount updatedOwners
|
||||
)
|
||||
# pcon (PPair (0 :: Term _ PInteger) (pnil @PBuiltinList))
|
||||
# stakeInputDatumHashes
|
||||
pure $ pconstant ()
|
||||
|
||||
sortedStakeOwners <- pletC $ pmsortBy # pltAsData # stakeOwners
|
||||
----------------------------------------------------------------------
|
||||
|
||||
redeemer <- pmatchC proposalRedeemer
|
||||
PVote r -> withSingleStake $ \stakeInF stakeOut _ -> do
|
||||
pguardC "Input proposal must be in VotingReady state" $
|
||||
currentStatus #== pconstant VotingReady
|
||||
|
||||
case redeemer of
|
||||
PCosign r -> do
|
||||
pguardC "Should be in draft state" $
|
||||
currentStatus #== pconstant Draft
|
||||
pguardC "Proposal time should be wthin the voting period" $
|
||||
isVotingPeriod # proposalF.timingConfig
|
||||
# proposalF.startingTime
|
||||
# currentTime
|
||||
|
||||
newSigs <- pletC $ pfield @"newCosigners" # r
|
||||
-- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
|
||||
PProposalVotes voteMap <- pmatchC proposalF.votes
|
||||
voteFor <- pletC $ pfromData $ pfield @"resultTag" # r
|
||||
|
||||
pguardC "Signed by all new cosigners" $
|
||||
pall # signedBy # newSigs
|
||||
pguardC "Vote option should be valid" $
|
||||
pisJust #$ plookup # voteFor # voteMap
|
||||
|
||||
updatedSigs <-
|
||||
pletC $
|
||||
pmergeBy # pltAsData
|
||||
# newSigs
|
||||
# proposalF.cosigners
|
||||
-- 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
|
||||
|
||||
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
|
||||
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 "Signatures are correctly added to cosignature list" $
|
||||
proposalOut #== expectedDatum
|
||||
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
|
||||
|
||||
pure $ pconstant ()
|
||||
-- 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
|
||||
)
|
||||
|
||||
PAdvanceProposal _ -> do
|
||||
inDraftPeriod <-
|
||||
pletC $
|
||||
isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
|
||||
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
|
||||
|
||||
pure $
|
||||
pif
|
||||
inDraftPeriod
|
||||
( unTermCont $ do
|
||||
pguardC "More cosigns than minimum amount" $
|
||||
punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
|
||||
pure $ pconstant ()
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
pure $ pconstant ()
|
||||
)
|
||||
( unTermCont $ do
|
||||
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
|
||||
-- This is the vote option we're retracting from.
|
||||
retractFrom <- pletC $ pfield @"resultTag" # r
|
||||
|
||||
pure $ pconstant ()
|
||||
)
|
||||
-- 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
|
||||
|
||||
_ -> pure $ pconstant ()
|
||||
)
|
||||
( unTermCont $ do
|
||||
pguardC "Can only deal with one stake" $
|
||||
stakeInputNum #== 1
|
||||
-- The count of removing votes is equal to the 'stakeAmount' of input stake.
|
||||
retractCount <-
|
||||
pletC $
|
||||
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
|
||||
|
||||
let stakeInputHash = pfromData $ phead # stakeInputDatumHashes
|
||||
stakeOutputHash = pfromData $ phead # stakeOutputDatumHashes
|
||||
-- The votes can only change when the proposal still allows voting.
|
||||
let shouldUpdateVotes =
|
||||
currentStatus #== pconstant VotingReady
|
||||
#&& pnot # (pcon PCreated #== stakeUsage)
|
||||
|
||||
stakeIn :: Term _ PStakeDatum <-
|
||||
pletC $
|
||||
pfromData $
|
||||
pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
|
||||
stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
|
||||
pguardC "Proposal output correct" $
|
||||
pif
|
||||
shouldUpdateVotes
|
||||
( let -- Remove votes and leave other parts of the proposal as it.
|
||||
expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
|
||||
|
||||
stakeOut :: Term _ PStakeDatum <-
|
||||
pletC $
|
||||
pfromData $
|
||||
pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
|
||||
|
||||
redeemer <- pmatchC proposalRedeemer
|
||||
|
||||
case redeemer of
|
||||
PVote r -> 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
|
||||
|
|
@ -505,122 +580,60 @@ proposalValidator proposal =
|
|||
.& #status .= proposalF.status
|
||||
.& #cosigners .= proposalF.cosigners
|
||||
.& #thresholds .= proposalF.thresholds
|
||||
.& #votes .= pdata expectedNewVotes
|
||||
.& #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
|
||||
|
||||
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
|
||||
-- At last, we ensure that all locks belong to this proposal will be removed.
|
||||
stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
|
||||
|
||||
-- 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 templateStakeOut =
|
||||
mkRecordConstr
|
||||
PStakeDatum
|
||||
( #stakedAmount .= stakeInF.stakedAmount
|
||||
.& #owner .= stakeInF.owner
|
||||
.& #lockedBy .= stakeOutputLocks
|
||||
)
|
||||
|
||||
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 "Only locks updated in the output stake" $
|
||||
templateStakeOut #== stakeOut
|
||||
|
||||
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
|
||||
pguardC "All relevant locks removed from the stake" $
|
||||
pgetStakeUsage # pfromData stakeOutputLocks
|
||||
# proposalF.proposalId #== pcon PDidNothing
|
||||
|
||||
pure $ pconstant ()
|
||||
pure $ pconstant ()
|
||||
|
||||
------------------------------------------------------------------
|
||||
PUnlock r -> 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
|
||||
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
|
||||
|
||||
-- Determine if the input stake is actually locked by this proposal.
|
||||
stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
|
||||
pguardC "All new cosigners are witnessed by their Stake datums" $
|
||||
plistEquals # sortedStakeOwners # proposalF.cosigners
|
||||
|
||||
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
|
||||
-- 'Draft' -> 'VotingReady'
|
||||
pguardC "Proposal status set to VotingReady" $
|
||||
proposalOutStatus #== pconstant VotingReady
|
||||
|
||||
-- The count of removing votes is equal to the 'stakeAmount' of input stake.
|
||||
retractCount <-
|
||||
pletC $
|
||||
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
|
||||
pure $ pconstant ()
|
||||
PFalse -> do
|
||||
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
|
||||
|
||||
-- The votes can only change when the proposal still allows voting.
|
||||
let shouldUpdateVotes =
|
||||
currentStatus #== pconstant VotingReady
|
||||
#&& pnot # (pcon PCreated #== stakeUsage)
|
||||
pure $ pconstant ()
|
||||
|
||||
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 _ -> do
|
||||
pguardC "Stake should not change" $
|
||||
stakeInputHash #== stakeOutputHash
|
||||
fromOther = withSingleStake $ \_ _ stakeUnchanged -> do
|
||||
pguardC "Stake should not change" stakeUnchanged
|
||||
|
||||
pguardC
|
||||
"Only status changes in the output proposal"
|
||||
|
|
@ -655,6 +668,7 @@ proposalValidator proposal =
|
|||
|
||||
-- TODO: Should check that the GST is not moved
|
||||
-- if the proposal is in 'Locked' state.
|
||||
|
||||
pure $ pconstant ()
|
||||
|
||||
toNextState = pmatchEnum proposalStatus $ \case
|
||||
|
|
@ -685,5 +699,4 @@ proposalValidator proposal =
|
|||
toNextState
|
||||
-- Too late: failed proposal, status set to 'Finished'.
|
||||
toFailedState
|
||||
_ -> pure $ pconstant ()
|
||||
)
|
||||
in pif (currentStatus #== pconstant Draft) fromDraft fromOther
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ import Agora.Utils (
|
|||
mustFindDatum',
|
||||
pvalidatorHashToTokenName,
|
||||
)
|
||||
import Data.Function (on)
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Api.V1 (
|
||||
AmountGuarantees (Positive),
|
||||
|
|
@ -303,10 +304,10 @@ stakeValidator stake =
|
|||
# pfromData txInfoF.outputs
|
||||
|
||||
let witnessStake = unTermCont $ do
|
||||
pguardC "Either owner signs the transaction or propsoal token moved" $
|
||||
pguardC "Either owner signs the transaction or proposal token moved" $
|
||||
ownerSignsTransaction #|| proposalTokenMoved
|
||||
|
||||
-- FIXME: refactor this with reference input, once it's supported by plutarch.
|
||||
-- FIXME: remove this once we have reference input.
|
||||
--
|
||||
-- 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.
|
||||
|
|
@ -335,15 +336,7 @@ stakeValidator stake =
|
|||
# pfromData txInfoF.inputs
|
||||
|
||||
sortTxOuts :: Term _ (PBuiltinList (PAsData PTxOut) :--> PBuiltinList (PAsData PTxOut))
|
||||
sortTxOuts =
|
||||
plam
|
||||
( pmsortBy
|
||||
# plam
|
||||
( \((getDatumHash #) -> dhX)
|
||||
((getDatumHash #) -> dhY) -> dhX #< dhY
|
||||
)
|
||||
#
|
||||
)
|
||||
sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #)
|
||||
where
|
||||
getDatumHash :: Term _ (PAsData PTxOut :--> PDatumHash)
|
||||
getDatumHash = phoistAcyclic $ plam ((pfromDJust #) . pfromData . (pfield @"datumHash" #))
|
||||
|
|
@ -464,7 +457,7 @@ stakeValidator stake =
|
|||
|
||||
newStakedAmount <- pletC $ oldStakedAmount + delta
|
||||
|
||||
pguardC "New staked amount shoudl be greater than or equal to 0" $
|
||||
pguardC "New staked amount should be greater than or equal to 0" $
|
||||
zero #<= newStakedAmount
|
||||
|
||||
let expectedDatum =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue