prevent minting SST while burning

This commit is contained in:
Hongrui Fang 2022-10-28 21:06:35 +08:00
parent 4fbd4b98f1
commit 621d98ddd6

View file

@ -52,7 +52,13 @@ import Agora.Stake.Redeemers (
ppermitVote, ppermitVote,
pretractVote, pretractVote,
) )
import Agora.Utils (passert, pisDNothing, pmapMaybe, pvalidatorHashToTokenName) import Agora.Utils (
passert,
pisDNothing,
pmapMaybe,
psymbolValueOf',
pvalidatorHashToTokenName,
)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (PPubKeyCredential, PScriptCredential), PCredential (PPubKeyCredential, PScriptCredential),
PCurrencySymbol, PCurrencySymbol,
@ -78,6 +84,7 @@ import Plutarch.Extra.Functor (PFunctor (pfmap))
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust) import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust)
import Plutarch.Extra.Maybe ( import Plutarch.Extra.Maybe (
passertPJust, passertPJust,
pfromJust,
pfromMaybe, pfromMaybe,
pjust, pjust,
pmaybeData, pmaybeData,
@ -89,7 +96,6 @@ 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,
@ -97,7 +103,6 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pmatchC, pmatchC,
ptryFromC, ptryFromC,
) )
import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value ( import Plutarch.Extra.Value (
passetClassValueOf, passetClassValueOf,
psymbolValueOf, psymbolValueOf,
@ -144,30 +149,18 @@ stakePolicy =
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
ownSymbol <- pletC $ pfield @"_0" # ownSymbol' ownSymbol <- pletC $ pfield @"_0" # ownSymbol'
spentST <- pletC $ psymbolValueOf # ownSymbol #$ pvalueSpent # txInfoF.inputs spentST <- pletC $ psymbolValueOf # ownSymbol #$ pvalueSpent # txInfoF.inputs
mintedST <- pletC $ psymbolValueOf # ownSymbol # txInfoF.mint
let burning = unTermCont $ do PPair mintedST burntST <-
let numStakeInputs = pmatchC $
pto $ pfromJust #$ psymbolValueOf'
pfoldMap @_ @_ @(PSum PInteger) # ownSymbol
# plam # txInfoF.mint
( \((pfield @"resolved" #) -> txOut) ->
let isStakeUTxO =
psymbolValueOf
# ownSymbol
# (pfield @"value" # txOut)
#== 1
in pif
isStakeUTxO
(pcon $ PSum 1)
mempty
)
# pfromData txInfoF.inputs
pguardC "ST burned" $ let burning =
mintedST #== pnegate # numStakeInputs passert
"All ST burned"
pure $ popaque (pconstant ()) (burntST #== pnegate # spentST)
(popaque $ pconstant ())
let minting = unTermCont $ do let minting = unTermCont $ do
pguardC "ST at inputs must be 0" $ pguardC "ST at inputs must be 0" $
@ -426,19 +419,6 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
-------------------------------------------------------------------------- --------------------------------------------------------------------------
mintedST <- pletC $ passetClassValueOf # sstClass # txInfoF.mint
pguardC "No new SST minted" $
foldl1
(#||)
[ ptraceIfTrue "All stakes burnt" $
mintedST #< 0 #&& pnull # stakeOutputDatums
, ptraceIfTrue "Nothing burnt" $
mintedST #== 0
]
--------------------------------------------------------------------------
-- Assemble the proposal context. -- Assemble the proposal context.
getProposalDatum <- pletC $ getProposalDatum <- pletC $