remove redundant unlock check from stake policy

This commit is contained in:
Hongrui Fang 2022-10-20 20:27:31 +08:00
parent 561cc6c378
commit 52ea8115e3
2 changed files with 10 additions and 21 deletions

View file

@ -123,7 +123,7 @@ specs =
, Destroy.mkTestTree , Destroy.mkTestTree
"Destroy locked stakes" "Destroy locked stakes"
Destroy.lockedStakes Destroy.lockedStakes
(Destroy.Validity (Just False) False) (Destroy.Validity (Just True) False)
, Destroy.mkTestTree , Destroy.mkTestTree
"not authorized by owner" "not authorized by owner"
Destroy.notAuthorized Destroy.notAuthorized

View file

@ -43,7 +43,6 @@ import Agora.Stake (
PStakeRedeemerHandlerContext PStakeRedeemerHandlerContext
), ),
StakeRedeemerImpl (..), StakeRedeemerImpl (..),
pstakeLocked,
) )
import Agora.Stake.Redeemers ( import Agora.Stake.Redeemers (
pclearDelegate, pclearDelegate,
@ -151,26 +150,16 @@ stakePolicy =
pto $ pto $
pfoldMap @_ @_ @(PSum PInteger) pfoldMap @_ @_ @(PSum PInteger)
# plam # plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do ( \((pfield @"resolved" #) -> txOut) ->
txOutF <- pletFieldsC @'["value", "datum"] txOut
let isStakeUTxO = let isStakeUTxO =
psymbolValueOf # ownSymbol # txOutF.value #== 1 psymbolValueOf
# ownSymbol
pmatchC isStakeUTxO # (pfield @"value" # txOut)
>>= \case #== 1
PTrue -> do in pif
let datum = isStakeUTxO
pfromData $ (pcon $ PSum 1)
pfromOutputDatum @(PAsData PStakeDatum) mempty
# txOutF.datum
# txInfoF.datums
pguardC "Stake is unlocked" $
pnot # (pstakeLocked # datum)
pure $ pcon $ PSum 1
PFalse -> pure mempty
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs