Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

use nested pmatches instead of laziness

Browse source
This commit is contained in:
fanghr 2022-05-24 21:48:32 +08:00
parent 6145d9ef68
commit cafe91f7a1
2 changed files with 179 additions and 184 deletions
Download patch file Download diff file Expand all files Collapse all files

12
agora/Agora/Proposal/Scripts.hs
View file

@ -187,9 +187,8 @@ proposalValidator proposal =
-- Filter out own output with own address and PST.
-- Delay the evaluation cause in some cases there won't be any continuing output.
ownOutputD <-
ownOutput <-
tclet $
pdelay $
mustBePJust # "Own output should be present" #$ pfind
# plam
( \input -> unTermCont $ do
@ -200,11 +199,10 @@ proposalValidator proposal =
)
# pfromData txInfoF.outputs
proposalOutD <-
proposalOut <-
tclet $
pdelay $
mustFindDatum' @PProposalDatum
# (pfield @"datumHash" # pforce ownOutputD)
# (pfield @"datumHash" # ownOutput)
# txInfoF.datums
pure $
@ -273,7 +271,7 @@ proposalValidator proposal =
.& #startingTime .= proposalF.startingTime
)
tcassert "Output proposal should be valid" $ pforce proposalOutD #== expectedProposalOut
tcassert "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
@ -360,7 +358,7 @@ proposalValidator proposal =
)
tcassert "Signatures are correctly added to cosignature list" $
pforce proposalOutD #== expectedDatum
proposalOut #== expectedDatum
pure $ popaque (pconstant ())
--------------------------------------------------------------------------

95
agora/Agora/Stake/Scripts.hs
View file

@ -244,43 +244,6 @@ stakeValidator stake =
-- Is the stake currently locked?
stakeIsLocked <- tclet $ stakeLocked # stakeDatum'
-- Filter out own output with own address and PST.
-- Delay the evaluation cause in some cases there won't be any continuing output.
ownOutputD <-
tclet $
pdelay $
mustBePJust # "Own output should be present" #$ pfind
# plam
( \input -> unTermCont $ do
inputF <- tcont $ pletFields @'["address", "value"] input
pure $
inputF.address #== ownAddress
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
)
# pfromData txInfoF.outputs
stakeOutD <-
tclet $
pdelay $
mustFindDatum' @PStakeDatum
# (pfield @"datumHash" # pforce ownOutputD)
# txInfoF.datums
ownOutputValueD <-
tclet $
pdelay $
pfield @"value" # pforce ownOutputD
ownOutputValueUnchangedD <-
tclet $
pdelay $
pdata continuingValue #== pdata (pforce ownOutputValueD)
stakeOutUnchangedD <-
tclet $
pdelay $
pdata (pforce stakeOutD) #== pdata stakeDatum'
pure $
pmatch stakeRedeemer $ \case
PDestroy _ -> unTermCont $ do
@ -296,6 +259,41 @@ stakeValidator stake =
pure $ popaque (pconstant ())
--------------------------------------------------------------------------
-- Handle redeemers that require own stake output.
_ -> unTermCont $ do
-- Filter out own output with own address and PST.
ownOutput <-
tclet $
mustBePJust # "Own output should be present" #$ pfind
# plam
( \input -> unTermCont $ do
inputF <- tcont $ pletFields @'["address", "value"] input
pure $
inputF.address #== ownAddress
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
)
# pfromData txInfoF.outputs
stakeOut <-
tclet $
mustFindDatum' @PStakeDatum
# (pfield @"datumHash" # ownOutput)
# txInfoF.datums
ownOutputValue <-
tclet $
pfield @"value" # ownOutput
ownOutputValueUnchanged <-
tclet $
pdata continuingValue #== pdata ownOutputValue
stakeOutUnchanged <-
tclet $
pdata stakeOut #== pdata stakeDatum'
pure $
pmatch stakeRedeemer $ \case
PRetractVotes _ -> unTermCont $ do
tcassert
"Owner signs this transaction"
@ -311,7 +309,7 @@ stakeValidator stake =
tcassert "A UTXO must exist with the correct output" $
unTermCont $ do
let valueCorrect = pforce ownOutputValueUnchangedD
let valueCorrect = ownOutputValueUnchanged
-- TODO: check output datum is expected.
@ -351,8 +349,8 @@ stakeValidator stake =
)
tcassert "A UTXO must exist with the correct output" $
let correctOutputDatum = pdata (pforce stakeOutD) #== pdata expectedDatum
valueCorrect = pforce ownOutputValueUnchangedD
let correctOutputDatum = stakeOut #== expectedDatum
valueCorrect = ownOutputValueUnchanged
in foldl1
(#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect
@ -380,14 +378,15 @@ stakeValidator stake =
(ownerSignsTransaction #|| proposalTokenMoved)
tcassert "A UTXO must exist with the correct output" $
let correctOutputDatum = pforce stakeOutUnchangedD
valueCorrect = pforce ownOutputValueUnchangedD
let correctOutputDatum = stakeOutUnchanged
valueCorrect = ownOutputValueUnchanged
in foldl1
(#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect
, ptraceIfFalse "correctOutputDatum" correctOutputDatum
]
pure $ popaque (pconstant ())
--------------------------------------------------------------------------
PDepositWithdraw r -> unTermCont $ do
tcassert "ST at inputs must be 1" $
spentST #== 1
@ -398,8 +397,6 @@ stakeValidator stake =
ownerSignsTransaction
tcassert "A UTXO must exist with the correct output" $
unTermCont $ do
let stakeOut = pforce stakeOutD
let oldStakedAmount = pfromData $ stakeDatum.stakedAmount
delta = pfromData $ pfield @"delta" # r
@ -417,9 +414,8 @@ stakeValidator stake =
)
datumCorrect = stakeOut #== expectedDatum
ownOutputValue <- tclet $ pforce ownOutputValueD
let expectedValue = paddValue # continuingValue # (pdiscreteValue' stake.gtClassRef # delta)
let expectedValue =
paddValue # continuingValue # (pdiscreteValue' stake.gtClassRef # delta)
valueCorrect =
foldr1
@ -435,12 +431,13 @@ stakeValidator stake =
# ownOutputValue
# expectedValue
]
--
pure $
foldl1
(#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect
, ptraceIfFalse "datumCorrect" datumCorrect
]
--
pure $ popaque (pconstant ())
_ -> popaque (pconstant ())