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

make stake validator operate only on its own stakes

Browse source
This commit is contained in:
Hongrui Fang 2022-10-25 19:28:35 +08:00
parent e3143629fd
commit d0f3162fdc
1 changed files with 17 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -52,7 +52,7 @@ import Agora.Stake.Redeemers (
ppermitVote, ppermitVote,
pretractVote, pretractVote,
) )
import Agora.Utils (passert, pisDNothing, pmapMaybe) import Agora.Utils (passert, pisDNothing, pmapMaybe, pvalidatorHashToTokenName)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (PPubKeyCredential, PScriptCredential), PCredential (PPubKeyCredential, PScriptCredential),
PCurrencySymbol, PCurrencySymbol,
@ -70,6 +70,7 @@ import Plutarch.Api.V2 (
import Plutarch.Extra.AssetClass ( import Plutarch.Extra.AssetClass (
PAssetClass, PAssetClass,
PAssetClassData, PAssetClassData,
passetClass,
ptoScottEncoding, ptoScottEncoding,
) )
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
@ -274,9 +275,17 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
# (pfield @"_0" # stakeInputRef) # (pfield @"_0" # stakeInputRef)
# txInfoF.inputs # txInfoF.inputs
stakeValidatorCredential = stakeValidatorCredential <-
pfield @"credential" pletC $
#$ pfield @"address" # validatedInput pfield @"credential"
#$ pfield @"address" # validatedInput
let sstName = pvalidatorHashToTokenName #$ pmatch stakeValidatorCredential $
\case
PScriptCredential r -> pfield @"_0" # r
_ -> perror
sstClass <- pletC $ passetClass # sstSymbol # sstName
-------------------------------------------------------------------------- --------------------------------------------------------------------------
@ -287,7 +296,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
pmatch pmatch
( pcompareBy # pfromOrd ( pcompareBy # pfromOrd
# (psymbolValueOf # sstSymbol # txOutF.value) # (passetClassValueOf # sstClass # txOutF.value)
# 1 # 1
) )
$ \case $ \case
@ -417,7 +426,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
-------------------------------------------------------------------------- --------------------------------------------------------------------------
mintedST <- pletC $ psymbolValueOf # sstSymbol # txInfoF.mint mintedST <- pletC $ passetClassValueOf # sstClass # txInfoF.mint
pguardC "No new SST minted" $ pguardC "No new SST minted" $
foldl1 foldl1
@ -608,7 +617,7 @@ stakeValidator ::
:--> PValidator :--> PValidator
) )
stakeValidator = stakeValidator =
plam $ \cs pstClass gstClass -> plam $ \sstSymbol pstClass gstClass ->
mkStakeValidator mkStakeValidator
( StakeRedeemerImpl ( StakeRedeemerImpl
{ onDepositWithdraw = pdepositWithdraw { onDepositWithdraw = pdepositWithdraw
@ -619,6 +628,6 @@ stakeValidator =
, onClearDelegate = pclearDelegate , onClearDelegate = pclearDelegate
} }
) )
cs sstSymbol
(ptoScottEncoding # pstClass) (ptoScottEncoding # pstClass)
(ptoScottEncoding # gstClass) (ptoScottEncoding # gstClass)