ensure the new proposal lock is placed on the stake
This commit is contained in:
parent
ce09d05dff
commit
97b3d6f023
2 changed files with 29 additions and 5 deletions
|
|
@ -271,8 +271,8 @@ proposalValidator proposal =
|
||||||
tcassert "Invalid output proposal" $ proposalOut #== expectedProposalOut
|
tcassert "Invalid output proposal" $ proposalOut #== expectedProposalOut
|
||||||
|
|
||||||
-- We validate the output stake datum here as well: We need the vote option
|
-- We validate the output stake datum here as well: We need the vote option
|
||||||
-- to create a proper 'ProposalLock'. However the vote option is encoded
|
-- to create a valid 'ProposalLock', however the vote option is encoded
|
||||||
-- in the proposal redeemer, which is invisible for the stake validator.
|
-- in the proposal redeemer, which is invisible for the stake validator.
|
||||||
|
|
||||||
let stakeOutput =
|
let stakeOutput =
|
||||||
mustBePJust # "Stake output not found"
|
mustBePJust # "Stake output not found"
|
||||||
|
|
@ -292,6 +292,7 @@ proposalValidator proposal =
|
||||||
( #vote .= pdata voteFor
|
( #vote .= pdata voteFor
|
||||||
.& #proposalTag .= proposalF.proposalId
|
.& #proposalTag .= proposalF.proposalId
|
||||||
)
|
)
|
||||||
|
-- Prepend the new lock to existing locks
|
||||||
expectedProposalLocks =
|
expectedProposalLocks =
|
||||||
pcons
|
pcons
|
||||||
# pdata newProposalLock
|
# pdata newProposalLock
|
||||||
|
|
|
||||||
|
|
@ -7,6 +7,7 @@ Plutus Scripts for Stakes.
|
||||||
-}
|
-}
|
||||||
module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
|
module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
|
||||||
|
|
||||||
|
import Agora.Record (mkRecordConstr, (.&), (.=))
|
||||||
import Agora.SafeMoney (GTTag)
|
import Agora.SafeMoney (GTTag)
|
||||||
import Agora.Stake
|
import Agora.Stake
|
||||||
import Agora.Utils (
|
import Agora.Utils (
|
||||||
|
|
@ -222,7 +223,7 @@ stakeValidator stake =
|
||||||
-- TODO: Use PTryFrom
|
-- TODO: Use PTryFrom
|
||||||
let stakeDatum' :: Term _ PStakeDatum
|
let stakeDatum' :: Term _ PStakeDatum
|
||||||
stakeDatum' = pfromData $ punsafeCoerce datum
|
stakeDatum' = pfromData $ punsafeCoerce datum
|
||||||
stakeDatum <- tcont $ pletFields @'["owner", "stakedAmount"] stakeDatum'
|
stakeDatum <- tcont $ pletFields @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
|
||||||
|
|
||||||
PSpending txOutRef <- tcmatch $ pfromData ctx.purpose
|
PSpending txOutRef <- tcmatch $ pfromData ctx.purpose
|
||||||
|
|
||||||
|
|
@ -291,7 +292,7 @@ stakeValidator stake =
|
||||||
|
|
||||||
pure $ popaque (pconstant ())
|
pure $ popaque (pconstant ())
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
PPermitVote _ -> unTermCont $ do
|
PPermitVote l -> unTermCont $ do
|
||||||
tcassert
|
tcassert
|
||||||
"Owner signs this transaction"
|
"Owner signs this transaction"
|
||||||
ownerSignsTransaction
|
ownerSignsTransaction
|
||||||
|
|
@ -301,18 +302,40 @@ stakeValidator stake =
|
||||||
tcassert "Proposal ST spent" $
|
tcassert "Proposal ST spent" $
|
||||||
spentProposalST #== 1
|
spentProposalST #== 1
|
||||||
|
|
||||||
|
-- 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 <-
|
||||||
|
tclet $
|
||||||
|
pdata $
|
||||||
|
mkRecordConstr
|
||||||
|
PStakeDatum
|
||||||
|
( #stakedAmount .= stakeDatum.stakedAmount
|
||||||
|
.& #owner .= stakeDatum.owner
|
||||||
|
.& #lockedBy .= pdata expectedLocks
|
||||||
|
)
|
||||||
|
|
||||||
tcassert "A UTXO must exist with the correct output" $
|
tcassert "A UTXO must exist with the correct output" $
|
||||||
|
-- FIXME: no need to pass the whole txInfo to 'anyOutput'.
|
||||||
anyOutput @PStakeDatum # txInfo
|
anyOutput @PStakeDatum # txInfo
|
||||||
#$ plam
|
#$ plam
|
||||||
$ \value address newStakeDatum' ->
|
$ \value address newStakeDatum' ->
|
||||||
let isScriptAddress = pdata address #== ownAddress
|
let isScriptAddress = pdata address #== ownAddress
|
||||||
_correctOutputDatum = pdata newStakeDatum' #== pdata stakeDatum'
|
correctOutputDatum = pdata newStakeDatum' #== expectedDatum
|
||||||
|
-- TODO: Is this correct? I think We only need to ensure
|
||||||
|
-- correct amount of GT/SST in the continuing output.
|
||||||
valueCorrect = pdata continuingValue #== pdata value
|
valueCorrect = pdata continuingValue #== pdata value
|
||||||
in pif
|
in pif
|
||||||
isScriptAddress
|
isScriptAddress
|
||||||
( foldl1
|
( foldl1
|
||||||
(#&&)
|
(#&&)
|
||||||
[ ptraceIfFalse "valueCorrect" valueCorrect
|
[ ptraceIfFalse "valueCorrect" valueCorrect
|
||||||
|
, ptraceIfFalse "datumCorrect" correctOutputDatum
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
(pcon PFalse)
|
(pcon PFalse)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue