check that the datum nft always stays at the governor address
This commit is contained in:
parent
b546fc9701
commit
99365a32ae
1 changed files with 52 additions and 7 deletions
|
|
@ -30,20 +30,23 @@ import Generics.SOP (Generic, I (I))
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds)
|
import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds)
|
||||||
|
import Agora.Utils (findOutputsToAddress, passert, passetClassValueOf', pfindTxInByTxOutRef)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Plutarch (popaque)
|
import Plutarch (popaque)
|
||||||
import Plutarch.Api.V1 (PMintingPolicy, PValidator)
|
import Plutarch.Api.V1 (PMaybeData (PDJust), PMintingPolicy, PScriptPurpose (PSpending), PValidator, PValue)
|
||||||
import Plutarch.DataRepr (
|
import Plutarch.DataRepr (
|
||||||
DerivePConstantViaData (..),
|
DerivePConstantViaData (..),
|
||||||
PDataFields,
|
PDataFields,
|
||||||
PIsDataReprInstances (PIsDataReprInstances),
|
PIsDataReprInstances (PIsDataReprInstances),
|
||||||
)
|
)
|
||||||
import Plutarch.Lift (PUnsafeLiftDecl (..))
|
import Plutarch.Lift (PUnsafeLiftDecl (..))
|
||||||
|
import Plutarch.Monadic qualified as P
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
import Plutarch.Unsafe (punsafeCoerce)
|
||||||
import Plutus.V1.Ledger.Value (AssetClass)
|
import Plutus.V1.Ledger.Value (AssetClass)
|
||||||
import PlutusTx qualified
|
import PlutusTx qualified
|
||||||
|
|
||||||
|
|
@ -72,7 +75,7 @@ data GovernorRedeemer
|
||||||
| -- | Checks that a SINGLE proposal finished correctly,
|
| -- | Checks that a SINGLE proposal finished correctly,
|
||||||
-- and allows minting GATs for each effect script.
|
-- and allows minting GATs for each effect script.
|
||||||
MintGATs
|
MintGATs
|
||||||
| -- | Allow effects to mutate the datum
|
| -- | Allows effects to mutate the datum.
|
||||||
MutateDatum
|
MutateDatum
|
||||||
deriving stock (Show, GHC.Generic)
|
deriving stock (Show, GHC.Generic)
|
||||||
|
|
||||||
|
|
@ -86,7 +89,7 @@ PlutusTx.makeIsDataIndexed
|
||||||
-- | Parameters for creating Governor scripts.
|
-- | Parameters for creating Governor scripts.
|
||||||
data Governor = Governor
|
data Governor = Governor
|
||||||
{ datumNFT :: AssetClass
|
{ datumNFT :: AssetClass
|
||||||
-- ^ NFT that identifies the governor datum
|
-- ^ NFT that identifies the governor datum.
|
||||||
}
|
}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
@ -112,7 +115,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
|
||||||
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
|
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
|
||||||
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum)
|
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum)
|
||||||
|
|
||||||
-- | Plutarch-level version of 'GovernorRedeemer'
|
-- | Plutarch-level version of 'GovernorRedeemer'.
|
||||||
data PGovernorRedeemer (s :: S)
|
data PGovernorRedeemer (s :: S)
|
||||||
= PCreateProposal (Term s (PDataRecord '[]))
|
= PCreateProposal (Term s (PDataRecord '[]))
|
||||||
| PMintGATs (Term s (PDataRecord '[]))
|
| PMintGATs (Term s (PDataRecord '[]))
|
||||||
|
|
@ -137,6 +140,48 @@ governorPolicy _ =
|
||||||
|
|
||||||
-- | Validator for Governors.
|
-- | Validator for Governors.
|
||||||
governorValidator :: Governor -> ClosedTerm PValidator
|
governorValidator :: Governor -> ClosedTerm PValidator
|
||||||
governorValidator _ =
|
governorValidator params =
|
||||||
plam $ \_datum _redeemer _ctx' -> P.do
|
plam $ \_datum' redeemer' ctx' -> P.do
|
||||||
popaque (pconstant ())
|
-- TODO: use `PTryFrom`
|
||||||
|
redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer'
|
||||||
|
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||||
|
|
||||||
|
txInfo <- plet $ pfromData $ ctx.txInfo
|
||||||
|
|
||||||
|
PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose
|
||||||
|
let txOutRef = pfromData txOutRef'
|
||||||
|
|
||||||
|
PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo
|
||||||
|
ownInput <- pletFields @'["address", "value", "datumHash"] ownInput'
|
||||||
|
selfAddress <- plet $ pfromData $ ownInput.address
|
||||||
|
|
||||||
|
let ownInputDatumNFTAmount = datumNFTValueOf # ownInput.value
|
||||||
|
passert "own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1
|
||||||
|
|
||||||
|
ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress
|
||||||
|
passert "exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1
|
||||||
|
|
||||||
|
ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs
|
||||||
|
let ownOuputDatumNFTAmount = datumNFTValueOf # ownOutput.value
|
||||||
|
passert "datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1
|
||||||
|
passert "output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash
|
||||||
|
|
||||||
|
-- datum <- plet $ pfromData @PGovernorDatum $ punsafeCoerce datum'
|
||||||
|
|
||||||
|
case redeemer of
|
||||||
|
PCreateProposal _ -> P.do
|
||||||
|
perror
|
||||||
|
_ -> perror
|
||||||
|
where
|
||||||
|
datumNFTValueOf :: Term s (PValue :--> PInteger)
|
||||||
|
datumNFTValueOf = passetClassValueOf' params.datumNFT
|
||||||
|
|
||||||
|
pisDJust :: Term s (PMaybeData a :--> PBool)
|
||||||
|
pisDJust = phoistAcyclic $
|
||||||
|
plam $ \x ->
|
||||||
|
pmatch
|
||||||
|
x
|
||||||
|
( \case
|
||||||
|
PDJust _ -> pconstant True
|
||||||
|
_ -> pconstant False
|
||||||
|
)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue