parameterize scripts over AgoraScripts

agora-purescript-bridge/AgoraTypes.hs

@@ -31,14 +31,12 @@ agoraTypes =
   , mkSumType (Proxy @Proposal.ProposalVotes)
   , mkSumType (Proxy @Proposal.ProposalDatum)
   , mkSumType (Proxy @Proposal.ProposalRedeemer)
-  , mkSumType (Proxy @Proposal.Proposal)
   , -- Governor
     mkSumType (Proxy @Governor.GovernorDatum)
   , mkSumType (Proxy @Governor.GovernorRedeemer)
   , mkSumType (Proxy @Governor.Governor)
   , -- Stake
-    mkSumType (Proxy @Stake.Stake)
+    mkSumType (Proxy @Stake.ProposalLock)
-  , mkSumType (Proxy @Stake.ProposalLock)
   , mkSumType (Proxy @Stake.StakeRedeemer)
   , mkSumType (Proxy @Stake.StakeDatum)
   , -- Treasury

agora-scripts/Main.hs

@@ -8,16 +8,11 @@
 -}
 module Main (main) where
 
-import Agora.AuthorityToken (AuthorityToken, authorityTokenPolicy)
+import Agora.Bootstrap qualified as Bootstrap
-import Agora.Governor (Governor (Governor))
+import Agora.Governor (Governor (..))
-import Agora.Governor qualified as Governor
-import Agora.Governor.Scripts (authorityTokenFromGovernor, authorityTokenSymbolFromGovernor, governorPolicy, governorValidator, proposalFromGovernor, stakeFromGovernor)
-import Agora.Proposal (Proposal)
-import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
 import Agora.SafeMoney (GTTag)
-import Agora.Stake (Stake)
+import Agora.Scripts qualified as Scripts
-import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Agora.Utils (CompiledMintingPolicy (..), CompiledValidator (..))
-import Agora.Treasury (treasuryValidator)
 import Data.Aeson qualified as Aeson
 import Data.Default (def)
 import Data.Function ((&))
@@ -25,13 +20,16 @@ import Data.Tagged (Tagged)
 import Data.Text (Text)
 import Development.GitRev (gitBranch, gitHash)
 import GHC.Generics qualified as GHC
-import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
+import Plutarch (Config (..), TracingMode (DoTracing))
-import PlutusLedgerApi.V1 (TxOutRef)
+import PlutusLedgerApi.V1 (
-import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol)
+  MintingPolicy (getMintingPolicy),
-import PlutusLedgerApi.V1.Value qualified as Value
+  TxOutRef,
+  Validator (getValidator),
+ )
+import PlutusLedgerApi.V1.Value (AssetClass)
 import ScriptExport.API (runServer)
 import ScriptExport.Options (parseOptions)
-import ScriptExport.ScriptInfo (ScriptInfo, mkPolicyInfo, mkValidatorInfo)
+import ScriptExport.ScriptInfo (ScriptInfo (..), mkPolicyInfo, mkScriptInfo, mkValidatorInfo)
 import ScriptExport.Types (Builders, insertBuilder)
 
 main :: IO ()
@@ -81,44 +79,23 @@ builders =
 agoraScripts :: ScriptParams -> AgoraScripts
 agoraScripts params =
   AgoraScripts
-    { governorPolicyInfo = mkPolicyInfo (governorPolicy governor)
+    { governorPolicyInfo = mkPolicyInfo' scripts.compiledGovernorPolicy
-    , governorValidatorInfo = mkValidatorInfo (governorValidator governor)
+    , governorValidatorInfo = mkValidatorInfo' scripts.compiledGovernorValidator
-    , stakePolicyInfo = mkPolicyInfo (stakePolicy params.gtClassRef)
+    , stakePolicyInfo = mkPolicyInfo' scripts.compiledStakePolicy
-    , stakeValidatorInfo = mkValidatorInfo (stakeValidator stake)
+    , stakeValidatorInfo = mkValidatorInfo' scripts.compiledStakeValidator
-    , proposalPolicyInfo = mkPolicyInfo (proposalPolicy governorSTAssetClass)
+    , proposalPolicyInfo = mkPolicyInfo' scripts.compiledProposalPolicy
-    , proposalValidatorInfo = mkValidatorInfo (proposalValidator proposal)
+    , proposalValidatorInfo = mkValidatorInfo' scripts.compiledProposalValidator
-    , treasuryValidatorInfo = mkValidatorInfo (treasuryValidator authorityTokenSymbol)
+    , treasuryValidatorInfo = mkValidatorInfo' scripts.compiledTreasuryValidator
-    , authorityTokenPolicyInfo = mkPolicyInfo (authorityTokenPolicy authorityToken)
+    , authorityTokenPolicyInfo = mkPolicyInfo' scripts.compiledAuthorityTokenPolicy
     }
   where
-    governor :: Governor
     governor =
-      Governor
+      Agora.Governor.Governor
-        { Governor.gstOutRef = params.governorInitialSpend
+        params.governorInitialSpend
-        , Governor.gtClassRef = params.gtClassRef
+        params.gtClassRef
-        , Governor.maximumCosigners = params.maximumCosigners
+        params.maximumCosigners
-        }
 
-    authorityToken :: AuthorityToken
+    scripts = Bootstrap.agoraScripts plutarchConfig governor
-    authorityToken = authorityTokenFromGovernor governor
-
-    authorityTokenSymbol :: CurrencySymbol
-    authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
-
-    governorSTAssetClass :: AssetClass
-    governorSTAssetClass =
-      Value.assetClass
-        ( mintingPolicySymbol $
-            mkMintingPolicy def $
-              governorPolicy governor
-        )
-        ""
-
-    proposal :: Proposal
-    proposal = proposalFromGovernor governor
-
-    stake :: Stake
-    stake = stakeFromGovernor governor
 
 {- | Params required for creating script export.
 
@@ -162,3 +139,26 @@ data AgoraScripts = AgoraScripts
     , -- | @since 0.2.0
       GHC.Generic
     )
+
+{- | Default plutarch configuration for compiling scripts.
+
+     TODO: we should have an option to control this.
+
+     @since 0.2.0
+-}
+plutarchConfig :: Config
+plutarchConfig = Config {tracingMode = DoTracing}
+
+{- | Turn a precompiled minting policy to a 'ScriptInfo'.
+
+     @since 0.2.0
+-}
+mkPolicyInfo' :: forall redeemer. CompiledMintingPolicy redeemer -> ScriptInfo
+mkPolicyInfo' = mkScriptInfo . getMintingPolicy . getCompiledMintingPolicy
+
+{- | Turn a precompiled validator to a 'ScriptInfo'.
+
+     @since 0.2.0
+-}
+mkValidatorInfo' :: forall redeemer datum. CompiledValidator datum redeemer -> ScriptInfo
+mkValidatorInfo' = mkScriptInfo . getValidator . getCompiledValidator

agora.cabal

@@ -95,6 +95,7 @@ common deps
     , bytestring
     , cardano-binary
     , cardano-prelude
+    , composition-prelude
     , containers
     , data-default
     , data-default-class
@@ -143,6 +144,7 @@ library
   exposed-modules:
     Agora.Aeson.Orphans
     Agora.AuthorityToken
+    Agora.Bootstrap
     Agora.Effect
     Agora.Effect.GovernorMutation
     Agora.Effect.NoOp
@@ -154,6 +156,7 @@ library
     Agora.Proposal.Scripts
     Agora.Proposal.Time
     Agora.SafeMoney
+    Agora.Scripts
     Agora.Stake
     Agora.Stake.Scripts
     Agora.Treasury

agora/Agora/Bootstrap.hs

@@ -0,0 +1,67 @@
+{- | Module     : Agora.Bootstrap
+     Maintainer : connor@mlabs.city
+     Description: Initialize a governance system
+
+     Initialize a governance system
+-}
+module Agora.Bootstrap (agoraScripts) where
+
+import Agora.AuthorityToken (AuthorityToken (..), authorityTokenPolicy)
+import Agora.Governor (Governor (..))
+import Agora.Governor.Scripts (governorPolicy, governorValidator)
+import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
+import Agora.Scripts (AgoraScripts (AgoraScripts))
+import Agora.Scripts qualified as Scripts
+import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Agora.Treasury (treasuryValidator)
+import Agora.Utils (
+  CompiledMintingPolicy (..),
+  CompiledValidator (..),
+ )
+import Plutarch (Config)
+import Plutarch.Api.V1 (
+  mintingPolicySymbol,
+  mkMintingPolicy,
+  mkValidator,
+ )
+import PlutusLedgerApi.V1.Value (AssetClass (..))
+
+{- | Parameterize and precompiled core scripts, given the
+     'Agora.Governor.Governor' parameters and plutarch configurations.
+
+     @since 0.2.0
+-}
+agoraScripts :: Config -> Governor -> AgoraScripts
+agoraScripts conf gov = scripts
+  where
+    mkMintingPolicy' = mkMintingPolicy conf
+    mkValidator' = mkValidator conf
+
+    compiledGovernorPolicy = mkMintingPolicy' $ governorPolicy gov.gstOutRef
+    compiledGovernorValidator = mkValidator' $ governorValidator scripts
+    governorSymbol = mintingPolicySymbol compiledGovernorPolicy
+    governorAssetClass = AssetClass (governorSymbol, "")
+
+    authority = AuthorityToken governorAssetClass
+    compiledAuthorityPolicy = mkMintingPolicy' $ authorityTokenPolicy authority
+    authorityTokenSymbol = mintingPolicySymbol compiledAuthorityPolicy
+
+    compiledProposalPolicy = mkMintingPolicy' $ proposalPolicy governorAssetClass
+    compiledProposalValidator = mkValidator' $ proposalValidator scripts gov.maximumCosigners
+
+    compiledStakePolicy = mkMintingPolicy' $ stakePolicy gov.gtClassRef
+    compiledStakeValidator = mkValidator' $ stakeValidator scripts gov.gtClassRef
+
+    compiledTreasuryValidator = mkValidator' $ treasuryValidator authorityTokenSymbol
+
+    scripts =
+      AgoraScripts
+        { Scripts.compiledGovernorPolicy = CompiledMintingPolicy compiledGovernorPolicy
+        , Scripts.compiledGovernorValidator = CompiledValidator compiledGovernorValidator
+        , Scripts.compiledStakePolicy = CompiledMintingPolicy compiledStakePolicy
+        , Scripts.compiledStakeValidator = CompiledValidator compiledStakeValidator
+        , Scripts.compiledProposalPolicy = CompiledMintingPolicy compiledProposalPolicy
+        , Scripts.compiledProposalValidator = CompiledValidator compiledProposalValidator
+        , Scripts.compiledTreasuryValidator = CompiledValidator compiledTreasuryValidator
+        , Scripts.compiledAuthorityTokenPolicy = CompiledMintingPolicy compiledAuthorityPolicy
+        }

agora/Agora/Effect.hs

@@ -23,7 +23,7 @@ import PlutusLedgerApi.V1.Value (CurrencySymbol)
 -}
 makeEffect ::
   forall (datum :: PType).
-  (PTryFrom PData datum) =>
+  (PTryFrom PData datum, PIsData datum) =>
   CurrencySymbol ->
   (forall (s :: S). Term s PCurrencySymbol -> Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) ->
   ClosedTerm PValidator

agora/Agora/Effect/GovernorMutation.hs

@@ -20,16 +20,12 @@ module Agora.Effect.GovernorMutation (
 
 import Agora.Effect (makeEffect)
 import Agora.Governor (
-  Governor,
   GovernorDatum,
   PGovernorDatum,
   pisGovernorDatumValid,
  )
-import Agora.Governor.Scripts (
-  authorityTokenSymbolFromGovernor,
-  governorSTAssetClassFromGovernor,
- )
 import Agora.Plutarch.Orphans ()
+import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass)
 import Generics.SOP qualified as SOP
 import Plutarch.Api.V1 (
   PTxOutRef,
@@ -149,8 +145,11 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
 
      @since 0.1.0
 -}
-mutateGovernorValidator :: Governor -> ClosedTerm PValidator
+mutateGovernorValidator ::
-mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
+  -- | Lazy precompiled scripts. This is beacuse we need the symbol of GST.
+  AgoraScripts ->
+  ClosedTerm PValidator
+mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $
   \_gatCs (datum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do
     datumF <- pletFieldsC @'["newDatum", "governorRef"] datum
     txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums"] txInfo
@@ -223,4 +222,4 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
     gstValueOf :: Term s (PValue _ _ :--> PInteger)
     gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn
       where
-        AssetClass (cs, tn) = governorSTAssetClassFromGovernor gov
+        AssetClass (cs, tn) = governorSTAssetClass as

agora/Agora/Governor/Scripts.hs

@@ -12,33 +12,15 @@ module Agora.Governor.Scripts (
   -- * Scripts
   governorPolicy,
   governorValidator,
-
-  -- * Bridges
-  governorSTSymbolFromGovernor,
-  governorSTAssetClassFromGovernor,
-  proposalSTAssetClassFromGovernor,
-  stakeSTSymbolFromGovernor,
-  stakeFromGovernor,
-  stakeValidatorHashFromGovernor,
-  proposalFromGovernor,
-  proposalValidatorHashFromGovernor,
-  proposalSTSymbolFromGovernor,
-  stakeSTAssetClassFromGovernor,
-  governorValidatorHash,
-  authorityTokenFromGovernor,
-  authorityTokenSymbolFromGovernor,
 ) where
 
 --------------------------------------------------------------------------------
 
 import Agora.AuthorityToken (
-  AuthorityToken (..),
-  authorityTokenPolicy,
   authorityTokensValidIn,
   singleAuthorityTokenBurned,
  )
 import Agora.Governor (
-  Governor (gstOutRef, gtClassRef, maximumCosigners),
   GovernorRedeemer (..),
   PGovernorDatum (PGovernorDatum),
   pgetNextProposalId,
@@ -46,7 +28,6 @@ import Agora.Governor (
  )
 import Agora.Proposal (
   PProposalDatum (..),
-  Proposal (..),
   ProposalStatus (Draft, Locked),
   phasNeutralEffect,
   pisEffectsVotesCompatible,
@@ -54,27 +35,17 @@ import Agora.Proposal (
   pneutralOption,
   pwinner,
  )
-import Agora.Proposal.Scripts (
-  proposalPolicy,
-  proposalValidator,
- )
 import Agora.Proposal.Time (createProposalStartingTime)
+import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTSymbol, proposalSTSymbol, proposalValidatoHash, stakeSTSymbol)
 import Agora.Stake (
   PProposalLock (..),
   PStakeDatum (..),
-  Stake (..),
   pnumCreatedProposals,
  )
-import Agora.Stake.Scripts (
-  stakePolicy,
-  stakeValidator,
- )
 import Agora.Utils (
   mustFindDatum',
   validatorHashToAddress,
-  validatorHashToTokenName,
  )
-import Data.Default (def)
 import Plutarch.Api.V1 (
   PAddress,
   PCurrencySymbol,
@@ -85,10 +56,6 @@ import Plutarch.Api.V1 (
   PTxOut,
   PValidator,
   PValidatorHash,
-  mintingPolicySymbol,
-  mkMintingPolicy,
-  mkValidator,
-  validatorHash,
  )
 import Plutarch.Api.V1.AssetClass (
   passetClass,
@@ -110,17 +77,10 @@ import Plutarch.Extra.Map (
   plookup,
   plookup',
  )
-import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pisDJust)
+import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pfromJust, pisDJust)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
-import PlutusLedgerApi.V1 (
+import PlutusLedgerApi.V1 (TxOutRef)
-  CurrencySymbol (..),
-  MintingPolicy,
- )
-import PlutusLedgerApi.V1.Scripts (ValidatorHash (..))
-import PlutusLedgerApi.V1.Value (
-  AssetClass (..),
- )
 
 --------------------------------------------------------------------------------
 
@@ -151,10 +111,10 @@ import PlutusLedgerApi.V1.Value (
 
   @since 0.1.0
 -}
-governorPolicy :: Governor -> ClosedTerm PMintingPolicy
+governorPolicy :: TxOutRef -> ClosedTerm PMintingPolicy
-governorPolicy gov =
+governorPolicy initialSpend =
   plam $ \_ ctx' -> unTermCont $ do
-    let oref = pconstant gov.gstOutRef
+    let oref = pconstant initialSpend
 
     PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatchC (pfromData $ pfield @"purpose" # ctx')
     let ownAssetClass = passetClass # ownSymbol # pconstant ""
@@ -273,8 +233,11 @@ governorPolicy gov =
 
      @since 0.1.0
 -}
-governorValidator :: Governor -> ClosedTerm PValidator
+governorValidator ::
-governorValidator gov =
+  -- | Lazy precompiled scripts.
+  AgoraScripts ->
+  ClosedTerm PValidator
+governorValidator as =
   plam $ \datum' redeemer' ctx' -> unTermCont $ do
     ctxF <- pletAllC ctx'
 
@@ -404,7 +367,7 @@ governorValidator gov =
           proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum'
 
           let expectedStartingTime =
-                createProposalStartingTime
+                pfromJust #$ createProposalStartingTime
                   # oldGovernorDatumF.createProposalTimeRangeMaxWidth
                   # txInfoF.validRange
 
@@ -604,160 +567,23 @@ governorValidator gov =
   where
     -- The currency symbol of authority token.
     patSymbol :: Term s PCurrencySymbol
-    patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov
+    patSymbol = pconstant $ authorityTokenSymbol as
 
     -- The currency symbol of the proposal state token.
     ppstSymbol :: Term s PCurrencySymbol
-    ppstSymbol =
+    ppstSymbol = pconstant $ proposalSTSymbol as
-      let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
-       in phoistAcyclic $ pconstant sym
 
     -- The address of the proposal validator.
     pproposalValidatorAddress :: Term s PAddress
     pproposalValidatorAddress =
-      let vh = proposalValidatorHashFromGovernor gov
+      pconstant $
-       in phoistAcyclic $ pconstant $ validatorHashToAddress vh
+        validatorHashToAddress $
+          proposalValidatoHash as
 
     -- The currency symbol of the stake state token.
     psstSymbol :: Term s PCurrencySymbol
-    psstSymbol =
+    psstSymbol = pconstant $ stakeSTSymbol as
-      let sym = stakeSTSymbolFromGovernor gov
-       in phoistAcyclic $ pconstant sym
 
     -- The currency symbol of the governor state token.
     pgstSymbol :: Term s PCurrencySymbol
-    pgstSymbol =
+    pgstSymbol = pconstant $ governorSTSymbol as
-      let sym = governorSTSymbolFromGovernor gov
-       in phoistAcyclic $ pconstant sym
-
---------------------------------------------------------------------------------
-
-{- | Get the 'CurrencySymbol' of GST.
-
-     @since 0.1.0
--}
-governorSTSymbolFromGovernor :: Governor -> CurrencySymbol
-governorSTSymbolFromGovernor gov = mintingPolicySymbol policy
-  where
-    policy :: MintingPolicy
-    policy = mkMintingPolicy def $ governorPolicy gov
-
-{- | Get the 'AssetClass' of GST.
-
-     @since 0.1.0
--}
-governorSTAssetClassFromGovernor :: Governor -> AssetClass
-governorSTAssetClassFromGovernor gov = AssetClass (symbol, "")
-  where
-    symbol :: CurrencySymbol
-    symbol = governorSTSymbolFromGovernor gov
-
-{- | Get the 'CurrencySymbol' of the proposal state token.
-
-     @since 0.1.0
--}
-proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol
-proposalSTSymbolFromGovernor gov = symbol
-  where
-    gstAC = governorSTAssetClassFromGovernor gov
-    policy = mkMintingPolicy def $ proposalPolicy gstAC
-    symbol = mintingPolicySymbol policy
-
-{- | Get the 'AssetClass' of the proposal state token.
-
-     @since 0.1.0
--}
-proposalSTAssetClassFromGovernor :: Governor -> AssetClass
-proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "")
-  where
-    symbol = proposalSTSymbolFromGovernor gov
-
-{- | Get the 'CurrencySymbol' of the stake token/
-
-     @since 0.1.0
--}
-stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol
-stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
-  where
-    policy = mkMintingPolicy def $ stakePolicy gov.gtClassRef
-
-{- | Get the 'AssetClass' of the stake token.
-
-   Note that the token is tagged with the hash of the stake validator.
-   See 'Agora.Stake.Script.stakePolicy'.
-
-    @since 0.1.0
--}
-stakeSTAssetClassFromGovernor :: Governor -> AssetClass
-stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
-  where
-    symbol = stakeSTSymbolFromGovernor gov
-
-    -- Tag with the address where the token is being sent to.
-    tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov
-
-{- | Get the 'Stake' parameter, given the 'Governor' parameter.
-
-     @since 0.1.0
--}
-stakeFromGovernor :: Governor -> Stake
-stakeFromGovernor gov =
-  Stake gov.gtClassRef $
-    proposalSTAssetClassFromGovernor gov
-
-{- | Get the hash of 'Agora.Stake.Script.stakePolicy'.
-
-     @since 0.1.0
--}
-stakeValidatorHashFromGovernor :: Governor -> ValidatorHash
-stakeValidatorHashFromGovernor gov = validatorHash validator
-  where
-    params = stakeFromGovernor gov
-    validator = mkValidator def $ stakeValidator params
-
-{- | Get the 'Proposal' parameter, given the 'Governor' parameter.
-
-     @since 0.1.0
--}
-proposalFromGovernor :: Governor -> Proposal
-proposalFromGovernor gov = Proposal gstAC sstAC mc
-  where
-    gstAC = governorSTAssetClassFromGovernor gov
-    mc = gov.maximumCosigners
-    sstAC = stakeSTAssetClassFromGovernor gov
-
-{- | Get the hash of 'Agora.Proposal.proposalPolicy'.
-
-     @since 0.1.0
--}
-proposalValidatorHashFromGovernor :: Governor -> ValidatorHash
-proposalValidatorHashFromGovernor gov = validatorHash validator
-  where
-    params = proposalFromGovernor gov
-    validator = mkValidator def $ proposalValidator params
-
-{- | Get the hash of 'Agora.Proposal.proposalValidator'.
-
-     @since 0.1.0
--}
-governorValidatorHash :: Governor -> ValidatorHash
-governorValidatorHash gov = validatorHash validator
-  where
-    validator = mkValidator def $ governorValidator gov
-
-{- | Get the 'AuthorityToken' parameter given the 'Governor' parameter.
-
-     @since 0.1.0
--}
-authorityTokenFromGovernor :: Governor -> AuthorityToken
-authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov
-
-{- | Get the 'CurrencySymbol' of the authority token.
-
-     @since 0.1.0
--}
-authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol
-authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy
-  where
-    policy = mkMintingPolicy def $ authorityTokenPolicy params
-    params = authorityTokenFromGovernor gov

agora/Agora/Plutarch/Orphans.hs

@@ -1,15 +1,39 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
+{- FIXME: All of the following instances and
+   types ought to belong in either plutarch or
+   plutarch-extra.
+-}
+
 module Agora.Plutarch.Orphans () where
 
-import Plutarch.Api.V1 (PDatumHash)
+import Plutarch.Api.V1 (PDatumHash (..))
 import Plutarch.Builtin (PIsData (..))
+import Plutarch.Extra.TermCont (ptryFromC)
+import Plutarch.TryFrom (PTryFrom (..))
+import Plutarch.Unsafe (punsafeCoerce)
 
--- TODO: add checks
+newtype Flip f a b = Flip (f b a) deriving stock (Generic)
-instance PTryFrom PData (PAsData PDatumHash)
 
+-- | @since 0.1.0
+instance PTryFrom PData (PAsData PDatumHash) where
+  type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
+  ptryFrom' opq = runTermCont $ do
+    (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq
+
+    tcont $ \f ->
+      pif
+        -- Blake2b_256 hash: 256 bits/32 bytes.
+        (plengthBS # unwrapped #== 32)
+        (f ())
+        (ptraceError "ptryFrom(PDatumHash): must be 32 bytes long")
+
+    pure (punsafeCoerce opq, pcon $ PDatumHash unwrapped)
+
+-- | @since 0.2.0
 instance PTryFrom PData (PAsData PUnit)
 
+-- | @since 0.2.0
 instance (PIsData a) => PIsData (PAsData a) where
-  pfromDataImpl = pfromData
+  pfromDataImpl = punsafeCoerce
   pdataImpl = pdataImpl . pfromData

agora/Agora/Proposal.hs

@@ -9,7 +9,8 @@ Proposal scripts encoding effects that operate on the system.
 -}
 module Agora.Proposal (
   -- * Haskell-land
-  Proposal (..),
+
+  -- Proposal (..),
   ProposalDatum (..),
   ProposalRedeemer (..),
   ProposalStatus (..),
@@ -76,7 +77,6 @@ import Plutarch.Lift (
 import Plutarch.SafeMoney (PDiscrete (..))
 import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
-import PlutusLedgerApi.V1.Value (AssetClass)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as AssocMap
 
@@ -398,29 +398,6 @@ PlutusTx.makeIsDataIndexed
   , ('AdvanceProposal, 3)
   ]
 
-{- | Parameters that identify the Proposal validator script.
-
-     @since 0.1.0
--}
-data Proposal = Proposal
-  { governorSTAssetClass :: AssetClass
-  , stakeSTAssetClass :: AssetClass
-  , maximumCosigners :: Integer
-  -- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
-  }
-  deriving stock
-    ( -- | @since 0.1.0
-      Show
-    , -- | @since 0.1.0
-      Eq
-    , -- | @since 0.1.0
-      Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.2.0
-      SOP.Generic
-    )
-
 --------------------------------------------------------------------------------
 -- Plutarch-land
 

agora/Agora/Proposal/Scripts.hs

@@ -14,7 +14,6 @@ import Agora.Proposal (
   PProposalDatum (PProposalDatum),
   PProposalRedeemer (..),
   PProposalVotes (PProposalVotes),
-  Proposal (..),
   ProposalStatus (..),
   pretractVotes,
   pwinner',
@@ -26,6 +25,7 @@ import Agora.Proposal.Time (
   isLockingPeriod,
   isVotingPeriod,
  )
+import Agora.Scripts (AgoraScripts, governorSTSymbol, proposalSTSymbol, stakeSTAssetClass)
 import Agora.Stake (
   PProposalLock (..),
   PStakeDatum (..),
@@ -37,7 +37,6 @@ import Agora.Stake (
   pisVoter,
  )
 import Agora.Utils (
-  getMintingPolicySymbol,
   mustFindDatum',
   pltAsData,
  )
@@ -75,7 +74,7 @@ import Plutarch.Extra.TermCont (
  )
 import Plutarch.SafeMoney (PDiscrete (..))
 import Plutarch.Unsafe (punsafeCoerce)
-import PlutusLedgerApi.V1.Value (AssetClass (AssetClass, unAssetClass))
+import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
 
 {- | Policy for Proposals.
 
@@ -152,8 +151,13 @@ proposalPolicy (AssetClass (govCs, govTn)) =
 
      @since 0.1.0
 -}
-proposalValidator :: Proposal -> ClosedTerm PValidator
+proposalValidator ::
-proposalValidator proposal =
+  -- | Lazy precompiled scripts.
+  AgoraScripts ->
+  -- | See 'Agora.Governor.Governor.maximumCosigners'.
+  Integer ->
+  ClosedTerm PValidator
+proposalValidator as maximumCosigners =
   plam $ \datum redeemer ctx' -> unTermCont $ do
     PScriptContext ctx' <- pmatchC ctx'
     ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
@@ -185,8 +189,7 @@ proposalValidator proposal =
 
     currentStatus <- pletC $ pfromData $ proposalF.status
 
-    let stCurrencySymbol =
+    let stCurrencySymbol = pconstant $ proposalSTSymbol as
-          pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass)
 
     signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
 
@@ -239,20 +242,6 @@ proposalValidator proposal =
 
     onlyStatusChanged <-
       pletC $
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
-        -- Only the status of proposals is updated.
-
         -- Only the status of proposals is updated.
         proposalOut
           #== mkRecordConstr
@@ -271,7 +260,7 @@ proposalValidator proposal =
 
     -- Find the stake inputs/outputs by SST.
 
-    let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
+    let AssetClass (stakeSym, stakeTn) = stakeSTAssetClass as
     stakeSTAssetClass <-
       pletC $ passetClass # pconstant stakeSym # pconstant stakeTn
 
@@ -421,7 +410,7 @@ proposalValidator proposal =
                   # proposalF.cosigners
 
             pguardC "Less cosigners than maximum limit" $
-              plength # updatedSigs #< pconstant proposal.maximumCosigners
+              plength # updatedSigs #< pconstant maximumCosigners
 
             pguardC "Cosigners are unique" $
               pisUniq' # updatedSigs
@@ -456,6 +445,7 @@ proposalValidator proposal =
             pguardC "Proposal time should be wthin the voting period" $
               isVotingPeriod # proposalF.timingConfig
                 # proposalF.startingTime
+                #$ pfromJust
                 # currentTime
 
             -- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
@@ -610,8 +600,9 @@ proposalValidator proposal =
           ----------------------------------------------------------------------
 
           PAdvanceProposal _ ->
-            let fromDraft = withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
+            let currentTime' = pfromJust # currentTime
-                  pmatchC (isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime) >>= \case
+                fromDraft = withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
+                  pmatchC (isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime') >>= \case
                     PTrue -> do
                       pguardC "More cosigns than minimum amount" $
                         punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
@@ -636,9 +627,9 @@ proposalValidator proposal =
                     "Only status changes in the output proposal"
                     onlyStatusChanged
 
-                  inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                  inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
-                  inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                  inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
-                  inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                  inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
 
                   proposalStatus <- pletC $ pto $ pfromData proposalF.status
 
@@ -659,10 +650,7 @@ proposalValidator proposal =
                   pguardC "Cannot advance ahead of time" notTooEarly
                   pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
 
-                  let gstSymbol =
+                  let gstSymbol = pconstant $ governorSTSymbol as
-                        pconstant $
-                          fst $
-                            unAssetClass proposal.governorSTAssetClass
 
                   gstMoved <-
                     pletC $

agora/Agora/Proposal/Time.hs

@@ -30,6 +30,7 @@ module Agora.Proposal.Time (
   pisMaxTimeRangeWidthValid,
 ) where
 
+import Control.Composition ((.*))
 import Generics.SOP qualified as SOP
 import Plutarch.Api.V1 (
   PExtended (PFinite),
@@ -43,14 +44,16 @@ import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
  )
-import Plutarch.Extra.Field (pletAllC)
+import Plutarch.Extra.Applicative (PApply (pliftA2))
-import Plutarch.Extra.TermCont (pguardC, pmatchC)
+import Plutarch.Extra.Field (pletAll, pletAllC)
+import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing)
+import Plutarch.Extra.TermCont (pmatchC)
 import Plutarch.Lift (
   DerivePConstantViaNewtype (..),
   PConstantDecl,
   PUnsafeLiftDecl (..),
  )
-import PlutusLedgerApi.V1.Time (POSIXTime)
+import PlutusLedgerApi.V1 (POSIXTime)
 import PlutusTx qualified
 import Prelude
 
@@ -344,23 +347,33 @@ pisMaxTimeRangeWidthValid =
 
      @since 0.1.0
 -}
-createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime)
+createProposalStartingTime ::
+  forall (s :: S).
+  Term
+    s
+    ( PMaxTimeRangeWidth
+        :--> PPOSIXTimeRange
+        :--> PMaybe PProposalStartingTime
+    )
 createProposalStartingTime = phoistAcyclic $
-  plam $ \(pto -> maxDuration) iv -> unTermCont $ do
+  plam $ \(pto -> maxDuration) iv ->
-    currentTimeF <- pmatchC $ currentProposalTime # iv
+    let ct = currentProposalTime # iv
 
-    -- Use the middle of the current time range as the starting time.
+        f :: Term _ (PProposalTime :--> PMaybe PProposalStartingTime)
-    let duration = currentTimeF.upperBound - currentTimeF.lowerBound
+        f = plam $
+          flip pmatch $ \(PProposalTime lb ub) ->
+            let duration = ub - lb
 
-        startingTime =
+                startingTime = pdiv # (lb + ub) # 2
-          pdiv
+             in pif
-            # (currentTimeF.lowerBound + currentTimeF.upperBound)
+                  (duration #<= maxDuration)
-            # 2
+                  (pjust #$ pcon $ PProposalStartingTime startingTime)
-
+                  ( ptrace
-    pguardC "createProposalStartingTime: given time range should be tight enough" $
+                      "createProposalStartingTime: given time range should be tight enough"
-      duration #<= maxDuration
+                      pnothing
-
+                  )
-    pure $ pcon $ PProposalStartingTime startingTime
+     in -- TODO: PMonad when?
+        pmaybe # pnothing # f # ct
 
 {- | Get the current proposal time, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
 
@@ -369,33 +382,30 @@ createProposalStartingTime = phoistAcyclic $
 
      @since 0.1.0
 -}
-currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTime)
+currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PMaybe PProposalTime)
 currentProposalTime = phoistAcyclic $
   plam $ \iv -> unTermCont $ do
     PInterval iv' <- pmatchC iv
     ivf <- pletAllC iv'
     PLowerBound lb <- pmatchC ivf.from
     PUpperBound ub <- pmatchC ivf.to
-    lbf <- pletAllC lb
+
-    ubf <- pletAllC ub
+    let getBound = phoistAcyclic $
-    pure $
+          plam $
-      pcon $
+            flip pletAll $ \f ->
-        PProposalTime
+              pif
-          { lowerBound =
+                f._1
-              pmatch
+                ( pmatch f._0 $ \case
-                lbf._0
+                    PFinite (pfromData . (pfield @"_0" #) -> d) -> pjust # d
-                ( \case
+                    _ -> ptrace "currentProposalTime: time range should be bounded" pnothing
-                    PFinite ((pfield @"_0" #) -> d) -> d
-                    _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
                 )
-          , upperBound =
+                (ptrace "currentProposalTime: time range should be inclusive" pnothing)
-              pmatch
+
-                ubf._0
+        lowerBound = getBound # lb
-                ( \case
+        upperBound = getBound # ub
-                    PFinite ((pfield @"_0" #) -> d) -> d
+
-                    _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
+        mkTime = phoistAcyclic $ plam $ pcon .* PProposalTime
-                )
+    pure $ pliftA2 # mkTime # lowerBound # upperBound
-          }
 
 {- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
 

agora/Agora/Scripts.hs

@@ -0,0 +1,138 @@
+{- | Module     : Agora.Scripts
+     Maintainer : connor@mlabs.city
+     Description: Precompiled core scripts and utilities
+
+     Precompiled core scripts and utilities
+-}
+module Agora.Scripts (
+  AgoraScripts (..),
+  governorSTSymbol,
+  governorSTAssetClass,
+  governorValidatorHash,
+  proposalSTSymbol,
+  proposalSTAssetClass,
+  proposalValidatoHash,
+  stakeSTSymbol,
+  stakeSTAssetClass,
+  stakeValidatorHash,
+  authorityTokenSymbol,
+  treasuryValidatorHash,
+) where
+
+import Agora.Governor (GovernorDatum, GovernorRedeemer)
+import Agora.Proposal (ProposalDatum, ProposalRedeemer)
+import Agora.Stake (StakeDatum, StakeRedeemer)
+import Agora.Treasury (TreasuryRedeemer)
+import Agora.Utils (CompiledMintingPolicy (..), CompiledValidator (..), validatorHashToTokenName)
+import Plutarch.Api.V1 (mintingPolicySymbol, validatorHash)
+import PlutusLedgerApi.V1 (CurrencySymbol)
+import PlutusLedgerApi.V1.Scripts (ValidatorHash)
+import PlutusLedgerApi.V1.Value (AssetClass (..))
+
+{- | Precompiled core scripts.
+
+     Including:
+
+    - Governor policy
+    - Governor validator
+    - Proposal policy
+    - Proposal validator
+    - Stake policy
+    - Stake validator
+    - Treasury validator
+    - Authority token policy
+
+     @since 0.2.0
+-}
+data AgoraScripts = AgoraScripts
+  { compiledGovernorPolicy :: CompiledMintingPolicy ()
+  , compiledGovernorValidator :: CompiledValidator GovernorDatum GovernorRedeemer
+  , compiledStakePolicy :: CompiledMintingPolicy ()
+  , compiledStakeValidator :: CompiledValidator StakeDatum StakeRedeemer
+  , compiledProposalPolicy :: CompiledMintingPolicy ()
+  , compiledProposalValidator :: CompiledValidator ProposalDatum ProposalRedeemer
+  , compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer
+  , compiledAuthorityTokenPolicy :: CompiledMintingPolicy ()
+  }
+
+{- | Get the currency symbol of the governor state token.
+
+     @since 0.2.0
+-}
+governorSTSymbol :: AgoraScripts -> CurrencySymbol
+governorSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledGovernorPolicy
+
+{- | Get the asset class of the governor state token.
+
+     @since 0.2.0
+-}
+governorSTAssetClass :: AgoraScripts -> AssetClass
+governorSTAssetClass as = AssetClass (governorSTSymbol as, "")
+
+{- | Get the script hash of the governor validator.
+
+     @since 0.2.0
+-}
+governorValidatorHash :: AgoraScripts -> ValidatorHash
+governorValidatorHash = validatorHash . getCompiledValidator . compiledGovernorValidator
+
+{- | Get the currency symbol of the propsoal state token.
+
+     @since 0.2.0
+-}
+proposalSTSymbol :: AgoraScripts -> CurrencySymbol
+proposalSTSymbol as = mintingPolicySymbol $ getCompiledMintingPolicy as.compiledProposalPolicy
+
+{- | Get the asset class of the governor state token.
+
+     @since 0.2.0
+-}
+proposalSTAssetClass :: AgoraScripts -> AssetClass
+proposalSTAssetClass as = AssetClass (proposalSTSymbol as, "")
+
+{- | Get the script hash of the proposal validator.
+
+     @since 0.2.0
+-}
+proposalValidatoHash :: AgoraScripts -> ValidatorHash
+proposalValidatoHash = validatorHash . getCompiledValidator . compiledProposalValidator
+
+{- | Get the script hash of the governor validator.
+
+     @since 0.2.0
+-}
+stakeSTSymbol :: AgoraScripts -> CurrencySymbol
+stakeSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledStakePolicy
+
+{- | Get the asset class of the stake state token.
+
+     Note that this token is tagged with the hash of the stake validator.
+      See 'Agora.Stake.Script.stakePolicy'.
+
+     @since 0.2.0
+-}
+stakeSTAssetClass :: AgoraScripts -> AssetClass
+stakeSTAssetClass as =
+  let tn = validatorHashToTokenName $ stakeValidatorHash as
+   in AssetClass (stakeSTSymbol as, tn)
+
+{- | Get the script hash of the stake validator.
+
+     @since 0.2.0
+-}
+stakeValidatorHash :: AgoraScripts -> ValidatorHash
+stakeValidatorHash = validatorHash . getCompiledValidator . compiledStakeValidator
+
+{- | Get the currency symbol of the authority token.
+
+     @since 0.2.0
+-}
+authorityTokenSymbol :: AgoraScripts -> CurrencySymbol
+authorityTokenSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledAuthorityTokenPolicy
+
+{- | Get the script hash of the treasury validator.
+
+     @since 0.2.0
+-}
+treasuryValidatorHash :: AgoraScripts -> ValidatorHash
+treasuryValidatorHash = validatorHash . getCompiledValidator . compiledTreasuryValidator

agora/Agora/Stake.hs

@@ -11,7 +11,6 @@ module Agora.Stake (
   -- * Haskell-land
   StakeDatum (..),
   StakeRedeemer (..),
-  Stake (..),
   ProposalLock (..),
 
   -- * Plutarch-land
@@ -54,26 +53,11 @@ import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
 import Plutarch.SafeMoney (PDiscrete)
 import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (PubKeyHash)
-import PlutusLedgerApi.V1.Value (AssetClass)
 import PlutusTx qualified
 import Prelude hiding (Num (..))
 
 --------------------------------------------------------------------------------
 
-{- | Parameters for creating Stake scripts.
-
-     @since 0.1.0
--}
-data Stake = Stake
-  { gtClassRef :: Tagged GTTag AssetClass
-  -- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code.
-  , proposalSTClass :: AssetClass
-  }
-  deriving stock
-    ( -- | @since 0.1.0
-      Generic
-    )
-
 {- | Locks that are stored in the stake datums for various purposes.
 
      NOTE: Due to retracting votes always being possible,

agora/Agora/Stake/Scripts.hs

@@ -8,20 +8,17 @@ Plutus Scripts for Stakes.
 module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
 
 import Agora.SafeMoney (GTTag)
+import Agora.Scripts (AgoraScripts, proposalSTAssetClass, stakeSTSymbol)
 import Agora.Stake (
   PStakeDatum (PStakeDatum),
   PStakeRedeemer (..),
-  Stake (gtClassRef, proposalSTClass),
   StakeRedeemer (WitnessStake),
   pstakeLocked,
  )
 import Agora.Utils (
   mustFindDatum',
-  pdjust,
-  pdnothing,
   pvalidatorHashToTokenName,
  )
-import Data.Default (def)
 import Data.Function (on)
 import Data.Tagged (Tagged (..), untag)
 import Plutarch.Api.V1 (
@@ -35,18 +32,15 @@ import Plutarch.Api.V1 (
   PTxOut,
   PValidator,
   PValue,
-  mintingPolicySymbol,
-  mkMintingPolicy,
  )
 import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
 import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
 import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.List (pmapMaybe, pmsortBy)
-import Plutarch.Extra.Maybe (passertPJust, pfromDJust)
+import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pfromDJust, pmaybeData)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
-import Plutarch.Internal (punsafeCoerce)
 import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
 import Plutarch.SafeMoney (
   pdiscreteValue',
@@ -223,8 +217,13 @@ stakePolicy gtClassRef =
 
      @since 0.1.0
 -}
-stakeValidator :: Stake -> ClosedTerm PValidator
+stakeValidator ::
-stakeValidator stake =
+  -- | Lazy precompiled scripts.
+  AgoraScripts ->
+  -- | See 'Agora.Governor.Governor.gtClassRef'.
+  Tagged GTTag AssetClass ->
+  ClosedTerm PValidator
+stakeValidator as gtClassRef =
   plam $ \datum redeemer ctx' -> unTermCont $ do
     ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
     txInfo <- pletC $ pfromData ctx.txInfo
@@ -240,9 +239,7 @@ stakeValidator stake =
 
     stakeRedeemer <- fst <$> ptryFromC redeemer
 
-    -- TODO: Use PTryFrom
+    stakeDatum' <- pfromData . fst <$> ptryFromC datum
-    let stakeDatum' :: Term _ PStakeDatum
-        stakeDatum' = pfromData $ punsafeCoerce datum
     stakeDatum <- pletAllC $ pto stakeDatum'
 
     PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
@@ -258,17 +255,14 @@ stakeValidator stake =
     signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
 
     ownerSignsTransaction <- pletC $ signedBy # stakeDatum.owner
-    delegateSignsTransaction <-
-      pletC $ pconstant False
-    -- pmaybeData # pconstant False
-    --   # plam (signedBy #)
-    --   # stakeDatum.delegatedTo
 
-    stCurrencySymbol <-
+    delegateSignsTransaction <-
       pletC $
-        pconstant $
+        pmaybeData # pconstant False
-          mintingPolicySymbol $
+          # signedBy
-            mkMintingPolicy def (stakePolicy stake.gtClassRef)
+          # stakeDatum.delegatedTo
+
+    stCurrencySymbol <- pletC $ pconstant $ stakeSTSymbol as
     mintedST <- pletC $ psymbolValueOf # stCurrencySymbol # txInfoF.mint
     valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
     spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
@@ -294,7 +288,7 @@ stakeValidator stake =
         -- Handle redeemers that require own stake output.
 
         _ -> unTermCont $ do
-          let AssetClass (propCs, propTn) = stake.proposalSTClass
+          let AssetClass (propCs, propTn) = proposalSTAssetClass as
               proposalSTClass = passetClass # pconstant propCs # pconstant propTn
               spentProposalST = passetClassValueOf # valueSpent # proposalSTClass
 
@@ -496,7 +490,7 @@ stakeValidator stake =
                               datumCorrect = stakeOut #== expectedDatum
 
                           let valueDelta :: Term _ (PValue _ 'Positive)
-                              valueDelta = pdiscreteValue' stake.gtClassRef # delta
+                              valueDelta = pdiscreteValue' gtClassRef # delta
 
                               expectedValue =
                                 resolvedF.value <> valueDelta
@@ -507,7 +501,7 @@ stakeValidator stake =
                                   [ pgeqByClass' (AssetClass ("", ""))
                                       # ownOutputValue
                                       # expectedValue
-                                  , pgeqByClass' (untag stake.gtClassRef)
+                                  , pgeqByClass' (untag gtClassRef)
                                       # ownOutputValue
                                       # expectedValue
                                   , pgeqBySymbol

agora/Agora/Utils.hs

@@ -9,57 +9,35 @@ Description: Plutarch utility functions that should be upstreamed or don't belon
 Plutarch utility functions that should be upstreamed or don't belong anywhere else.
 -}
 module Agora.Utils (
-  scriptHashFromAddress,
-  findOutputsToAddress,
-  findTxOutDatum,
   validatorHashToTokenName,
   pvalidatorHashToTokenName,
-  getMintingPolicySymbol,
-  hasOnlyOneTokenOfCurrencySymbol,
   mustFindDatum',
-  mustBePJust,
-  mustBePDJust,
   validatorHashToAddress,
-  isScriptAddress,
-  isPubKey,
   pltAsData,
-  pon,
   withBuiltinPairAsData,
-  pmaybeData,
+  CompiledValidator (..),
-  pmaybe,
+  CompiledMintingPolicy (..),
-  pdjust,
+  CompiledEffect (..),
-  pdnothing,
 ) where
 
-import Data.Default (Default (def))
 import Plutarch.Api.V1 (
-  AmountGuarantees,
-  KeyGuarantees,
-  PAddress,
-  PCredential (PScriptCredential),
-  PCurrencySymbol,
   PDatum,
   PDatumHash,
-  PMaybeData (PDJust, PDNothing),
+  PMaybeData,
-  PMintingPolicy,
   PTokenName (PTokenName),
   PTuple,
-  PTxOut,
   PValidatorHash,
-  PValue,
-  mintingPolicySymbol,
-  mkMintingPolicy,
  )
-import Plutarch.Api.V1.ScriptContext (pfindDatum)
-import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
 import Plutarch.Builtin (pforgetData)
 import Plutarch.Extra.List (plookupTuple)
-import Plutarch.Extra.TermCont (pletC, pmatchC, ptryFromC)
+import Plutarch.Extra.Maybe (passertPDJust, passertPJust)
+import Plutarch.Extra.TermCont (ptryFromC)
 import PlutusLedgerApi.V1 (
   Address (..),
   Credential (..),
-  CurrencySymbol,
+  MintingPolicy,
   TokenName (..),
+  Validator,
   ValidatorHash (..),
  )
 
@@ -67,60 +45,6 @@ import PlutusLedgerApi.V1 (
    All of these functions are quite inefficient.
 -}
 
-{- | Get script hash from an Address.
-
-     @since 0.1.0
--}
-scriptHashFromAddress :: Term s (PAddress :--> PMaybe PValidatorHash)
-scriptHashFromAddress = phoistAcyclic $
-  plam $ \addr ->
-    pmatch (pfromData $ pfield @"credential" # addr) $ \case
-      PScriptCredential ((pfield @"_0" #) -> h) -> pcon $ PJust h
-      _ -> pcon PNothing
-
-{- | Return true if the given address is a script address.
-
-     @since 0.1.0
--}
-isScriptAddress :: Term s (PAddress :--> PBool)
-isScriptAddress = phoistAcyclic $
-  plam $ \addr -> pnot #$ isPubKey #$ pfromData $ pfield @"credential" # addr
-
-{- | Return true if the given credential is a pub-key-hash.
-
-     @since 0.1.0
--}
-isPubKey :: Term s (PCredential :--> PBool)
-isPubKey = phoistAcyclic $
-  plam $ \cred ->
-    pmatch cred $ \case
-      PScriptCredential _ -> pconstant False
-      _ -> pconstant True
-
-{- | Find all TxOuts sent to an Address
-
-     @since 0.1.0
--}
-findOutputsToAddress :: Term s (PBuiltinList (PAsData PTxOut) :--> PAddress :--> PBuiltinList (PAsData PTxOut))
-findOutputsToAddress = phoistAcyclic $
-  plam $ \outputs address' -> unTermCont $ do
-    address <- pletC $ pdata address'
-    pure $
-      pfilter # plam (\(pfromData -> txOut) -> pfield @"address" # txOut #== address)
-        # outputs
-
-{- | Find the data corresponding to a TxOut, if there is one
-
-     @since 0.1.0
--}
-findTxOutDatum :: Term s (PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PTxOut :--> PMaybe PDatum)
-findTxOutDatum = phoistAcyclic $
-  plam $ \datums out -> unTermCont $ do
-    datumHash' <- pmatchC $ pfromData $ pfield @"datumHash" # out
-    pure $ case datumHash' of
-      PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # datums
-      _ -> pcon PNothing
-
 {- | Safely convert a 'PValidatorHash' into a 'PTokenName'. This can be useful for tagging
      tokens for extra safety.
 
@@ -136,25 +60,6 @@ validatorHashToTokenName (ValidatorHash hash) = TokenName hash
 pvalidatorHashToTokenName :: forall (s :: S). Term s PValidatorHash -> Term s PTokenName
 pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh))
 
-{- | Get the CurrencySymbol of a PMintingPolicy.
-
-     @since 0.1.0
--}
-getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol
-getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy def v
-
-{- | The entire value only contains one token of the given currency symbol.
-
-     @since 0.1.0
--}
-hasOnlyOneTokenOfCurrencySymbol ::
-  forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
-  Term s (PCurrencySymbol :--> PValue keys amounts :--> PBool)
-hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $
-  plam $ \cs vs -> P.do
-    psymbolValueOf # cs # vs #== 1
-      #&& (plength #$ pto $ pto $ pto vs) #== 1
-
 {- | Find datum given a maybe datum hash
 
      @since 0.1.0
@@ -171,33 +76,11 @@ mustFindDatum' ::
     )
 mustFindDatum' = phoistAcyclic $
   plam $ \mdh datums -> unTermCont $ do
-    let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh
+    let dh = passertPDJust # "Given TxOut dones't have a datum" # mdh
-        dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
+        dt = passertPJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
     (d, _) <- ptryFromC $ pforgetData $ pdata dt
     pure d
 
-{- | Extract the value stored in a PMaybe container.
-     If there's no value, throw an error with the given message.
-
-     @since 0.1.0
--}
-mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a)
-mustBePJust = phoistAcyclic $
-  plam $ \emsg mv' -> pmatch mv' $ \case
-    PJust v -> v
-    _ -> ptraceError emsg
-
-{- | Extract the value stored in a PMaybeData container.
-     If there's no value, throw an error with the given message.
-
-     @since 0.1.0
--}
-mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a)
-mustBePDJust = phoistAcyclic $
-  plam $ \emsg mv' -> pmatch mv' $ \case
-    PDJust ((pfield @"_0" #) -> v) -> v
-    _ -> ptraceError emsg
-
 {- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
 
      @since 0.1.0
@@ -217,19 +100,6 @@ pltAsData = phoistAcyclic $
   plam $
     \(pfromData -> l) (pfromData -> r) -> l #< r
 
-{- | Plutarch level 'Data.Function.on'.
-
-     @since 0.2.0
--}
-pon ::
-  forall (a :: PType) (b :: PType) (c :: PType) (s :: S).
-  Term s ((b :--> b :--> c) :--> (a :--> b) :--> a :--> a :--> c)
-pon = phoistAcyclic $
-  plam $ \f g x y ->
-    let a = g # x
-        b = g # y
-     in f # a # b
-
 {- | Extract data stored in a 'PBuiltinPair' and call a function to process it.
 
      @since 0.2.0
@@ -247,53 +117,26 @@ withBuiltinPairAsData f p =
       b = pfromData $ psndBuiltin # p
    in f a b
 
-{- | Plutarch version of 'Data.Maybe.maybe'. Take a default value and a function
+{- | Type-safe wrapper for compiled plutus validator.
-      @f@. If the given 'PMaybe' value is @'PJust' x@, apply the function @f@ to
-      @x@, otherewise the default value will be retuned.
 
      @since 0.2.0
 -}
-pmaybe ::
+newtype CompiledValidator (datum :: Type) (redeemer :: Type) = CompiledValidator
-  forall (a :: PType) (b :: PType) (s :: S).
+  { getCompiledValidator :: Validator
-  Term s (b :--> (a :--> b) :--> PMaybe a :--> b)
+  }
-pmaybe = phoistAcyclic $
-  plam $ \n f m -> pmatch m $ \case
-    PJust x -> f # x
-    _ -> n
 
-{- | Special version of 'pmaybe' that works with 'PMaybedata'.
+{- | Type-safe wrapper for compiled plutus miting policy.
 
      @since 0.2.0
 -}
-pmaybeData ::
+newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy
-  forall (a :: PType) (b :: PType) (s :: S).
+  { getCompiledMintingPolicy :: MintingPolicy
-  PIsData a =>
+  }
-  Term s (b :--> (a :--> b) :--> PMaybeData a :--> b)
-pmaybeData = phoistAcyclic $
-  plam $ \n f m -> pmatch m $ \case
-    PDJust ((pfield @"_0" #) -> x) -> f # x
-    _ -> n
 
-{- Construct a 'PDJust' value.
+{- | Type-safe wrapper for compiled plutus effect.
 
-    @since 0.2.0
+     @since 0.2.0
 -}
-pdjust ::
+newtype CompiledEffect (datum :: Type) = CompiledEffect
-  forall (a :: PType) (s :: S).
+  { getCompiledEffect :: Validator
-  (PIsData a) =>
+  }
-  Term s (a :--> PMaybeData a)
-pdjust = phoistAcyclic $
-  plam $ \x ->
-    pcon $
-      PDJust $
-        pdcons @"_0" # pdata x #$ pdnil
-
-{- Construct a 'PDNothing' value.
-
-    @since 0.2.0
--}
-pdnothing ::
-  forall (a :: PType) (s :: S).
-  (PIsData a) =>
-  Term s (PMaybeData a)
-pdnothing = phoistAcyclic $ pcon $ PDNothing pdnil