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

38
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,31 +157,36 @@ 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)
pguardC "ST burned" $
mintedST #== -1
pguardC "An unlocked input existed containing an ST" $
pany
# plam # plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- pletFieldsC @'["value", "datum"] txOut txOutF <- pletFieldsC @'["value", "datum"] txOut
pure $
pif let isStakeUTxO =
(psymbolValueOf # ownSymbol # txOutF.value #== 1) psymbolValueOf # ownSymbol # txOutF.value #== 1
( let datum =
pmatchC isStakeUTxO
>>= \case
PTrue -> do
let datum =
pfromData $ pfromData $
pfromOutputDatum @(PAsData PStakeDatum) pfromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum # txOutF.datum
# txInfoF.datums # txInfoF.datums
in pnot # (pstakeLocked # datum)
) pguardC "Stake is unlocked" $
(pconstant False) pnot # (pstakeLocked # datum)
pure $ pcon $ PSum 1
PFalse -> pure mempty
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
pguardC "ST burned" $
mintedST #== pnegate # numStakeInputs
pure $ popaque (pconstant ()) pure $ popaque (pconstant ())
let minting = unTermCont $ do let minting = unTermCont $ do