diff --git a/agora.cabal b/agora.cabal index baa6b5c..e73243f 100644 --- a/agora.cabal +++ b/agora.cabal @@ -124,6 +124,7 @@ library Agora.AuthorityToken Agora.Effect Agora.Effect.TreasuryWithdrawal + Agora.Effect.NoOp Agora.Governor Agora.MultiSig Agora.Proposal diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index e8c3794..3a3b1e9 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -5,17 +5,13 @@ Description: Helpers for constructing effects Helpers for constructing effects. -} -module Agora.Effect ( - makeEffect, - noopEffect, -) where +module Agora.Effect (makeEffect) where import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.Utils (passert) -import Plutarch (popaque) import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue) -import Plutarch.Internal (punsafeCoerce) import Plutarch.Monadic qualified as P +import Plutarch.TryFrom (PTryFrom, ptryFrom) import Plutus.V1.Ledger.Value (CurrencySymbol) -------------------------------------------------------------------------------- @@ -28,7 +24,7 @@ import Plutus.V1.Ledger.Value (CurrencySymbol) -} makeEffect :: forall (datum :: PType). - PIsData datum => + (PIsData datum, PTryFrom PData datum) => CurrencySymbol -> (forall (s :: S). Term s PCurrencySymbol -> Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> ClosedTerm PValidator @@ -37,29 +33,24 @@ makeEffect gatCs' f = ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet ctx.txInfo - -- TODO: Use PTryFrom - let datum' :: Term _ datum - datum' = pfromData $ punsafeCoerce datum + -- convert input datum, PData, into desierable type + -- the way this conversion is performed should be defined + -- by PTryFrom for each datum in effect script. + (datum', _) <- ptryFrom @datum datum + -- ensure purpose is Spending. PSpending txOutRef <- pmatch $ pfromData ctx.purpose txOutRef' <- plet (pfield @"_0" # txOutRef) + -- fetch minted values to ensure single GAT is burned txInfo <- pletFields @'["mint"] txInfo' let mint :: Term _ PValue mint = txInfo.mint + -- fetch script context gatCs <- plet $ pconstant gatCs' passert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint + -- run effect function f gatCs datum' txOutRef' txInfo' - --------------------------------------------------------------------------------- - --- | Dummy effect which can only burn its GAT. -noopEffect :: CurrencySymbol -> ClosedTerm PValidator -noopEffect = - ( `makeEffect` - \_gatCs (_datum :: Term _ PUnit) _txOutRef _txInfo -> P.do - popaque (pconstant ()) - ) diff --git a/agora/Agora/Effect/NoOp.hs b/agora/Agora/Effect/NoOp.hs new file mode 100644 index 0000000..90782e9 --- /dev/null +++ b/agora/Agora/Effect/NoOp.hs @@ -0,0 +1,33 @@ +{- | +Module : Agora.Effect.NoOp +Maintainer : seungheon.ooh@gmail.com +Description: Dummy dumb dumb effect. + +A dumb effect that only burns its GAT. +-} +module Agora.Effect.NoOp (noOpValidator, PNoOp) where + +import Control.Applicative (Const) + +import Agora.Effect (makeEffect) +import Plutarch (popaque) +import Plutarch.Api.V1 (PValidator) +import Plutarch.TryFrom (PTryFrom (..)) +import Plutus.V1.Ledger.Value (CurrencySymbol) + +newtype PNoOp (s :: S) = PNoOp (Term s PUnit) + deriving (PlutusType, PIsData) via (DerivePNewtype PNoOp PUnit) + +instance PTryFrom PData PNoOp where + type PTryFromExcess PData PNoOp = Const () + ptryFrom' _ cont = + -- JUSTIFICATION: + -- We don't care anything about data. + -- It should always be reduced to Unit. + cont (pcon $ PNoOp (pconstant ()), ()) + +-- | Dummy effect which can only burn its GAT. +noOpValidator :: CurrencySymbol -> ClosedTerm PValidator +noOpValidator curr = makeEffect curr $ + \_ (_datum :: Term s PNoOp) _ _ -> P.do + popaque (pconstant ())