share stake check code among redeemers
This commit is contained in:
fanghr
Hongrui Fang
parent
e745a051ce
commit
13dff0db43
4 changed files with 141 additions and 70 deletions
|
|
@ -54,6 +54,7 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
|||
import Plutarch.Extra.TermCont (
|
||||
pguardC,
|
||||
pletC,
|
||||
pletFieldsC,
|
||||
pmatchC,
|
||||
ptryFromC,
|
||||
)
|
||||
|
|
@ -184,29 +185,37 @@ proposalValidator proposal =
|
|||
valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
|
||||
spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
|
||||
|
||||
let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
|
||||
stakeSTAssetClass <-
|
||||
pletC $ passetClass # pconstant stakeSym # pconstant stakeTn
|
||||
spentStakeST <-
|
||||
pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass
|
||||
|
||||
signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
|
||||
|
||||
pguardC "ST at inputs must be 1" (spentST #== 1)
|
||||
|
||||
currentTime <- pletC $ currentProposalTime # txInfoF.validRange
|
||||
|
||||
-- Filter out own output with own address and PST.
|
||||
-- Delay the evaluation cause in some cases there won't be any continuing output.
|
||||
-- Own output is an output that
|
||||
-- * is sent to the address of the proposal validator
|
||||
-- * has an PST
|
||||
-- * has the same proposal id as the proposal input
|
||||
--
|
||||
-- We match the proposal id here so that we can support multiple
|
||||
-- proposal inputs in one thansaction.
|
||||
ownOutput <-
|
||||
pletC $
|
||||
mustBePJust # "Own output should be present" #$ pfind
|
||||
# plam
|
||||
( \input -> unTermCont $ do
|
||||
inputF <- tcont $ pletFields @'["address", "value"] input
|
||||
inputF <- tcont $ pletFields @'["address", "value", "datumHash"] input
|
||||
|
||||
-- TODO: this is highly inefficient: O(n) for every output,
|
||||
-- Maybe we can cache the sorted datum map?
|
||||
let datum =
|
||||
mustFindDatum' @PProposalDatum
|
||||
# inputF.datumHash
|
||||
# txInfoF.datums
|
||||
|
||||
proposalId = pfield @"proposalId" # datum
|
||||
|
||||
pure $
|
||||
inputF.address #== ownAddress
|
||||
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
|
||||
#&& proposalId #== proposalF.proposalId
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
|
|
@ -216,6 +225,46 @@ proposalValidator proposal =
|
|||
# (pfield @"datumHash" # ownOutput)
|
||||
# txInfoF.datums
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- Find the stake input and stake output by SST.
|
||||
|
||||
let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
|
||||
stakeSTAssetClass <-
|
||||
pletC $ passetClass # pconstant stakeSym # pconstant stakeTn
|
||||
spentStakeST <-
|
||||
pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass
|
||||
|
||||
pguardC "ST at inputs must be 1" (spentST #== 1)
|
||||
|
||||
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
|
||||
|
|
@ -232,23 +281,6 @@ proposalValidator proposal =
|
|||
pguardC "Vote option should be valid" $
|
||||
pisJust #$ plookup # voteFor # voteMap
|
||||
|
||||
-- Find the input stake, the amount of new votes should be the 'stakedAmount'.
|
||||
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 :: Term _ PStakeDatum
|
||||
stakeIn = mustFindDatum' # (pfield @"datumHash" # stakeInput) # txInfoF.datums
|
||||
|
||||
stakeInF <- tcont $ pletFields @'["stakedAmount", "lockedBy", "owner"] stakeIn
|
||||
|
||||
-- Ensure that no lock with the current proposal id has been put on the stake.
|
||||
pguardC "Same stake shouldn't vote on the same propsoal twice" $
|
||||
pnot #$ pany
|
||||
|
|
@ -258,7 +290,8 @@ proposalValidator proposal =
|
|||
)
|
||||
# pfromData stakeInF.lockedBy
|
||||
|
||||
let -- Update the vote counter of the proposal, and leave other stuff as is.
|
||||
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 $
|
||||
|
|
@ -289,18 +322,6 @@ proposalValidator proposal =
|
|||
-- to create a valid 'ProposalLock', however the vote option is encoded
|
||||
-- in the proposal redeemer, which is invisible for the stake validator.
|
||||
|
||||
let stakeOutput =
|
||||
mustBePJust # "Stake output should be present"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \(pfromData . (pfield @"value" #) -> value) ->
|
||||
passetClassValueOf # value # stakeSTAssetClass #== 1
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
stakeOut :: Term _ PStakeDatum
|
||||
stakeOut = mustFindDatum' # (pfield @"datumHash" # stakeOutput) # txInfoF.datums
|
||||
|
||||
let newProposalLock =
|
||||
mkRecordConstr
|
||||
PProposalLock
|
||||
|
|
@ -325,6 +346,8 @@ proposalValidator proposal =
|
|||
pure $ popaque (pconstant ())
|
||||
--------------------------------------------------------------------------
|
||||
PCosign r -> unTermCont $ do
|
||||
pguardC "Stake should not change" stakeUnchanged
|
||||
|
||||
newSigs <- pletC $ pfield @"newCosigners" # r
|
||||
|
||||
pguardC "Cosigners are unique" $
|
||||
|
|
@ -374,13 +397,11 @@ proposalValidator proposal =
|
|||
|
||||
pure $ popaque (pconstant ())
|
||||
--------------------------------------------------------------------------
|
||||
PUnlock _r ->
|
||||
popaque (pconstant ())
|
||||
PUnlock _r -> popaque (pconstant ())
|
||||
--------------------------------------------------------------------------
|
||||
PAdvanceProposal _r -> unTermCont $ do
|
||||
pguardC "No stake input is allowed" $ spentStakeST #== 0
|
||||
pguardC "Stake should not change" stakeUnchanged
|
||||
|
||||
currentTime <- pletC $ currentProposalTime # txInfoF.validRange
|
||||
proposalOutStatus <- pletC $ pfield @"status" # proposalOut
|
||||
|
||||
let -- Only the status of proposals should be updated in this case.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue