stub of stake validator
This commit is contained in:
parent
df349b8f35
commit
b5ea62ca4d
1 changed files with 26 additions and 9 deletions
|
|
@ -7,6 +7,7 @@ module Agora.Stake (
|
||||||
StakeAction (..),
|
StakeAction (..),
|
||||||
Stake (..),
|
Stake (..),
|
||||||
stakePolicy,
|
stakePolicy,
|
||||||
|
stakeValidator,
|
||||||
stakeLocked,
|
stakeLocked,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
@ -114,15 +115,17 @@ anyInput = phoistAcyclic $
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
--
|
--
|
||||||
-- # What this Policy does
|
-- What this Policy does
|
||||||
--
|
--
|
||||||
-- For minting:
|
-- For minting:
|
||||||
-- Check that exactly 1 state thread is minted
|
-- Check that exactly 1 state thread is minted
|
||||||
-- Check that an output exists with a state thread and a valid datum
|
-- Check that an output exists with a state thread and a valid datum
|
||||||
-- Check that no state thread is an input
|
-- Check that no state thread is an input
|
||||||
--
|
--
|
||||||
-- FIXME: This doesn't check that it's paid to the right script address, can we?
|
-- > FIXME: This doesn't check that it's paid to the right script address, can we?
|
||||||
--
|
-- > Potential solution:
|
||||||
|
-- > Encode script hash in token-name.
|
||||||
|
-- > Then, those who script hash, will be able to verify.
|
||||||
--
|
--
|
||||||
-- For burning:
|
-- For burning:
|
||||||
-- Check that exactly 1 state thread is burned
|
-- Check that exactly 1 state thread is burned
|
||||||
|
|
@ -135,12 +138,10 @@ stakePolicy ::
|
||||||
, KnownSymbol n
|
, KnownSymbol n
|
||||||
, gt ~ '(ac, n, scale)
|
, gt ~ '(ac, n, scale)
|
||||||
) =>
|
) =>
|
||||||
Stake
|
Stake gt ->
|
||||||
gt ->
|
Term s (PData :--> PAsData PScriptContext :--> PUnit)
|
||||||
Term s (PData :--> PScriptContext :--> PUnit)
|
|
||||||
stakePolicy _stake =
|
stakePolicy _stake =
|
||||||
plam $ \_redeemer ctx'' -> P.do
|
plam $ \_redeemer ctx' -> P.do
|
||||||
PScriptContext ctx' <- pmatch ctx''
|
|
||||||
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||||
txInfo' <- plet ctx.txInfo
|
txInfo' <- plet ctx.txInfo
|
||||||
txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo'
|
txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo'
|
||||||
|
|
@ -148,7 +149,6 @@ stakePolicy _stake =
|
||||||
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
|
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
|
||||||
ownSymbol <- plet $ pfield @"_0" # ownSymbol'
|
ownSymbol <- plet $ pfield @"_0" # ownSymbol'
|
||||||
let stValue = psingletonValue # ownSymbol # pconstant "ST" # 1
|
let stValue = psingletonValue # ownSymbol # pconstant "ST" # 1
|
||||||
|
|
||||||
stOf <- plet $ plam $ \v -> passetClassValueOf # ownSymbol # pconstant "ST" # v
|
stOf <- plet $ plam $ \v -> passetClassValueOf # ownSymbol # pconstant "ST" # v
|
||||||
mintedST <- plet $ stOf # txInfo.mint
|
mintedST <- plet $ stOf # txInfo.mint
|
||||||
inputST <- plet $ stOf # (pvalueSpent # pfromData txInfo')
|
inputST <- plet $ stOf # (pvalueSpent # pfromData txInfo')
|
||||||
|
|
@ -202,3 +202,20 @@ stakeLocked = phoistAcyclic $
|
||||||
plam $ \_stakeDatum ->
|
plam $ \_stakeDatum ->
|
||||||
-- TODO: when we extend this to support proposals, this will need to do something
|
-- TODO: when we extend this to support proposals, this will need to do something
|
||||||
pcon PFalse
|
pcon PFalse
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
stakeValidator ::
|
||||||
|
forall (gt :: MoneyClass) ac n scale s.
|
||||||
|
( KnownSymbol ac
|
||||||
|
, KnownSymbol n
|
||||||
|
, gt ~ '(ac, n, scale)
|
||||||
|
) =>
|
||||||
|
Stake gt ->
|
||||||
|
Term s (PData :--> PData :--> PAsData PScriptContext :--> PUnit)
|
||||||
|
stakeValidator _stake =
|
||||||
|
plam $ \datum redeemer ctx' -> P.do
|
||||||
|
_ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||||
|
let _stakeAction = punsafeCoerce redeemer :: Term s (StakeAction gt)
|
||||||
|
_stakeDatum <- pletFields @'["owner"] (punsafeCoerce datum :: Term s (StakeDatum gt))
|
||||||
|
|
||||||
|
pconstant ()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue