use nested pmatches instead of laziness

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

View file

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

View file

@ -244,43 +244,6 @@ stakeValidator stake =
-- Is the stake currently locked? -- Is the stake currently locked?
stakeIsLocked <- tclet $ stakeLocked # stakeDatum' 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 $ pure $
pmatch stakeRedeemer $ \case pmatch stakeRedeemer $ \case
PDestroy _ -> unTermCont $ do PDestroy _ -> unTermCont $ do
@ -296,6 +259,41 @@ stakeValidator stake =
pure $ popaque (pconstant ()) 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 PRetractVotes _ -> unTermCont $ do
tcassert tcassert
"Owner signs this transaction" "Owner signs this transaction"
@ -311,7 +309,7 @@ stakeValidator stake =
tcassert "A UTXO must exist with the correct output" $ tcassert "A UTXO must exist with the correct output" $
unTermCont $ do unTermCont $ do
let valueCorrect = pforce ownOutputValueUnchangedD let valueCorrect = ownOutputValueUnchanged
-- TODO: check output datum is expected. -- TODO: check output datum is expected.
@ -351,8 +349,8 @@ stakeValidator stake =
) )
tcassert "A UTXO must exist with the correct output" $ tcassert "A UTXO must exist with the correct output" $
let correctOutputDatum = pdata (pforce stakeOutD) #== pdata expectedDatum let correctOutputDatum = stakeOut #== expectedDatum
valueCorrect = pforce ownOutputValueUnchangedD valueCorrect = ownOutputValueUnchanged
in foldl1 in foldl1
(#&&) (#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect [ ptraceIfFalse "valueCorrect" valueCorrect
@ -380,14 +378,15 @@ stakeValidator stake =
(ownerSignsTransaction #|| proposalTokenMoved) (ownerSignsTransaction #|| proposalTokenMoved)
tcassert "A UTXO must exist with the correct output" $ tcassert "A UTXO must exist with the correct output" $
let correctOutputDatum = pforce stakeOutUnchangedD let correctOutputDatum = stakeOutUnchanged
valueCorrect = pforce ownOutputValueUnchangedD valueCorrect = ownOutputValueUnchanged
in foldl1 in foldl1
(#&&) (#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect [ ptraceIfFalse "valueCorrect" valueCorrect
, ptraceIfFalse "correctOutputDatum" correctOutputDatum , ptraceIfFalse "correctOutputDatum" correctOutputDatum
] ]
pure $ popaque (pconstant ()) pure $ popaque (pconstant ())
--------------------------------------------------------------------------
PDepositWithdraw r -> unTermCont $ do PDepositWithdraw r -> unTermCont $ do
tcassert "ST at inputs must be 1" $ tcassert "ST at inputs must be 1" $
spentST #== 1 spentST #== 1
@ -398,8 +397,6 @@ stakeValidator stake =
ownerSignsTransaction ownerSignsTransaction
tcassert "A UTXO must exist with the correct output" $ tcassert "A UTXO must exist with the correct output" $
unTermCont $ do unTermCont $ do
let stakeOut = pforce stakeOutD
let oldStakedAmount = pfromData $ stakeDatum.stakedAmount let oldStakedAmount = pfromData $ stakeDatum.stakedAmount
delta = pfromData $ pfield @"delta" # r delta = pfromData $ pfield @"delta" # r
@ -417,9 +414,8 @@ stakeValidator stake =
) )
datumCorrect = stakeOut #== expectedDatum datumCorrect = stakeOut #== expectedDatum
ownOutputValue <- tclet $ pforce ownOutputValueD let expectedValue =
paddValue # continuingValue # (pdiscreteValue' stake.gtClassRef # delta)
let expectedValue = paddValue # continuingValue # (pdiscreteValue' stake.gtClassRef # delta)
valueCorrect = valueCorrect =
foldr1 foldr1
@ -435,12 +431,13 @@ stakeValidator stake =
# ownOutputValue # ownOutputValue
# expectedValue # expectedValue
] ]
--
pure $ pure $
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect [ ptraceIfFalse "valueCorrect" valueCorrect
, ptraceIfFalse "datumCorrect" datumCorrect , ptraceIfFalse "datumCorrect" datumCorrect
] ]
--
pure $ popaque (pconstant ()) pure $ popaque (pconstant ())
_ -> popaque (pconstant ())