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

allow multiple stakes to be burnt

Browse source
This commit is contained in:
Hongrui Fang 2022-10-13 19:34:00 +08:00
parent 7c6359f7c6
commit 57ed91afb8
1 changed files with 30 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -99,6 +99,7 @@ import Plutarch.Extra.ScriptContext (
pfromOutputDatum, pfromOutputDatum,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Sum (PSum (PSum))
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -106,9 +107,11 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pmatchC, pmatchC,
ptryFromC, ptryFromC,
) )
import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value ( import Plutarch.Extra.Value (
psymbolValueOf, psymbolValueOf,
) )
import Plutarch.Num (PNum (pnegate))
import Plutarch.SafeMoney ( import Plutarch.SafeMoney (
pvalueDiscrete, pvalueDiscrete,
pvalueDiscrete', pvalueDiscrete',
@ -154,30 +157,35 @@ stakePolicy gtClassRef =
mintedST <- pletC $ psymbolValueOf # ownSymbol # txInfoF.mint mintedST <- pletC $ psymbolValueOf # ownSymbol # txInfoF.mint
let burning = unTermCont $ do let burning = unTermCont $ do
pguardC "ST at inputs must be 1" $ let numStakeInputs =
spentST #== 1 pto $
pfoldMap @_ @_ @(PSum PInteger)
# plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- pletFieldsC @'["value", "datum"] txOut
let isStakeUTxO =
psymbolValueOf # ownSymbol # txOutF.value #== 1
pmatchC isStakeUTxO
>>= \case
PTrue -> do
let datum =
pfromData $
pfromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum
# txInfoF.datums
pguardC "Stake is unlocked" $
pnot # (pstakeLocked # datum)
pure $ pcon $ PSum 1
PFalse -> pure mempty
)
# pfromData txInfoF.inputs
pguardC "ST burned" $ pguardC "ST burned" $
mintedST #== -1 mintedST #== pnegate # numStakeInputs
pguardC "An unlocked input existed containing an ST" $
pany
# plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- pletFieldsC @'["value", "datum"] txOut
pure $
pif
(psymbolValueOf # ownSymbol # txOutF.value #== 1)
( let datum =
pfromData $
pfromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum
# txInfoF.datums
in pnot # (pstakeLocked # datum)
)
(pconstant False)
)
# pfromData txInfoF.inputs
pure $ popaque (pconstant ()) pure $ popaque (pconstant ())