Merge pull request #150 from Liqwid-Labs/connor/liqwid-nix

Use `liqwid-nix`; Bump plutarch

Makefile

@@ -1,13 +1,32 @@
 # This really ought to be `/usr/bin/env bash`, but nix flakes don't like that.
 SHELL := /bin/sh
 
-.PHONY: hoogle format haddock usage tag format_nix format_haskell format_check lint ps_bridge bench bench_check scripts
+.PHONY: hoogle format haddock usage tag format_nix format_haskell format_check	\ 
+				lint refactor ps_bridge bench bench_check scripts test build ci
 
-AGORA_TARGETS := agora agora-bench agora-purescript-bridge agora-scripts agora-specs agora-test agora-testlib
+SOURCE_FILES := $(shell git ls-tree -r HEAD --full-tree --name-only)
+SOURCE_FILES := $(wildcard $(SOURCE_FILES))
+HASKELL_SOURCES := $(filter %.hs,$(SOURCE_FILES))
+CABAL_SOURCES := $(filter %.cabal,$(SOURCE_FILES))
+NIX_SOURCES := $(filter %.nix,$(SOURCE_FILES))
+FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications	\
+										-o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot
+HLINT_EXTS := -XQuasiQuotes
+
+THREADS ?= 8
+PS_BRIDGE_OUTPUT_DIR ?= agora-purescript-bridge/
+BENCH_OUTPUT ?= bench.csv
+TEST_CASE_TIMEOUT ?= 100
 
 usage:
-	@echo "usage: make <command> [OPTIONS]"
+	@echo "usage: [env [<variable>=<value> ...]] make <command> [OPTIONS]"
 	@echo
+	@echo "Available variables:"
+	@echo "  THREADS -- The number of threads for building the project"
+	@echo "  PS_BRIDGE_OUTPUT_DIR -- The output directory of the purescript bridge"
+	@echo "  BENCH_OUTPUT -- The output file of the benchmark report"
+	@echo "  TEST_CASE_TIMEOUT -- Timeout for individual tests. Default unit: s"
+	@echo 
 	@echo "Available commands:"
 	@echo "  hoogle -- Start local hoogle"
 	@echo "  format -- Format the project"
@@ -21,8 +40,13 @@ usage:
 	@echo "  bench -- Generate bench report bench.csv"
 	@echo "  bench_check -- Check if bench report is up-to-date"
 	@echo "  scripts -- Run the agora script server (dev mode)"
+	@echo "  ci -- Run all the CI checks"
 
-hoogle:
+requires_nix_shell:
+	@ [ "$(IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside a nix shell"
+	@ [ "$(IN_NIX_SHELL)" ] || (echo "    run 'nix develop' first" && false)
+
+hoogle: requires_nix_shell
 	pkill hoogle || true
 	hoogle generate --local=haddock --database=hoo/local.hoo
 	hoogle server --local -p 8081 >> /dev/null &
@@ -30,45 +54,48 @@ hoogle:
 
 format: format_haskell format_nix
 
-format_nix:
+format_nix: requires_nix_shell
-	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.nix' | xargs nixpkgs-fmt
+	nixpkgs-fmt $(NIX_SOURCES)
 
-FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot
+format_haskell: requires_nix_shell
-format_haskell:
+	fourmolu $(FORMAT_EXTENSIONS) -m inplace $(HASKELL_SOURCES)
-	find -name '*.hs' -not -path './dist-*/*' | xargs fourmolu $(FORMAT_EXTENSIONS) -m inplace
+	cabal-fmt -i $(CABAL_SOURCES)
-	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.cabal' | xargs cabal-fmt -i
 
-format_check:
+format_check: requires_nix_shell
-	find -name '*.hs' \
+	fourmolu $(FORMAT_EXTENSIONS) -m check $(HASKELL_SOURCES)
-	     -not -path './dist*/*' \
+	nixpkgs-fmt --check $(NIX_SOURCES) 
-	     -not -path './haddock/*' \
+	cabal-fmt --check $(CABAL_SOURCES)
-	  | xargs fourmolu $(FORMAT_EXTENSIONS) -m check
 
-haddock:
+haddock: requires_nix_shell
 	cabal haddock --haddock-html --haddock-hoogle --builddir=haddock
 
-tag:
+tag: requires_nix_shell
-	hasktags -x $(AGORA_TARGETS)
+	hasktags -x $(HASKELL_SOURCES)
 
-lint:
+lint: requires_nix_shell
-	hlint $(AGORA_TARGETS)
+	hlint $(HLINT_EXTS) $(HASKELL_SOURCES)
 
-PS_BRIDGE_OUTPUT_DIR := agora-purescript-bridge/
+refactor: requires_nix_shell
-ps_bridge:
+	for src in $(HASKELL_SOURCES) ; do \
+		hlint $(HLINT_EXTS) --refactor --refactor-options='-i -s' $$src ;\
+	done
+
+ps_bridge: requires_nix_shell
 	cabal run exe:agora-purescript-bridge -- -o $(PS_BRIDGE_OUTPUT_DIR)
 
-bench:
+bench: requires_nix_shell
-	cabal run agora-bench
+	cabal run agora-bench -- -o $(BENCH_OUTPUT)
 
-BENCH_TMPDIR := $(shell mktemp -d)
+bench_check: requires_nix_shell
-BENCH_TMPFILE := $(BENCH_TMPDIR)/bench.csv
+	cabal -v0 new-run agora-bench | diff bench.csv -
-bench_check:
-	(cabal run agora-bench -- -o "$(BENCH_TMPFILE)" \
-		|| $(bench) -o "$(BENCH_TMPFILE)") >> /dev/null
-	diff bench.csv $(BENCH_TMPFILE) \
-		|| (echo "bench.csv is outdated"; exit 1)
-	# TODO: do the clean-up even if `diff` fails.
-	rm -rf $(BENCH_TMPDIR)
 
-scripts:
+scripts: requires_nix_shell
 	cabal run agora-scripts -- -c
+
+test: requires_nix_shell
+	cabal test --test-options="--hide-successes -t $(TEST_CASE_TIMEOUT) -j$(THREADS)"
+
+build: requires_nix_shell
+	cabal build -j$(THREADS)
+
+ci: format_check lint build bench_check test haddock

agora-bench/Bench.hs

@@ -8,7 +8,6 @@ import Data.ByteString.Short qualified as SBS
 import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=))
 import Data.List (intercalate)
 import Data.Text (Text, pack)
-import GHC.Generics (Generic)
 import Plutarch.Evaluate (evalScript)
 import PlutusLedgerApi.V1 (
   ExBudget (ExBudget),

agora-bench/Main.hs

@@ -3,10 +3,10 @@ module Main (main) where
 import Bench (specificationTreeToBenchmarks)
 import Data.Csv (EncodeOptions (encUseCrLf), defaultEncodeOptions, encodeDefaultOrderedByNameWith)
 import Data.Text.Lazy.Encoding (decodeUtf8)
-import Data.Text.Lazy.IO as I (writeFile)
+import Data.Text.Lazy.IO as I (putStr, writeFile)
 import Options (Options (..), parseOptions)
 import Prettyprinter (defaultLayoutOptions, layoutPretty, pretty)
-import Prettyprinter.Render.String (renderString)
+import Prettyprinter.Render.Text (renderLazy)
 import Spec.AuthorityToken qualified as AuthorityToken
 import Spec.Effect.GovernorMutation qualified as GovernorMutation
 import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
@@ -14,6 +14,7 @@ import Spec.Governor qualified as Governor
 import Spec.Proposal qualified as Proposal
 import Spec.Stake qualified as Stake
 import Spec.Treasury qualified as Treasury
+import System.IO (hIsTerminalDevice, stdout)
 import Test.Specification (group)
 import Prelude
 
@@ -22,11 +23,14 @@ import Prelude
 main :: IO ()
 main = do
   options <- parseOptions
+  isTTY <- hIsTerminalDevice stdout
 
-  I.writeFile options.output $
+  mapM_ (`I.writeFile` csv) options.output
-    (decodeUtf8 . encodeDefaultOrderedByNameWith encodeOptions) res
 
-  mapM_ (putStrLn . renderString . layoutPretty defaultLayoutOptions . pretty) res
+  I.putStr $
+    if isTTY
+      then prettified
+      else csv
   where
     encodeOptions =
       defaultEncodeOptions
@@ -49,3 +53,7 @@ main = do
           , group "AuthorityToken" AuthorityToken.specs
           , group "Governor" Governor.specs
           ]
+
+    csv = decodeUtf8 $ encodeDefaultOrderedByNameWith encodeOptions res
+
+    prettified = renderLazy $ layoutPretty defaultLayoutOptions $ pretty res

agora-bench/Options.hs

@@ -1,21 +1,22 @@
 module Options (Options (..), parseOptions) where
 
+import Control.Applicative (optional)
 import Options.Applicative ((<**>))
 import Options.Applicative qualified as Opt
 
 newtype Options = Options
-  { output :: FilePath
+  { output :: Maybe FilePath
   }
 
-outputOpt :: Opt.Parser FilePath
+outputOpt :: Opt.Parser (Maybe FilePath)
 outputOpt =
-  Opt.strOption
+  optional $
-    ( Opt.long "output-path"
+    Opt.strOption
-        <> Opt.short 'o'
+      ( Opt.long "output-path"
-        <> Opt.metavar "OUTPUT_PATH"
+          <> Opt.short 'o'
-        <> Opt.value "./bench.csv"
+          <> Opt.metavar "OUTPUT_PATH"
-        <> Opt.help "The path of the bench report file."
+          <> Opt.help "The path of the bench report file."
-    )
+      )
 
 benchOpt :: Opt.Parser Options
 benchOpt = Options <$> outputOpt

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,39 +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 $ governorPolicy governor) ""
-
-    proposal :: Proposal
-    proposal = proposalFromGovernor governor
-
-    stake :: Stake
-    stake = stakeFromGovernor governor
 
 {- | Params required for creating script export.
 
@@ -157,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-specs/Property/Generator.hs

@@ -114,8 +114,10 @@ genInput = do
   val <- genSingletonValue
   return $
     input $
-      credential cred
+      mconcat
-        . withValue val
+        [ credential cred
+        , withValue val
+        ]
 
 genOutput :: Builder a => Gen a
 genOutput = do
@@ -123,8 +125,10 @@ genOutput = do
   val <- genSingletonValue
   return $
     output $
-      credential cred
+      mconcat
-        . withValue val
+        [ credential cred
+        , withValue val
+        ]
 
 genOutRef :: Gen TxOutRef
 genOutRef = do

agora-specs/Property/Governor.hs

@@ -7,7 +7,7 @@ Property model and tests for 'Governor' related functions
 -}
 module Property.Governor (props) where
 
-import Agora.Governor (GovernorDatum (..), pisGovernorDatumValid)
+import Agora.Governor (Governor (gstOutRef), GovernorDatum (..), pisGovernorDatumValid)
 import Agora.Governor.Scripts (governorPolicy)
 import Agora.Proposal (
   ProposalId (ProposalId),
@@ -157,7 +157,13 @@ governorMintingProperty =
     -}
     gst = assetClassValue govAssetClass 1
     mintAmount x = mint . mconcat $ replicate x gst
-    outputToGov = output $ script govValidatorHash . withValue gst . withDatum govDatum
+    outputToGov =
+      output $
+        mconcat
+          [ script govValidatorHash
+          , withValue gst
+          , withDatum govDatum
+          ]
     referencedInput = input $ withOutRef gstUTXORef
 
     govDatum :: GovernorDatum
@@ -195,7 +201,7 @@ governorMintingProperty =
     opaqueToUnit = plam $ \_ -> pconstant ()
 
     actual :: Term s (PScriptContext :--> PUnit)
-    actual = plam $ \sc -> opaqueToUnit #$ governorPolicy governor # pforgetData (pconstantData ()) # sc
+    actual = plam $ \sc -> opaqueToUnit #$ governorPolicy governor.gstOutRef # pforgetData (pconstantData ()) # sc
 
     classifier :: ScriptContext -> GovernorPolicyCases
     classifier sc

agora-specs/Sample/Effect/GovernorMutation.hs

@@ -17,6 +17,7 @@ import Agora.Effect.GovernorMutation (
  )
 import Agora.Governor (GovernorDatum (..))
 import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
+import Agora.Utils (validatorHashToTokenName)
 import Data.Default.Class (Default (def))
 import Data.Tagged (Tagged (..))
 import Plutarch.Api.V1 (mkValidator, validatorHash)
@@ -24,7 +25,6 @@ import PlutusLedgerApi.V1 (
   Address,
   Datum (..),
   ToData (..),
-  TokenName (..),
   TxInInfo (..),
   TxInfo (..),
   TxOut (..),
@@ -40,10 +40,11 @@ import PlutusLedgerApi.V1.Value qualified as Value (
   singleton,
  )
 import Sample.Shared (
+  agoraScripts,
   authorityTokenSymbol,
+  deterministicTracingConfing,
   govAssetClass,
   govValidatorAddress,
-  governor,
   minAda,
   signer,
  )
@@ -51,7 +52,7 @@ import Test.Util (datumPair, toDatumHash)
 
 -- | The effect validator instance.
 effectValidator :: Validator
-effectValidator = mkValidator $ mutateGovernorValidator governor
+effectValidator = mkValidator deterministicTracingConfing $ mutateGovernorValidator agoraScripts
 
 -- | The hash of the validator instance.
 effectValidatorHash :: ValidatorHash
@@ -65,17 +66,15 @@ effectValidatorAddress = scriptHashAddress effectValidatorHash
 atAssetClass :: AssetClass
 atAssetClass = assetClass authorityTokenSymbol tokenName
   where
-    -- TODO: use 'validatorHashToTokenName'
+    tokenName = validatorHashToTokenName effectValidatorHash
-    ValidatorHash bs = effectValidatorHash
-    tokenName = TokenName bs
 
 -- | The mock reference of the governor state UTXO.
 govRef :: TxOutRef
-govRef = TxOutRef "614481d2159bfb72350222d61fce17e548e0fc00e5a1f841ff1837c431346ce7" 1
+govRef = TxOutRef "1475e1ee22330dfc55430980e5a6b100ec9d9249bb4b462256a79559" 1
 
 -- | The mock reference of the effect UTXO.
 effectRef :: TxOutRef
-effectRef = TxOutRef "c31164dc11835de7eb6187f67d0e1a19c1dfc0786a456923eef5043189cdb578" 1
+effectRef = TxOutRef "a302d327d8e5553d50b9d017475369753f723d7e999ac1b68da8ad52" 1
 
 -- | The input effect datum in 'mkEffectTransaction'.
 mkEffectDatum :: GovernorDatum -> MutateGovernorDatum
@@ -159,7 +158,7 @@ mkEffectTxInfo newGovDatum =
         , txInfoValidRange = Interval.always
         , txInfoSignatories = [signer]
         , txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum]
-        , txInfoId = "4dae3806cc69615b721d52ed09b758f43f25a8f39b7934d6b28514caf71f5f7b"
+        , txInfoId = "74c75505691e7baa981fa80e50b9b7e88dbe1eda67d4f062d89d203b"
         }
 
 validNewGovernorDatum :: GovernorDatum

agora-specs/Sample/Effect/TreasuryWithdrawal.hs

@@ -23,11 +23,12 @@ import Agora.Effect.TreasuryWithdrawal (
   TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
   treasuryWithdrawalValidator,
  )
+import Data.Default (def)
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import PlutusLedgerApi.V1 (
   Address (Address),
   Credential (..),
-  CurrencySymbol (CurrencySymbol),
+  CurrencySymbol,
   DatumHash (DatumHash),
   PubKeyHash,
   ScriptContext (..),
@@ -59,7 +60,7 @@ import Test.Util (scriptCredentials, userCredentials)
 
 -- | A sample Currency Symbol.
 currSymbol :: CurrencySymbol
-currSymbol = CurrencySymbol "12312099"
+currSymbol = "9c04a69c7133e26061fe5a15adaf4f79cd51e47ef22a2e3c91a36f04"
 
 -- | A sample 'PubKeyHash'.
 signer :: PubKeyHash
@@ -147,7 +148,7 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
 
 -- | Effect validator instance.
 validator :: Validator
-validator = mkValidator $ treasuryWithdrawalValidator currSymbol
+validator = mkValidator def $ treasuryWithdrawalValidator currSymbol
 
 -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
 validatorHashTN :: TokenName

agora-specs/Sample/Governor/Initialize.hs

@@ -19,16 +19,20 @@ module Sample.Governor.Initialize (
   mkTestCase,
 ) where
 
+import Agora.Bootstrap (agoraScripts)
 import Agora.Governor (Governor (..), GovernorDatum (..))
-import Agora.Governor.Scripts (
+import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
-  governorPolicy,
+import Agora.Proposal.Time (
-  governorSTAssetClassFromGovernor,
+  MaxTimeRangeWidth (MaxTimeRangeWidth),
+  ProposalTimingConfig (ProposalTimingConfig),
+ )
+import Agora.Scripts (
+  AgoraScripts (compiledGovernorPolicy),
+  governorSTAssetClass,
+  governorSTSymbol,
   governorValidatorHash,
  )
-import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
-import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalTimingConfig (ProposalTimingConfig))
 import Data.Default (Default (..))
-import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
 import Plutarch.Context (
   input,
   mint,
@@ -43,7 +47,6 @@ import Plutarch.Context (
  )
 import PlutusLedgerApi.V1 (
   CurrencySymbol,
-  MintingPolicy,
   TxOutRef (TxOutRef),
   ValidatorHash,
  )
@@ -107,17 +110,17 @@ governor =
     { gstOutRef = witnessRef
     }
 
+scripts :: AgoraScripts
+scripts = agoraScripts Shared.deterministicTracingConfing governor
+
 govAssetClass :: AssetClass
-govAssetClass = governorSTAssetClassFromGovernor governor
+govAssetClass = governorSTAssetClass scripts
 
 govValidatorHash :: ValidatorHash
-govValidatorHash = governorValidatorHash governor
+govValidatorHash = governorValidatorHash scripts
-
-govPolicy :: MintingPolicy
-govPolicy = mkMintingPolicy (governorPolicy governor)
 
 govSymbol :: CurrencySymbol
-govSymbol = mintingPolicySymbol govPolicy
+govSymbol = governorSTSymbol scripts
 
 --------------------------------------------------------------------------------
 
@@ -169,12 +172,16 @@ mintGST ps = builder
         then
           mconcat
             [ input $
-                pubKey witnessPubKey
+                mconcat
-                  . withValue witnessValue
+                  [ pubKey witnessPubKey
-                  . withOutRef witnessRef
+                  , withValue witnessValue
+                  , withOutRef witnessRef
+                  ]
             , output $
-                pubKey witnessPubKey
+                mconcat
-                  . withValue witnessValue
+                  [ pubKey witnessPubKey
+                  , withValue witnessValue
+                  ]
             ]
         else mempty
 
@@ -184,11 +191,13 @@ mintGST ps = builder
       let datum =
             if ps.withGovernorDatum
               then withDatum governorOutputDatum
-              else id
+              else mempty
        in output $
-            script govValidatorHash
+            mconcat
-              . withValue governorValue
+              [ script govValidatorHash
-              . datum
+              , withValue governorValue
+              , datum
+              ]
     --
     builder =
       mconcat
@@ -265,6 +274,6 @@ mkTestCase name ps valid =
   testPolicy
     valid
     name
-    (governorPolicy governor)
+    scripts.compiledGovernorPolicy
     ()
     (mkMinting mintGST ps govSymbol)

agora-specs/Sample/Governor/Mutate.hs

@@ -18,8 +18,8 @@ module Sample.Governor.Mutate (
 
 import Agora.Effect.NoOp (noOpValidator)
 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
-import Agora.Governor.Scripts (governorValidator)
 import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..))
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Utils (validatorHashToTokenName)
 import Data.Default (def)
 import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash)
@@ -42,14 +42,14 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import Sample.Shared (
+  agoraScripts,
   authorityTokenSymbol,
   govAssetClass,
   govValidatorHash,
-  governor,
   minAda,
  )
 import Test.Specification (SpecificationTree, testValidator)
-import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes, withOptional)
+import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes)
 
 --------------------------------------------------------------------------------
 
@@ -142,18 +142,22 @@ mkGovernorBuilder ps =
           then pubKey $ head pubKeyHashes
           else script govValidatorHash
       withGSTDatum =
-        withOptional withDatum $
+        maybe mempty withDatum $
           mkGovernorOutputDatum ps.governorOutputDatumValidity
    in mconcat
         [ input $
-            script govValidatorHash
+            mconcat
-              . withDatum governorInputDatum
+              [ script govValidatorHash
-              . withValue value
+              , withDatum governorInputDatum
-              . withOutRef governorRef
+              , withValue value
+              , withOutRef governorRef
+              ]
         , output $
-            gstOutput
+            mconcat
-              . withGSTDatum
+              [ gstOutput
-              . withValue value
+              , withGSTDatum
+              , withValue value
+              ]
         ]
 
 --------------------------------------------------------------------------------
@@ -162,7 +166,7 @@ mockEffectValidator :: ClosedTerm PValidator
 mockEffectValidator = noOpValidator authorityTokenSymbol
 
 mockEffectValidatorHash :: ValidatorHash
-mockEffectValidatorHash = validatorHash $ mkValidator mockEffectValidator
+mockEffectValidatorHash = validatorHash $ mkValidator def mockEffectValidator
 
 mkGATValue :: GATValidity -> Integer -> Value
 mkGATValue NoGAT _ = mempty
@@ -187,11 +191,15 @@ mkMockEffectBuilder ps =
    in mconcat
         [ mint burnt
         , input $
-            script mockEffectValidatorHash
+            mconcat
-              . withValue inputValue
+              [ script mockEffectValidatorHash
+              , withValue inputValue
+              ]
         , output $
-            script mockEffectValidatorHash
+            mconcat
-              . withValue outputValue
+              [ script mockEffectValidatorHash
+              , withValue outputValue
+              ]
         ]
 
 --------------------------------------------------------------------------------
@@ -211,7 +219,7 @@ mkTestCase name pb (Validity forGov) =
   testValidator
     forGov
     name
-    (governorValidator governor)
+    agoraScripts.compiledGovernorValidator
     governorInputDatum
     governorRedeemer
     (mkSpending mutate pb governorRef)

agora-specs/Sample/Proposal/Advance.hs

@@ -37,15 +37,11 @@ module Sample.Proposal.Advance (
   mkBadGovernorOutputDatumBundle,
 ) where
 
-import Agora.AuthorityToken (
-  AuthorityToken (AuthorityToken),
-  authorityTokenPolicy,
- )
 import Agora.Governor (
+  Governor (..),
   GovernorDatum (..),
   GovernorRedeemer (MintGATs),
  )
-import Agora.Governor.Scripts (governorValidator)
 import Agora.Proposal (
   ProposalDatum (..),
   ProposalId (ProposalId),
@@ -56,7 +52,6 @@ import Agora.Proposal (
   ResultTag (ResultTag),
   emptyVotesFor,
  )
-import Agora.Proposal.Scripts (proposalValidator)
 import Agora.Proposal.Time (
   ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (
@@ -66,12 +61,11 @@ import Agora.Proposal.Time (
     votingTime
   ),
  )
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  Stake (gtClassRef),
   StakeDatum (..),
   StakeRedeemer (WitnessStake),
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Agora.Utils (validatorHashToTokenName)
 import Control.Monad.State (execState, modify, when)
 import Data.Default (def)
@@ -107,18 +101,18 @@ import Sample.Proposal.Shared (
   stakeTxRef,
  )
 import Sample.Shared (
+  agoraScripts,
   authorityTokenSymbol,
   govAssetClass,
   govValidatorHash,
+  governor,
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
   signer,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Sample.Shared qualified as Shared
 import Test.Specification (
   SpecificationTree,
   group,
@@ -321,14 +315,18 @@ mkProposalBuilder ps =
       value = sortValue $ minAda <> pst
    in mconcat
         [ input $
-            script proposalValidatorHash
+            mconcat
-              . withOutRef proposalRef
+              [ script proposalValidatorHash
-              . withDatum (mkProposalInputDatum ps)
+              , withOutRef proposalRef
-              . withValue value
+              , withDatum (mkProposalInputDatum ps)
+              , withValue value
+              ]
         , output $
-            script proposalValidatorHash
+            mconcat
-              . withDatum (mkProposalOutputDatum ps)
+              [ script proposalValidatorHash
-              . withValue value
+              , withDatum (mkProposalOutputDatum ps)
+              , withValue value
+              ]
         ]
 
 {- | The proposal redeemer used to spend the proposal UTXO, which is always
@@ -390,7 +388,7 @@ mkStakeBuilder ps =
           minAda
             <> Value.assetClassValue stakeAssetClass 1
             <> Value.assetClassValue
-              (untag stake.gtClassRef)
+              (untag governor.gtClassRef)
               ps.perStakeGTs
       perStake idx i o =
         let withSig =
@@ -400,14 +398,18 @@ mkStakeBuilder ps =
          in mconcat
               [ withSig
               , input $
-                  script stakeValidatorHash
+                  mconcat
-                    . withOutRef (mkStakeRef idx)
+                    [ script stakeValidatorHash
-                    . withValue perStakeValue
+                    , withOutRef (mkStakeRef idx)
-                    . withDatum i
+                    , withValue perStakeValue
+                    , withDatum i
+                    ]
               , output $
-                  script stakeValidatorHash
+                  mconcat
-                    . withValue perStakeValue
+                    [ script stakeValidatorHash
-                    . withDatum o
+                    , withValue perStakeValue
+                    , withDatum o
+                    ]
               ]
    in mconcat $
         zipWith3
@@ -457,15 +459,19 @@ mkGovernorBuilder ps =
       value = sortValue $ gst <> minAda
    in mconcat
         [ input $
-            script govValidatorHash
+            mconcat
-              . withValue value
+              [ script govValidatorHash
-              . withOutRef governorRef
+              , withValue value
-              . withDatum governorInputDatum
+              , withOutRef governorRef
+              , withDatum governorInputDatum
+              ]
         , output $
-            script govValidatorHash
+            mconcat
-              . withValue value
+              [ script govValidatorHash
-              . withOutRef governorRef
+              , withValue value
-              . withDatum (mkGovernorOutputDatum ps)
+              , withOutRef governorRef
+              , withDatum (mkGovernorOutputDatum ps)
+              ]
         ]
 
 {- | The proposal redeemer used to spend the governor UTXO, which is always
@@ -501,9 +507,11 @@ mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) =
        in mconcat
             [ mint minted
             , output $
-                script vh
+                mconcat
-                  . maybe id withDatum mdt
+                  [ script vh
-                  . withValue value
+                  , maybe mempty withDatum mdt
+                  , withValue value
+                  ]
             ]
 
 -- | The redeemer used while running the authority token policy.
@@ -551,7 +559,7 @@ mkTestTree name pb val =
             testValidator
               val.forProposalValidator
               "proposal"
-              (proposalValidator Shared.proposal)
+              agoraScripts.compiledProposalValidator
               proposalInputDatum
               proposalRedeemer
               (spend proposalRef)
@@ -562,7 +570,7 @@ mkTestTree name pb val =
             testValidator
               val.forStakeValidator
               "stake"
-              (stakeValidator Shared.stake)
+              agoraScripts.compiledStakeValidator
               (getStakeInputDatumAt pb.stakeParameters idx)
               stakeRedeemer
               ( spend (mkStakeRef idx)
@@ -572,7 +580,7 @@ mkTestTree name pb val =
       testValidator
         (fromJust val.forGovernorValidator)
         "governor"
-        (governorValidator Shared.governor)
+        agoraScripts.compiledGovernorValidator
         governorInputDatum
         governorRedeemer
         (spend governorRef)
@@ -582,7 +590,7 @@ mkTestTree name pb val =
       testPolicy
         (fromJust val.forAuthorityTokenPolicy)
         "authority"
-        (authorityTokenPolicy $ AuthorityToken Shared.govAssetClass)
+        agoraScripts.compiledAuthorityTokenPolicy
         authorityTokenRedeemer
         (mint authorityTokenSymbol)
         <$ (pb.authorityTokenParameters)

agora-specs/Sample/Proposal/Cosign.hs

@@ -14,6 +14,7 @@ module Sample.Proposal.Cosign (
   mkTestTree,
 ) where
 
+import Agora.Governor (Governor (..))
 import Agora.Proposal (
   ProposalDatum (..),
   ProposalId (ProposalId),
@@ -22,19 +23,17 @@ import Agora.Proposal (
   ResultTag (ResultTag),
   emptyVotesFor,
  )
-import Agora.Proposal.Scripts (proposalValidator)
 import Agora.Proposal.Time (
   ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (draftTime),
  )
 import Agora.SafeMoney (GTTag)
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  Stake (gtClassRef),
   StakeDatum (StakeDatum, owner),
   StakeRedeemer (WitnessStake),
   stakedAmount,
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Data.Coerce (coerce)
 import Data.Default (def)
 import Data.List (sort)
@@ -61,15 +60,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
+  agoraScripts,
+  governor,
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
   signer,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Sample.Shared qualified as Shared
 import Test.Specification (
   SpecificationTree,
   group,
@@ -149,7 +148,7 @@ cosign ps = builder
       sortValue $
         minAda
           <> Value.assetClassValue
-            (untag stake.gtClassRef)
+            (untag governor.gtClassRef)
             (untag perStakedGTs)
           <> sst
 
@@ -162,15 +161,19 @@ cosign ps = builder
                     else stakeDatum
              in mconcat
                   [ input $
-                      script stakeValidatorHash
+                      mconcat
-                        . withValue stakeValue
+                        [ script stakeValidatorHash
-                        . withDatum stakeDatum
+                        , withValue stakeValue
-                        . withTxId stakeTxRef
+                        , withDatum stakeDatum
-                        . withOutRef (mkStakeRef refIdx)
+                        , withTxId stakeTxRef
+                        , withOutRef (mkStakeRef refIdx)
+                        ]
                   , output $
-                      script stakeValidatorHash
+                      mconcat
-                        . withValue stakeValue
+                        [ script stakeValidatorHash
-                        . withDatum stakeOutputDatum
+                        , withValue stakeValue
+                        , withDatum stakeOutputDatum
+                        ]
                   , signedWith stakeDatum.owner
                   ]
         )
@@ -189,15 +192,19 @@ cosign ps = builder
     proposalBuilder =
       mconcat
         [ input $
-            script proposalValidatorHash
+            mconcat
-              . withValue pst
+              [ script proposalValidatorHash
-              . withDatum proposalInputDatum
+              , withValue pst
-              . withTxId proposalTxRef
+              , withDatum proposalInputDatum
-              . withOutRef proposalRef
+              , withTxId proposalTxRef
+              , withOutRef proposalRef
+              ]
         , output $
-            script proposalValidatorHash
+            mconcat
-              . withValue (sortValue (pst <> minAda))
+              [ script proposalValidatorHash
-              . withDatum proposalOutputDatum
+              , withValue (sortValue (pst <> minAda))
+              , withDatum proposalOutputDatum
+              ]
         ]
 
     validTimeRange :: POSIXTimeRange
@@ -314,7 +321,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
        in testValidator
             isValid
             "proposal"
-            (proposalValidator Shared.proposal)
+            agoraScripts.compiledProposalValidator
             proposalInputDatum
             (mkProposalRedeemer ps)
             (spend proposalRef)
@@ -326,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
        in testValidator
             isValid
             "stake"
-            (stakeValidator Shared.stake)
+            agoraScripts.compiledStakeValidator
             stakeInputDatum
             stakeRedeemer
             (spend $ mkStakeRef idx)

agora-specs/Sample/Proposal/Create.hs

@@ -20,27 +20,24 @@ module Sample.Proposal.Create (
 ) where
 
 import Agora.Governor (
+  Governor (..),
   GovernorDatum (..),
   GovernorRedeemer (CreateProposal),
  )
-import Agora.Governor.Scripts (governorValidator)
 import Agora.Proposal (
-  Proposal (governorSTAssetClass),
   ProposalDatum (..),
   ProposalId (ProposalId),
   ProposalStatus (..),
   ResultTag (ResultTag),
   emptyVotesFor,
  )
-import Agora.Proposal.Scripts (proposalPolicy)
 import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..))
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
   ProposalLock (..),
-  Stake (gtClassRef),
   StakeDatum (..),
   StakeRedeemer (PermitVote),
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Data.Coerce (coerce)
 import Data.Default (Default (def))
 import Data.Tagged (Tagged, untag)
@@ -69,19 +66,19 @@ import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal.Shared (stakeTxRef)
 import Sample.Shared (
+  agoraScripts,
+  govAssetClass,
   govValidatorHash,
+  governor,
   minAda,
-  proposal,
   proposalPolicySymbol,
   proposalStartingTimeFromTimeRange,
   proposalValidatorHash,
   signer,
   signer2,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Sample.Shared qualified as Shared
 import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
 import Test.Util (CombinableBuilder, closedBoundedInterval, mkMinting, mkSpending, sortValue)
 
@@ -270,7 +267,7 @@ createProposal ps = builder
   where
     pst = Value.singleton proposalPolicySymbol "" 1
     sst = Value.assetClassValue stakeAssetClass 1
-    gst = Value.assetClassValue proposal.governorSTAssetClass 1
+    gst = Value.assetClassValue govAssetClass 1
 
     ---
 
@@ -279,7 +276,7 @@ createProposal ps = builder
       sortValue $
         sortValue $
           sst
-            <> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs)
+            <> Value.assetClassValue (untag governor.gtClassRef) (untag stakedGTs)
             <> minAda
     proposalValue = sortValue $ pst <> minAda
 
@@ -302,29 +299,39 @@ createProposal ps = builder
         , ---
           timeRange $ mkTimeRange ps
         , input $
-            script govValidatorHash
+            mconcat
-              . withValue governorValue
+              [ script govValidatorHash
-              . withDatum governorInputDatum
+              , withValue governorValue
-              . withOutRef governorRef
+              , withDatum governorInputDatum
+              , withOutRef governorRef
+              ]
         , output $
-            script govValidatorHash
+            mconcat
-              . withValue governorValue
+              [ script govValidatorHash
-              . withDatum (mkGovernorOutputDatum ps)
+              , withValue governorValue
+              , withDatum (mkGovernorOutputDatum ps)
+              ]
         , ---
           input $
-            script stakeValidatorHash
+            mconcat
-              . withValue stakeValue
+              [ script stakeValidatorHash
-              . withDatum (mkStakeInputDatum ps)
+              , withValue stakeValue
-              . withOutRef stakeRef
+              , withDatum (mkStakeInputDatum ps)
+              , withOutRef stakeRef
+              ]
         , output $
-            script stakeValidatorHash
+            mconcat
-              . withValue stakeValue
+              [ script stakeValidatorHash
-              . withDatum (mkStakeOutputDatum ps)
+              , withValue stakeValue
+              , withDatum (mkStakeOutputDatum ps)
+              ]
         , ---
           output $
-            script proposalValidatorHash
+            mconcat
-              . withValue proposalValue
+              [ script proposalValidatorHash
-              . withDatum (mkProposalOutputDatum ps)
+              , withValue proposalValue
+              , withDatum (mkProposalOutputDatum ps)
+              ]
         ]
 
 --------------------------------------------------------------------------------
@@ -428,7 +435,7 @@ mkTestTree
         testPolicy
           validForProposalPolicy
           "proposal"
-          (proposalPolicy Shared.proposal.governorSTAssetClass)
+          agoraScripts.compiledProposalPolicy
           proposalPolicyRedeemer
           (mint proposalPolicySymbol)
 
@@ -436,15 +443,16 @@ mkTestTree
         testValidator
           validForGovernorValidator
           "governor"
-          (governorValidator Shared.governor)
+          agoraScripts.compiledGovernorValidator
           governorInputDatum
           governorRedeemer
           (spend governorRef)
+
       stakeTest =
         testValidator
           validForStakeValidator
           "stake"
-          (stakeValidator Shared.stake)
+          agoraScripts.compiledStakeValidator
           (mkStakeInputDatum ps)
           stakeRedeemer
           (spend stakeRef)

agora-specs/Sample/Proposal/UnlockStake.hs

@@ -25,6 +25,7 @@ module Sample.Proposal.UnlockStake (
 
 --------------------------------------------------------------------------------
 
+import Agora.Governor (Governor (..))
 import Agora.Proposal (
   ProposalDatum (..),
   ProposalId (..),
@@ -33,10 +34,9 @@ import Agora.Proposal (
   ProposalVotes (..),
   ResultTag (..),
  )
-import Agora.Proposal.Scripts (proposalValidator)
 import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
-import Agora.Stake (ProposalLock (..), Stake (..), StakeDatum (..), StakeRedeemer (RetractVotes))
+import Agora.Scripts (AgoraScripts (..))
-import Agora.Stake.Scripts (stakeValidator)
+import Agora.Stake (ProposalLock (..), StakeDatum (..), StakeRedeemer (RetractVotes))
 import Data.Default.Class (Default (def))
 import Data.Tagged (Tagged (..), untag)
 import Plutarch.Context (
@@ -59,15 +59,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal.Shared (stakeTxRef)
 import Sample.Shared (
+  agoraScripts,
+  governor,
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
   signer,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Sample.Shared qualified as Shared
 import Test.Specification (SpecificationTree, group, testValidator)
 import Test.Util (CombinableBuilder, mkSpending, sortValue, updateMap)
 
@@ -257,14 +257,18 @@ unlockStake ps =
           ( \((i, o), idx) ->
               mconcat
                 [ input $
-                    script proposalValidatorHash
+                    mconcat
-                      . withValue pst
+                      [ script proposalValidatorHash
-                      . withDatum i
+                      , withValue pst
-                      . withOutRef (mkProposalRef idx)
+                      , withDatum i
+                      , withOutRef (mkProposalRef idx)
+                      ]
                 , output $
-                    script proposalValidatorHash
+                    mconcat
-                      . withValue (sortValue $ pst <> minAda)
+                      [ script proposalValidatorHash
-                      . withDatum o
+                      , withValue (sortValue $ pst <> minAda)
+                      , withDatum o
+                      ]
                 ]
           )
           (zip pIODatums [0 ..])
@@ -273,7 +277,7 @@ unlockStake ps =
         sortValue $
           mconcat
             [ Value.assetClassValue
-                (untag stake.gtClassRef)
+                (untag governor.gtClassRef)
                 (untag defStakedGTs)
             , sst
             , minAda
@@ -285,14 +289,18 @@ unlockStake ps =
       stakes =
         mconcat
           [ input $
-              script stakeValidatorHash
+              mconcat
-                . withValue stakeValue
+                [ script stakeValidatorHash
-                . withDatum sInDatum
+                , withValue stakeValue
-                . withOutRef stakeRef
+                , withDatum sInDatum
+                , withOutRef stakeRef
+                ]
           , output $
-              script stakeValidatorHash
+              mconcat
-                . withValue stakeValue
+                [ script stakeValidatorHash
-                . withDatum sOutDatum
+                , withValue stakeValue
+                , withDatum sOutDatum
+                ]
           ]
 
       builder =
@@ -524,7 +532,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
       testValidator
         (not ps.alterOutputStake)
         "stake"
-        (stakeValidator Shared.stake)
+        agoraScripts.compiledStakeValidator
         (mkStakeInputDatum ps)
         stakeRedeemer
         (spend stakeRef)
@@ -536,7 +544,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
        in testValidator
             isValid
             "proposal"
-            (proposalValidator Shared.proposal)
+            agoraScripts.compiledProposalValidator
             (mkProposalInputDatum ps pid)
             proposalRedeemer
             (spend ref)

agora-specs/Sample/Proposal/Vote.hs

@@ -11,6 +11,7 @@ module Sample.Proposal.Vote (
   validVoteAsDelegateParameters,
 ) where
 
+import Agora.Governor (Governor (..))
 import Agora.Proposal (
   ProposalDatum (..),
   ProposalId (ProposalId),
@@ -19,18 +20,16 @@ import Agora.Proposal (
   ProposalVotes (ProposalVotes),
   ResultTag (ResultTag),
  )
-import Agora.Proposal.Scripts (proposalValidator)
 import Agora.Proposal.Time (
   ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (draftTime, votingTime),
  )
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
   ProposalLock (..),
-  Stake (gtClassRef),
   StakeDatum (..),
   StakeRedeemer (PermitVote),
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Data.Default (Default (def))
 import Data.Tagged (Tagged (Tagged), untag)
 import Plutarch.Context (
@@ -52,15 +51,15 @@ import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
 import Sample.Shared (
+  agoraScripts,
+  governor,
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
   signer,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Sample.Shared qualified as Shared
 import Test.Specification (
   SpecificationTree,
   group,
@@ -205,7 +204,7 @@ vote params =
       stakeValue =
         sortValue $
           sst
-            <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
+            <> Value.assetClassValue (untag governor.gtClassRef) params.voteCount
             <> minAda
 
       signer =
@@ -219,23 +218,31 @@ vote params =
           , signedWith signer
           , timeRange validTimeRange
           , input $
-              script proposalValidatorHash
+              mconcat
-                . withValue pst
+                [ script proposalValidatorHash
-                . withDatum proposalInputDatum
+                , withValue pst
-                . withOutRef proposalRef
+                , withDatum proposalInputDatum
+                , withOutRef proposalRef
+                ]
           , input $
-              script stakeValidatorHash
+              mconcat
-                . withValue stakeValue
+                [ script stakeValidatorHash
-                . withDatum stakeInputDatum
+                , withValue stakeValue
-                . withOutRef stakeRef
+                , withDatum stakeInputDatum
+                , withOutRef stakeRef
+                ]
           , output $
-              script proposalValidatorHash
+              mconcat
-                . withValue pst
+                [ script proposalValidatorHash
-                . withDatum proposalOutputDatum
+                , withValue pst
+                , withDatum proposalOutputDatum
+                ]
           , output $
-              script stakeValidatorHash
+              mconcat
-                . withValue stakeValue
+                [ script stakeValidatorHash
-                . withDatum stakeOutputDatum
+                , withValue stakeValue
+                , withDatum stakeOutputDatum
+                ]
           ]
    in builder
 
@@ -270,7 +277,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
       testValidator
         isValid
         "proposal"
-        (proposalValidator Shared.proposal)
+        agoraScripts.compiledProposalValidator
         proposalInputDatum
         (mkProposalRedeemer ps)
         (spend proposalRef)
@@ -279,7 +286,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
       let stakeInputDatum = mkStakeInputDatum ps
        in validatorSucceedsWith
             "stake"
-            (stakeValidator Shared.stake)
+            agoraScripts.compiledStakeValidator
             stakeInputDatum
             stakeRedeemer
             (spend stakeRef)

agora-specs/Sample/Shared.hs

@@ -12,11 +12,15 @@ module Sample.Shared (
   signer,
   signer2,
   minAda,
+  deterministicTracingConfing,
+  mkEffect,
+
+  -- * Agora Scripts
+  agoraScripts,
 
   -- * Components
 
   -- ** Stake
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
   stakeAddress,
@@ -33,14 +37,12 @@ module Sample.Shared (
   gstUTXORef,
 
   -- ** Proposal
-  proposal,
   proposalPolicySymbol,
   proposalValidatorHash,
   proposalValidatorAddress,
   proposalStartingTimeFromTimeRange,
 
   -- ** Authority
-  authorityToken,
   authorityTokenSymbol,
 
   -- ** Treasury
@@ -53,38 +55,29 @@ module Sample.Shared (
   wrongEffHash,
 ) where
 
-import Agora.AuthorityToken (AuthorityToken)
+import Agora.Bootstrap qualified as Bootstrap
 import Agora.Effect.NoOp (noOpValidator)
 import Agora.Governor (Governor (Governor))
-import Agora.Governor.Scripts (
+import Agora.Proposal (ProposalThresholds (..))
-  authorityTokenFromGovernor,
-  authorityTokenSymbolFromGovernor,
-  governorPolicy,
-  governorSTAssetClassFromGovernor,
-  governorValidator,
-  governorValidatorHash,
-  proposalFromGovernor,
-  proposalSTSymbolFromGovernor,
-  proposalValidatorHashFromGovernor,
-  stakeFromGovernor,
-  stakeSTAssetClassFromGovernor,
-  stakeSTSymbolFromGovernor,
-  stakeValidatorHashFromGovernor,
- )
-import Agora.Proposal (Proposal (..), ProposalThresholds (..))
 import Agora.Proposal.Time (
   MaxTimeRangeWidth (..),
   ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (..),
  )
-import Agora.Stake (Stake (..))
+import Agora.Scripts qualified as Scripts
 import Agora.Treasury (treasuryValidator)
-import Agora.Utils (validatorHashToTokenName)
+import Agora.Utils (
+  CompiledEffect (CompiledEffect),
+  CompiledMintingPolicy (getCompiledMintingPolicy),
+  CompiledValidator (getCompiledValidator),
+  validatorHashToTokenName,
+ )
 import Data.Default.Class (Default (..))
 import Data.Tagged (Tagged (..))
+import Plutarch (Config (..), TracingMode (DetTracing))
 import Plutarch.Api.V1 (
+  PValidator,
   mintingPolicySymbol,
-  mkMintingPolicy,
   mkValidator,
   validatorHash,
  )
@@ -110,24 +103,13 @@ import PlutusLedgerApi.V1.Value qualified as Value (
   assetClass,
   singleton,
  )
+import PlutusTx qualified
 
-stake :: Stake
+-- Plutarch compiler configauration.
-stake = stakeFromGovernor governor
+-- TODO: add the ability to change this value. Maybe wrap everything in a
-
+--        Reader monad?
-stakeSymbol :: CurrencySymbol
+deterministicTracingConfing :: Config
-stakeSymbol = stakeSTSymbolFromGovernor governor
+deterministicTracingConfing = Config DetTracing
-
-stakeAssetClass :: AssetClass
-stakeAssetClass = stakeSTAssetClassFromGovernor governor
-
-stakeValidatorHash :: ValidatorHash
-stakeValidatorHash = stakeValidatorHashFromGovernor governor
-
-stakeAddress :: Address
-stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing
-
-gstUTXORef :: TxOutRef
-gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
 
 governor :: Governor
 governor = Governor oref gt mc
@@ -140,29 +122,44 @@ governor = Governor oref gt mc
           "LQ"
     mc = 20
 
+agoraScripts :: Scripts.AgoraScripts
+agoraScripts = Bootstrap.agoraScripts deterministicTracingConfing governor
+
+stakeSymbol :: CurrencySymbol
+stakeSymbol = Scripts.stakeSTSymbol agoraScripts
+
+stakeAssetClass :: AssetClass
+stakeAssetClass = Scripts.stakeSTAssetClass agoraScripts
+
+stakeValidatorHash :: ValidatorHash
+stakeValidatorHash = Scripts.stakeValidatorHash agoraScripts
+
+stakeAddress :: Address
+stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing
+
+gstUTXORef :: TxOutRef
+gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
+
 govPolicy :: MintingPolicy
-govPolicy = mkMintingPolicy (governorPolicy governor)
+govPolicy = getCompiledMintingPolicy $ agoraScripts.compiledGovernorPolicy
 
 govValidator :: Validator
-govValidator = mkValidator (governorValidator governor)
+govValidator = getCompiledValidator $ agoraScripts.compiledGovernorValidator
 
 govSymbol :: CurrencySymbol
 govSymbol = mintingPolicySymbol govPolicy
 
 govAssetClass :: AssetClass
-govAssetClass = governorSTAssetClassFromGovernor governor
+govAssetClass = Scripts.governorSTAssetClass agoraScripts
 
 govValidatorHash :: ValidatorHash
-govValidatorHash = governorValidatorHash governor
+govValidatorHash = Scripts.governorValidatorHash agoraScripts
 
 govValidatorAddress :: Address
 govValidatorAddress = scriptHashAddress govValidatorHash
 
-proposal :: Proposal
-proposal = proposalFromGovernor governor
-
 proposalPolicySymbol :: CurrencySymbol
-proposalPolicySymbol = proposalSTSymbolFromGovernor governor
+proposalPolicySymbol = Scripts.proposalSTSymbol agoraScripts
 
 -- | A sample 'PubKeyHash'.
 signer :: PubKeyHash
@@ -173,7 +170,7 @@ signer2 :: PubKeyHash
 signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
 
 proposalValidatorHash :: ValidatorHash
-proposalValidatorHash = proposalValidatorHashFromGovernor governor
+proposalValidatorHash = Scripts.proposalValidatoHash agoraScripts
 
 proposalValidatorAddress :: Address
 proposalValidatorAddress = scriptHashAddress proposalValidatorHash
@@ -189,11 +186,8 @@ instance Default ProposalThresholds where
       , vote = Tagged 100
       }
 
-authorityToken :: AuthorityToken
-authorityToken = authorityTokenFromGovernor governor
-
 authorityTokenSymbol :: CurrencySymbol
-authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
+authorityTokenSymbol = Scripts.authorityTokenSymbol agoraScripts
 
 {- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'.
      For testing purpose only.
@@ -222,6 +216,9 @@ proposalStartingTimeFromTimeRange
     ProposalStartingTime $ (l + u) `div` 2
 proposalStartingTimeFromTimeRange _ = error "Given time range should be finite and closed"
 
+mkEffect :: (PlutusTx.ToData datum) => ClosedTerm PValidator -> CompiledEffect datum
+mkEffect v = CompiledEffect $ mkValidator deterministicTracingConfing v
+
 ------------------------------------------------------------------
 
 treasuryOut :: TxOut
@@ -239,7 +236,7 @@ gatCs :: CurrencySymbol
 gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
 
 trValidator :: Validator
-trValidator = mkValidator (treasuryValidator gatCs)
+trValidator = mkValidator def (treasuryValidator gatCs)
 
 -- | `ScriptCredential` used for the dummy treasury validator.
 trCredential :: Credential
@@ -251,7 +248,7 @@ gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
 
 -- | Mock treasury effect script, used for testing.
 mockTrEffect :: Validator
-mockTrEffect = mkValidator $ noOpValidator gatCs
+mockTrEffect = mkValidator def $ noOpValidator gatCs
 
 -- | Mock treasury effect validator hash
 mockTrEffectHash :: ValidatorHash

agora-specs/Sample/Stake.hs

@@ -6,10 +6,8 @@ Description: Sample based testing for Stake utxos
 This module tests primarily the happy path for Stake creation
 -}
 module Sample.Stake (
-  stake,
   stakeAssetClass,
   stakeSymbol,
-  validatorHashTN,
   signer,
 
   -- * Script contexts
@@ -20,14 +18,12 @@ module Sample.Stake (
   DepositWithdrawExample (..),
 ) where
 
+import Agora.Governor (Governor (gtClassRef))
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
-  Stake (gtClassRef),
   StakeDatum (StakeDatum, stakedAmount),
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Data.Tagged (Tagged, untag)
-import Plutarch.Api.V1 (mkValidator, validatorHash)
 import Plutarch.Context (
   MintingBuilder,
   SpendingBuilder,
@@ -50,9 +46,7 @@ import PlutusLedgerApi.V1 (
   ScriptContext (..),
   ScriptPurpose (Minting),
   ToData (toBuiltinData),
-  TokenName (TokenName),
   TxInfo (txInfoData, txInfoSignatories),
-  ValidatorHash (ValidatorHash),
  )
 import PlutusLedgerApi.V1.Contexts (TxOutRef (..))
 import PlutusLedgerApi.V1.Value qualified as Value (
@@ -60,16 +54,13 @@ import PlutusLedgerApi.V1.Value qualified as Value (
   singleton,
  )
 import Sample.Shared (
+  governor,
   signer,
-  stake,
   stakeAssetClass,
   stakeSymbol,
   stakeValidatorHash,
  )
-
+import Test.Util (sortValue)
--- | 'TokenName' that represents the hash of the 'Stake' validator.
-validatorHashTN :: TokenName
-validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValidator stake) in TokenName vh
 
 -- | This script context should be a valid transaction.
 stakeCreation :: ScriptContext
@@ -85,9 +76,11 @@ stakeCreation =
           , signedWith signer
           , mint st
           , output $
-              script stakeValidatorHash
+              mconcat
-                . withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
+                [ script stakeValidatorHash
-                . withDatum datum
+                , withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
+                , withDatum datum
+                ]
           , withMinting stakeSymbol
           ]
    in buildMintingUnsafe builder
@@ -143,14 +136,26 @@ stakeDepositWithdraw config =
           , signedWith signer
           , mint st
           , input $
-              script stakeValidatorHash
+              mconcat
-                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
+                [ script stakeValidatorHash
-                . withDatum stakeAfter
+                , withValue
-                . withOutRef stakeRef
+                    ( sortValue $
+                        st
+                          <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeBefore.stakedAmount)
+                    )
+                , withDatum stakeAfter
+                , withOutRef stakeRef
+                ]
           , output $
-              script stakeValidatorHash
+              mconcat
-                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount))
+                [ script stakeValidatorHash
-                . withDatum stakeAfter
+                , withValue
+                    ( sortValue $
+                        st
+                          <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeAfter.stakedAmount)
+                    )
+                , withDatum stakeAfter
+                ]
           , withSpendingOutRef stakeRef
           ]
    in buildSpendingUnsafe builder

agora-specs/Sample/Stake/SetDelegate.hs

@@ -19,12 +19,12 @@ module Sample.Stake.SetDelegate (
   delegateToOwnerParameters,
 ) where
 
+import Agora.Governor (Governor (gtClassRef))
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  Stake (gtClassRef),
   StakeDatum (..),
   StakeRedeemer (ClearDelegate, DelegateTo),
  )
-import Agora.Stake.Scripts (stakeValidator)
 import Data.Tagged (untag)
 import Plutarch.Context (
   SpendingBuilder,
@@ -46,10 +46,11 @@ import PlutusLedgerApi.V1 (
  )
 import PlutusLedgerApi.V1.Value qualified as Value
 import Sample.Shared (
+  agoraScripts,
+  governor,
   minAda,
   signer,
   signer2,
-  stake,
   stakeAssetClass,
   stakeValidatorHash,
  )
@@ -118,7 +119,7 @@ setDelegate ps = buildSpendingUnsafe builder
         mconcat
           [ st
           , Value.assetClassValue
-              (untag stake.gtClassRef)
+              (untag governor.gtClassRef)
               (untag stakeInput.stakedAmount)
           , minAda
           ]
@@ -129,14 +130,18 @@ setDelegate ps = buildSpendingUnsafe builder
         [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
         , signedWith signer
         , input $
-            script stakeValidatorHash
+            mconcat
-              . withValue stakeValue
+              [ script stakeValidatorHash
-              . withDatum stakeInput
+              , withValue stakeValue
-              . withOutRef stakeRef
+              , withDatum stakeInput
+              , withOutRef stakeRef
+              ]
         , output $
-            script stakeValidatorHash
+            mconcat
-              . withValue stakeValue
+              [ script stakeValidatorHash
-              . withDatum stakeOutput
+              , withValue stakeValue
+              , withDatum stakeOutput
+              ]
         , withSpendingOutRef stakeRef
         ]
 
@@ -150,7 +155,7 @@ mkTestCase name ps valid =
   testValidator
     valid
     name
-    (stakeValidator stake)
+    agoraScripts.compiledStakeValidator
     (mkStakeInputDatum ps)
     (mkStakeRedeemer ps)
     (setDelegate ps)

agora-specs/Sample/Treasury.hs

@@ -19,7 +19,6 @@ module Sample.Treasury (
 
 import Plutarch.Context (
   MintingBuilder,
-  UTXO,
   buildMintingUnsafe,
   credential,
   input,
@@ -57,11 +56,12 @@ import Sample.Shared (
 
 baseCtxBuilder :: MintingBuilder
 baseCtxBuilder =
-  let treasury :: UTXO -> UTXO
+  let treasury =
-      treasury =
+        mconcat
-        credential trCredential
+          [ credential trCredential
-          . withValue minAda
+          , withValue minAda
-          . withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+          , withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+          ]
    in mconcat
         [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
         , signedWith signer
@@ -81,9 +81,11 @@ validCtx =
         mconcat
           [ baseCtxBuilder
           , input $
-              script mockTrEffectHash
+              mconcat
-                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                [ script mockTrEffectHash
-                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                , withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                ]
           ]
    in buildMintingUnsafe builder
 
@@ -122,8 +124,10 @@ trCtxGATNameNotAddress =
         mconcat
           [ baseCtxBuilder
           , input $
-              script wrongEffHash
+              mconcat
-                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                [ script wrongEffHash
-                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                , withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                ]
           ]
    in buildMintingUnsafe builder

agora-specs/Spec/AuthorityToken.hs

@@ -10,7 +10,8 @@ Tests for Authority token functions
 module Spec.AuthorityToken (specs) where
 
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
+import Plutarch (ClosedTerm, POpaque, perror, popaque)
+import Plutarch.Extra.Compile (mustCompile)
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1 (
   Address (Address),
@@ -60,7 +61,7 @@ singleAuthorityTokenBurnedTest mint outs =
           actual
           (popaque (pconstant ()))
           perror
-   in compile s
+   in mustCompile s
 
 -- | The SpecificationTree exported by this module.
 specs :: [SpecificationTree]

agora-specs/Spec/Effect/GovernorMutation.hs

@@ -2,8 +2,8 @@ module Spec.Effect.GovernorMutation (specs) where
 
 import Agora.Effect.GovernorMutation (mutateGovernorValidator)
 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
-import Agora.Governor.Scripts (governorValidator)
 import Agora.Proposal (ProposalId (..))
+import Agora.Scripts (AgoraScripts (..))
 import Data.Default.Class (Default (def))
 import PlutusLedgerApi.V1 (ScriptContext (ScriptContext), ScriptPurpose (Spending))
 import Sample.Effect.GovernorMutation (
@@ -14,7 +14,7 @@ import Sample.Effect.GovernorMutation (
   mkEffectTxInfo,
   validNewGovernorDatum,
  )
-import Sample.Shared qualified as Shared
+import Sample.Shared (agoraScripts, mkEffect)
 import Test.Specification (
   SpecificationTree,
   effectFailsWith,
@@ -32,7 +32,7 @@ specs =
           "valid new governor datum"
           [ validatorSucceedsWith
               "governor validator should pass"
-              (governorValidator Shared.governor)
+              agoraScripts.compiledGovernorValidator
               ( GovernorDatum
                   def
                   (ProposalId 0)
@@ -47,7 +47,7 @@ specs =
               )
           , effectSucceedsWith
               "effect validator should pass"
-              (mutateGovernorValidator Shared.governor)
+              (mkEffect $ mutateGovernorValidator agoraScripts)
               (mkEffectDatum validNewGovernorDatum)
               (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
           ]
@@ -55,7 +55,7 @@ specs =
           "invalid new governor datum"
           [ validatorFailsWith
               "governor validator should fail"
-              (governorValidator Shared.governor)
+              agoraScripts.compiledGovernorValidator
               ( GovernorDatum
                   def
                   (ProposalId 0)
@@ -70,7 +70,7 @@ specs =
               )
           , effectFailsWith
               "effect validator should fail"
-              (mutateGovernorValidator Shared.governor)
+              (mkEffect $ mutateGovernorValidator agoraScripts)
               (mkEffectDatum validNewGovernorDatum)
               (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
           ]

agora-specs/Spec/Effect/TreasuryWithdrawal.hs

@@ -25,12 +25,14 @@ import Sample.Effect.TreasuryWithdrawal (
   treasuries,
   users,
  )
+import Sample.Shared (mkEffect)
 import Test.Specification (
   SpecificationTree,
   effectFailsWith,
   effectSucceedsWith,
   group,
  )
+import Test.Util (sortValue)
 
 specs :: [SpecificationTree]
 specs =
@@ -38,7 +40,7 @@ specs =
       "effect"
       [ effectSucceedsWith
           "Simple"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum1
           ( buildScriptContext
               [ inputGAT
@@ -50,7 +52,7 @@ specs =
           )
       , effectSucceedsWith
           "Simple with multiple treasuries "
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum1
           ( buildScriptContext
               [ inputGAT
@@ -67,7 +69,7 @@ specs =
           )
       , effectSucceedsWith
           "Mixed Assets"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum2
           ( buildScriptContext
               [ inputGAT
@@ -82,7 +84,7 @@ specs =
           )
       , effectFailsWith
           "Pay to uknown 3rd party"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum2
           ( buildScriptContext
               [ inputGAT
@@ -98,7 +100,7 @@ specs =
           )
       , effectFailsWith
           "Missing receiver"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum2
           ( buildScriptContext
               [ inputGAT
@@ -113,7 +115,7 @@ specs =
           )
       , effectFailsWith
           "Unauthorized treasury"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum3
           ( buildScriptContext
               [ inputGAT
@@ -125,7 +127,7 @@ specs =
           )
       , effectFailsWith
           "Prevent transactions besides the withdrawal"
-          (treasuryWithdrawalValidator currSymbol)
+          (mkEffect $ treasuryWithdrawalValidator currSymbol)
           datum3
           ( buildScriptContext
               [ inputGAT
@@ -141,8 +143,14 @@ specs =
       ]
   ]
   where
-    asset1 = Value.singleton "abbc12" "OrangeBottle"
+    asset1 =
-    asset2 = Value.singleton "abbc12" "19721121"
+      Value.singleton
+        "0d586e057e76238f8c56c0752507bfa45ae13b04f8497a311d4aaa48"
+        "OrangeBottle"
+    asset2 =
+      Value.singleton
+        "7e6aa764bceeba1f7acf47d20f1a2a85440afa2928f8ae96376f4d85"
+        "19721121"
     datum1 =
       TreasuryWithdrawalDatum
         [ (head users, asset1 1)
@@ -155,8 +163,8 @@ specs =
         ]
     datum2 =
       TreasuryWithdrawalDatum
-        [ (head users, asset2 5 <> asset1 4)
+        [ (head users, sortValue $ asset2 5 <> asset1 4)
-        , (users !! 1, asset2 1 <> asset1 2)
+        , (users !! 1, sortValue $ asset2 1 <> asset1 2)
         , (users !! 2, asset1 1)
         ]
         [ head treasuries

agora-specs/Spec/Stake.hs

@@ -9,14 +9,14 @@ Tests for Stake policy and validator
 -}
 module Spec.Stake (specs) where
 
+import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  Stake (..),
   StakeDatum (StakeDatum),
   StakeRedeemer (DepositWithdraw),
  )
-import Agora.Stake.Scripts (stakePolicy, stakeValidator)
 import Data.Bool (Bool (..))
 import Data.Maybe (Maybe (..))
+import Sample.Shared (agoraScripts)
 import Sample.Stake (
   DepositWithdrawExample (
     DepositWithdrawExample,
@@ -26,7 +26,6 @@ import Sample.Stake (
   signer,
  )
 import Sample.Stake qualified as Stake (
-  stake,
   stakeCreation,
   stakeCreationUnsigned,
   stakeCreationWrongDatum,
@@ -41,7 +40,6 @@ import Test.Specification (
   validatorFailsWith,
   validatorSucceedsWith,
  )
-import Test.Util (toDatum)
 import Prelude (Num (negate), ($))
 
 -- | The SpecificationTree exported by this module.
@@ -51,17 +49,17 @@ specs =
       "policy"
       [ policySucceedsWith
           "stakeCreation"
-          (stakePolicy Stake.stake.gtClassRef)
+          agoraScripts.compiledStakePolicy
           ()
           Stake.stakeCreation
       , policyFailsWith
           "stakeCreationWrongDatum"
-          (stakePolicy Stake.stake.gtClassRef)
+          agoraScripts.compiledStakePolicy
           ()
           Stake.stakeCreationWrongDatum
       , policyFailsWith
           "stakeCreationUnsigned"
-          (stakePolicy Stake.stake.gtClassRef)
+          agoraScripts.compiledStakePolicy
           ()
           Stake.stakeCreationUnsigned
       ]
@@ -69,21 +67,21 @@ specs =
       "validator"
       [ validatorSucceedsWith
           "stakeDepositWithdraw deposit"
-          (stakeValidator Stake.stake)
+          agoraScripts.compiledStakeValidator
-          (toDatum $ StakeDatum 100_000 signer Nothing [])
+          (StakeDatum 100_000 signer Nothing [])
-          (toDatum $ DepositWithdraw 100_000)
+          (DepositWithdraw 100_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000})
       , validatorSucceedsWith
           "stakeDepositWithdraw withdraw"
-          (stakeValidator Stake.stake)
+          agoraScripts.compiledStakeValidator
-          (toDatum $ StakeDatum 100_000 signer Nothing [])
+          (StakeDatum 100_000 signer Nothing [])
-          (toDatum $ DepositWithdraw $ negate 100_000)
+          (DepositWithdraw $ negate 100_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000})
       , validatorFailsWith
           "stakeDepositWithdraw negative GT"
-          (stakeValidator Stake.stake)
+          agoraScripts.compiledStakeValidator
-          (toDatum $ StakeDatum 100_000 signer Nothing [])
+          (StakeDatum 100_000 signer Nothing [])
-          (toDatum $ DepositWithdraw 1_000_000)
+          (DepositWithdraw 1_000_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000})
       , group
           "set delegate"

agora-specs/Spec/Treasury.hs

@@ -25,6 +25,8 @@ import Agora.Treasury (
   TreasuryRedeemer (SpendTreasuryGAT),
   treasuryValidator,
  )
+import Agora.Utils (CompiledValidator (CompiledValidator))
+import Plutarch.Api.V1 (mkValidator)
 import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey))
 import PlutusLedgerApi.V1.Contexts (
   ScriptContext (scriptContextPurpose, scriptContextTxInfo),
@@ -35,7 +37,7 @@ import PlutusLedgerApi.V1.Credential (
   StakingCredential (StakingHash),
  )
 import PlutusLedgerApi.V1.Value qualified as Value (singleton)
-import Sample.Shared (trCredential)
+import Sample.Shared (deterministicTracingConfing, trCredential)
 import Sample.Treasury (
   gatCs,
   gatTn,
@@ -51,6 +53,12 @@ import Test.Specification (
   validatorSucceedsWith,
  )
 
+compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer
+compiledTreasuryValidator =
+  CompiledValidator $
+    mkValidator deterministicTracingConfing $
+      treasuryValidator gatCs
+
 specs :: [SpecificationTree]
 specs =
   [ group
@@ -59,7 +67,7 @@ specs =
           "Positive"
           [ validatorSucceedsWith
               "Allows for effect changes"
-              (treasuryValidator gatCs)
+              compiledTreasuryValidator
               ()
               SpendTreasuryGAT
               validCtx
@@ -70,7 +78,7 @@ specs =
               "Fails with ScriptPurpose not Minting"
               [ validatorFailsWith
                   "Spending"
-                  (treasuryValidator gatCs)
+                  compiledTreasuryValidator
                   ()
                   SpendTreasuryGAT
                   validCtx
@@ -78,7 +86,7 @@ specs =
                     }
               , validatorFailsWith
                   "Rewarding"
-                  (treasuryValidator gatCs)
+                  compiledTreasuryValidator
                   ()
                   SpendTreasuryGAT
                   validCtx
@@ -88,7 +96,7 @@ specs =
                     }
               , validatorFailsWith
                   "Certifying"
-                  (treasuryValidator gatCs)
+                  compiledTreasuryValidator
                   ()
                   SpendTreasuryGAT
                   validCtx
@@ -100,7 +108,7 @@ specs =
               ]
           , validatorFailsWith -- TODO: Use QuickCheck.
               "Fails when multiple GATs burned"
-              (treasuryValidator gatCs)
+              compiledTreasuryValidator
               ()
               SpendTreasuryGAT
               validCtx
@@ -115,13 +123,13 @@ specs =
                 }
           , validatorFailsWith
               "Fails when GAT token name is not script address"
-              (treasuryValidator gatCs)
+              compiledTreasuryValidator
               ()
               SpendTreasuryGAT
               trCtxGATNameNotAddress
           , validatorFailsWith
               "Fails with wallet as input"
-              (treasuryValidator gatCs)
+              compiledTreasuryValidator
               ()
               SpendTreasuryGAT
               ( let txInfo = validCtx.scriptContextTxInfo

agora-testlib/Test/Specification.hs

@@ -49,11 +49,18 @@ module Test.Specification (
   toTestTree,
 ) where
 
-import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import Agora.Utils (CompiledEffect (..), CompiledMintingPolicy (..), CompiledValidator (..))
-import Plutarch.Builtin (pforgetData)
+import Control.Composition ((.**), (.***))
+import Data.Coerce (coerce)
 import Plutarch.Evaluate (evalScript)
-import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
+import PlutusLedgerApi.V1 (
-import PlutusLedgerApi.V1 (Script, ScriptContext)
+  Datum (..),
+  Redeemer (Redeemer),
+  Script,
+  ScriptContext,
+  ToData (toBuiltinData),
+ )
+import PlutusLedgerApi.V1.Scripts (Context (..), applyMintingPolicyScript, applyValidator)
 import PlutusTx.IsData qualified as PlutusTx (ToData)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase)
@@ -152,122 +159,133 @@ scriptSucceeds name script = Terminal $ Specification name Success script
 scriptFails :: String -> Script -> SpecificationTree
 scriptFails name script = Terminal $ Specification name Failure script
 
+mkContext :: ScriptContext -> Context
+mkContext = Context . toBuiltinData
+
+mkRedeemer ::
+  forall redeemer.
+  (PlutusTx.ToData redeemer) =>
+  redeemer ->
+  Redeemer
+mkRedeemer = Redeemer . toBuiltinData
+
+mkDatum ::
+  forall datum.
+  (PlutusTx.ToData datum) =>
+  datum ->
+  Datum
+mkDatum = Datum . toBuiltinData
+
+applyMintingPolicy' ::
+  (PlutusTx.ToData redeemer) =>
+  CompiledMintingPolicy redeemer ->
+  redeemer ->
+  ScriptContext ->
+  Script
+applyMintingPolicy' policy redeemer scriptContext =
+  applyMintingPolicyScript
+    (mkContext scriptContext)
+    (getCompiledMintingPolicy policy)
+    (mkRedeemer redeemer)
+
+applyValidator' ::
+  ( PlutusTx.ToData datum
+  , PlutusTx.ToData redeemer
+  ) =>
+  CompiledValidator datum redeemer ->
+  datum ->
+  redeemer ->
+  ScriptContext ->
+  Script
+applyValidator' validator datum redeemer scriptContext =
+  applyValidator
+    (mkContext scriptContext)
+    (getCompiledValidator validator)
+    (mkDatum datum)
+    (mkRedeemer redeemer)
+
 -- | Check that a policy script succeeds, given a name and arguments.
 policySucceedsWith ::
-  ( PLift redeemer
+  (PlutusTx.ToData redeemer) =>
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
   String ->
-  ClosedTerm PMintingPolicy ->
+  CompiledMintingPolicy redeemer ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
-policySucceedsWith tag policy redeemer scriptContext =
+policySucceedsWith tag =
-  scriptSucceeds tag $
+  scriptSucceeds tag .** applyMintingPolicy'
-    compile
-      ( policy
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
 
 -- | Check that a policy script fails, given a name and arguments.
 policyFailsWith ::
-  ( PLift redeemer
+  (PlutusTx.ToData redeemer) =>
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
   String ->
-  ClosedTerm PMintingPolicy ->
+  CompiledMintingPolicy redeemer ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
-policyFailsWith tag policy redeemer scriptContext =
+policyFailsWith tag =
-  scriptFails tag $
+  scriptFails tag .** applyMintingPolicy'
-    compile
-      ( policy
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
 
 -- | Check that a validator script succeeds, given a name and arguments.
 validatorSucceedsWith ::
-  ( PLift datum
+  ( PlutusTx.ToData datum
-  , PlutusTx.ToData (PLifted datum)
+  , PlutusTx.ToData redeemer
-  , PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
   ) =>
   String ->
-  ClosedTerm PValidator ->
+  CompiledValidator datum redeemer ->
-  PLifted datum ->
+  datum ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
-validatorSucceedsWith tag validator datum redeemer scriptContext =
+validatorSucceedsWith tag =
-  scriptSucceeds tag $
+  scriptSucceeds tag .*** applyValidator'
-    compile
-      ( validator
-          # pforgetData (pconstantData datum)
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
 
 -- | Check that a validator script fails, given a name and arguments.
 validatorFailsWith ::
-  ( PLift datum
+  ( PlutusTx.ToData datum
-  , PlutusTx.ToData (PLifted datum)
+  , PlutusTx.ToData redeemer
-  , PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
   ) =>
   String ->
-  ClosedTerm PValidator ->
+  CompiledValidator datum redeemer ->
-  PLifted datum ->
+  datum ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
-validatorFailsWith tag validator datum redeemer scriptContext =
+validatorFailsWith tag =
-  scriptFails tag $
+  scriptFails tag .*** applyValidator'
-    compile
-      ( validator
-          # pforgetData (pconstantData datum)
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
 
 -- | Check that an effect succeeds, given a name and argument.
 effectSucceedsWith ::
-  ( PLift datum
+  ( PlutusTx.ToData datum
-  , PlutusTx.ToData (PLifted datum)
   ) =>
   String ->
-  ClosedTerm PValidator ->
+  CompiledEffect datum ->
-  PLifted datum ->
+  datum ->
   ScriptContext ->
   SpecificationTree
-effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum ()
+effectSucceedsWith tag eff datum = validatorSucceedsWith tag (coerce eff) datum ()
 
 -- | Check that an effect fails, given a name and argument.
 effectFailsWith ::
-  ( PLift datum
+  ( PlutusTx.ToData datum
-  , PlutusTx.ToData (PLifted datum)
   ) =>
   String ->
-  ClosedTerm PValidator ->
+  CompiledEffect datum ->
-  PLifted datum ->
+  datum ->
   ScriptContext ->
   SpecificationTree
-effectFailsWith tag eff datum = validatorFailsWith tag eff datum ()
+effectFailsWith tag eff datum = validatorFailsWith tag (coerce eff) datum ()
 
+-- | Test a validator, given the expectation as a boolean value.
 testValidator ::
-  ( PLift datum
+  forall datum redeemer.
-  , PlutusTx.ToData (PLifted datum)
+  (PlutusTx.ToData datum, PlutusTx.ToData redeemer) =>
-  , PLift redeemer
+  -- | Is this test case expected to succeed?
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
-  -- | Should the validator pass?
   Bool ->
   String ->
-  ClosedTerm PValidator ->
+  CompiledValidator datum redeemer ->
-  PLifted datum ->
+  datum ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
 testValidator isValid =
@@ -275,14 +293,15 @@ testValidator isValid =
     then validatorSucceedsWith
     else validatorFailsWith
 
+-- | Test a policy, given the expectation as a boolean value.
 testPolicy ::
-  ( PLift redeemer
+  forall redeemer.
-  , PlutusTx.ToData (PLifted redeemer)
+  (PlutusTx.ToData redeemer) =>
-  ) =>
+  -- | Is this test case expected to succeed?
   Bool ->
   String ->
-  ClosedTerm PMintingPolicy ->
+  CompiledMintingPolicy redeemer ->
-  PLifted redeemer ->
+  redeemer ->
   ScriptContext ->
   SpecificationTree
 testPolicy isValid =

agora-testlib/Test/Util.hs

@@ -19,7 +19,6 @@ module Test.Util (
   scriptCredentials,
   validatorHashes,
   groupsOfN,
-  withOptional,
   mkSpending,
   mkMinting,
   CombinableBuilder,
@@ -37,7 +36,6 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy
 import Data.List (sortOn)
 import Plutarch.Context (
   Builder,
-  UTXO,
   buildMintingUnsafe,
   buildSpendingUnsafe,
   withMinting,
@@ -182,15 +180,6 @@ groupsOfN n xs =
 
 --------------------------------------------------------------------------------
 
--- | Optionally apply a modifier to the given 'UTXO'.
-withOptional ::
-  (a -> UTXO -> UTXO) ->
-  Maybe a ->
-  UTXO ->
-  UTXO
-withOptional f (Just b) = f b
-withOptional _ _ = id
-
 {- | Given the builder generator and the parameters, create a 'ScriptContext'
     that spends the UTXO that referenced by the given 'TxOutRef'.
 -}

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/AuthorityToken.hs

@@ -12,7 +12,6 @@ module Agora.AuthorityToken (
   AuthorityToken (..),
 ) where
 
-import GHC.Generics qualified as GHC
 import Plutarch.Api.V1 (
   AmountGuarantees,
   KeyGuarantees,
@@ -53,7 +52,7 @@ newtype AuthorityToken = AuthorityToken
   }
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
 
 --------------------------------------------------------------------------------
@@ -105,7 +104,7 @@ authorityTokensValidIn = phoistAcyclic $
 singleAuthorityTokenBurned ::
   forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
   Term s PCurrencySymbol ->
-  Term s (PBuiltinList (PAsData PTxInInfo)) ->
+  Term s (PBuiltinList PTxInInfo) ->
   Term s (PValue keys amounts) ->
   Term s PBool
 singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
@@ -120,7 +119,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
           pall
             # plam
               ( \txInInfo' -> unTermCont $ do
-                  PTxInInfo txInInfo <- pmatchC (pfromData txInInfo')
+                  PTxInInfo txInInfo <- pmatchC txInInfo'
                   let txOut' = pfield @"resolved" # txInInfo
                   pure $ authorityTokensValidIn # gatCs # pfromData txOut'
               )
@@ -156,9 +155,7 @@ authorityTokenPolicy params =
               pguardC "All outputs only emit valid GATs" $
                 pall
                   # plam
-                    ( (authorityTokensValidIn # ownSymbol #)
+                    (authorityTokensValidIn # ownSymbol #)
-                        . pfromData
-                    )
                   # txInfo.outputs
               pure $ popaque $ pconstant ()
           )

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

@@ -8,7 +8,14 @@ Helpers for constructing effects.
 module Agora.Effect (makeEffect) where
 
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue)
+import Plutarch.Api.V1 (
+  PCurrencySymbol,
+  PScriptPurpose (PSpending),
+  PTxInfo,
+  PTxOutRef,
+  PValidator,
+  PValue,
+ )
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
 import Plutarch.TryFrom ()
 import PlutusLedgerApi.V1.Value (CurrencySymbol)
@@ -23,7 +30,7 @@ import PlutusLedgerApi.V1.Value (CurrencySymbol)
 -}
 makeEffect ::
   forall (datum :: PType).
-  (PIsData datum, PTryFrom PData (PAsData 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
@@ -34,7 +41,7 @@ makeEffect gatCs' f =
     -- convert input datum, PData, into desierable type
     -- the way this conversion is performed should be defined
     -- by PTryFrom for each datum in effect script.
-    (pfromData -> datum', _) <- ptryFromC datum
+    (datum', _) <- ptryFromC datum
 
     -- ensure purpose is Spending.
     PSpending txOutRef <- pmatchC $ pfromData ctx.purpose

agora/Agora/Effect/GovernorMutation.hs

@@ -20,18 +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 GHC.Generics qualified as GHC
+import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass)
-import Generics.SOP (Generic, I (I))
 import Plutarch.Api.V1 (
   PTxOutRef,
   PValidator,
@@ -42,7 +36,6 @@ import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf)
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
-  PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Extra.Maybe (
   passertPDJust,
@@ -66,8 +59,12 @@ data MutateGovernorDatum = MutateGovernorDatum
   , newDatum :: GovernorDatum
   -- ^ The new settings for the governor.
   }
-  deriving stock (Show, GHC.Generic)
+  deriving stock
-  deriving anyclass (Generic)
+    ( -- | @since 0.1.ç
+      Show
+    , -- | @since 0.1.ç
+      Generic
+    )
 
 PlutusTx.makeIsDataIndexed ''MutateGovernorDatum [('MutateGovernorDatum, 0)]
 
@@ -88,18 +85,10 @@ newtype PMutateGovernorDatum (s :: S)
           )
       )
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -109,7 +98,9 @@ newtype PMutateGovernorDatum (s :: S)
     , -- | @since 0.1.0
       PEq
     )
-    via (PIsDataReprInstances PMutateGovernorDatum)
+
+instance DerivePlutusType PMutateGovernorDatum where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum
@@ -118,7 +109,7 @@ instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernor
 deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstantDecl MutateGovernorDatum)
 
 -- | @since 0.1.0
-deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFrom PData (PAsData PMutateGovernorDatum)
+deriving anyclass instance PTryFrom PData PMutateGovernorDatum
 
 --------------------------------------------------------------------------------
 
@@ -147,8 +138,11 @@ deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFr
 
      @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
@@ -195,7 +189,7 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
       plength # pfromData txInfoF.outputs #== 1
 
     let govAddress = pfield @"address" #$ govInInfo.resolved
-        govOutput' = pfromData $ phead # pfromData txInfoF.outputs
+        govOutput' = phead # pfromData txInfoF.outputs
 
     govOutput <- pletFieldsC @'["address", "value", "datumHash"] govOutput'
 
@@ -208,9 +202,8 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
     let governorOutputDatumHash =
           passertPDJust # "Governor output doesn't have datum" # govOutput.datumHash
         governorOutputDatum =
-          pfromData @PGovernorDatum $
+          passertPJust @PGovernorDatum # "Governor output datum not found"
-            passertPJust # "Governor output datum not found"
+            #$ ptryFindDatum # governorOutputDatumHash # txInfoF.datums
-              #$ ptryFindDatum # governorOutputDatumHash # txInfoF.datums
 
     -- Ensure the output governor datum is what we want.
     pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum
@@ -222,4 +215,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/Effect/NoOp.hs

@@ -7,11 +7,9 @@ A dumb effect that only burns its GAT.
 -}
 module Agora.Effect.NoOp (noOpValidator, PNoOp) where
 
-import Control.Applicative (Const)
-
 import Agora.Effect (makeEffect)
+import Agora.Plutarch.Orphans ()
 import Plutarch.Api.V1 (PValidator)
-import Plutarch.TryFrom (PTryFrom (..))
 import PlutusLedgerApi.V1.Value (CurrencySymbol)
 
 {- | Dummy datum for NoOp effect.
@@ -19,22 +17,23 @@ import PlutusLedgerApi.V1.Value (CurrencySymbol)
      @since 0.1.0
 -}
 newtype PNoOp (s :: S) = PNoOp (Term s PUnit)
-  deriving
+  deriving stock
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     )
-    via (DerivePNewtype PNoOp PUnit)
 
--- | @since 0.1.0
+-- | @since 0.2.0
-instance PTryFrom PData (PAsData PNoOp) where
+instance DerivePlutusType PNoOp where
-  type PTryFromExcess PData (PAsData PNoOp) = Const ()
+  type DPTStrat _ = PlutusTypeNewtype
-  ptryFrom' _ cont =
+
-    -- JUSTIFICATION:
+-- | @since 0.2.0
-    -- We don't care anything about data.
+instance PTryFrom PData (PAsData PNoOp)
-    -- It should always be reduced to Unit.
-    cont (pdata $ pcon $ PNoOp (pconstant ()), ())
 
 {- | Dummy effect which can only burn its GAT.
 
@@ -42,4 +41,4 @@ instance PTryFrom PData (PAsData PNoOp) where
 -}
 noOpValidator :: CurrencySymbol -> ClosedTerm PValidator
 noOpValidator curr = makeEffect curr $
-  \_ (_datum :: Term s PNoOp) _ _ -> popaque (pconstant ())
+  \_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ())

agora/Agora/Effect/TreasuryWithdrawal.hs

@@ -15,8 +15,6 @@ module Agora.Effect.TreasuryWithdrawal (
 
 import Agora.Effect (makeEffect)
 import Agora.Plutarch.Orphans ()
-import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, I (I))
 import Plutarch.Api.V1 (
   AmountGuarantees (Positive),
   KeyGuarantees (Sorted),
@@ -31,7 +29,6 @@ import "plutarch" Plutarch.Api.V1.Value (pnormalize)
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
-  PIsDataReprInstances (..),
  )
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
@@ -57,10 +54,6 @@ data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
     ( -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.1.0
       Generic
     )
 
@@ -86,15 +79,9 @@ newtype PTreasuryWithdrawalDatum (s :: S)
       )
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      Generic
-    , -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -102,7 +89,9 @@ newtype PTreasuryWithdrawalDatum (s :: S)
     , -- | @since 0.1.0
       PDataFields
     )
-    via PIsDataReprInstances PTreasuryWithdrawalDatum
+
+instance DerivePlutusType PTreasuryWithdrawalDatum where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where
@@ -115,10 +104,7 @@ deriving via
     (PConstantDecl TreasuryWithdrawalDatum)
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData PTreasuryWithdrawalDatum
-  PAsData (PIsDataReprInstances PTreasuryWithdrawalDatum)
-  instance
-    PTryFrom PData (PAsData PTreasuryWithdrawalDatum)
 
 {- | Withdraws given list of values to specific target addresses.
      It can be evoked by burning GAT. The transaction should have correct
@@ -150,17 +136,17 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
       pletC $
         pmap
           # plam
-            ( \(pfromData -> txOut') -> unTermCont $ do
+            ( \txOut' -> unTermCont $ do
                 txOut <- pletFieldsC @'["address", "value"] $ txOut'
                 let cred = pfield @"credential" # pfromData txOut.address
                 pure . pdata $ ptuple # cred # txOut.value
             )
-          # txInfo.outputs
+          # pfromData txInfo.outputs
     inputValues <-
       pletC $
         pmap
           # plam
-            ( \((pfield @"resolved" #) . pfromData -> txOut') -> unTermCont $ do
+            ( \((pfield @"resolved" #) -> txOut') -> unTermCont $ do
                 txOut <- pletFieldsC @'["address", "value"] $ txOut'
                 let cred = pfield @"credential" # pfromData txOut.address
                 pure . pdata $ ptuple # cred # txOut.value
@@ -189,7 +175,7 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
           pnot #$ pany
             # plam
               ( \x ->
-                  effInput.address #== pfield @"address" # pfromData x
+                  effInput.address #== pfield @"address" # x
               )
             # pfromData txInfo.outputs
         inputsAreOnlyTreasuriesOrCollateral =

agora/Agora/Governor.hs

@@ -40,18 +40,15 @@ import Agora.Proposal.Time (
  )
 import Agora.SafeMoney (GTTag)
 import Data.Tagged (Tagged (..))
-import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, I (I))
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
-  PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Extra.IsData (
   DerivePConstantViaEnum (..),
   EnumIsData (..),
+  PlutusTypeEnumData,
  )
-import Plutarch.Extra.Other (DerivePNewtype' (..))
 import Plutarch.Extra.TermCont (pletFieldsC)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
 import PlutusLedgerApi.V1 (TxOutRef)
@@ -78,7 +75,12 @@ data GovernorDatum = GovernorDatum
   -- ^ The maximum number of unfinished proposals that a stake is allowed to be
   --   associated to.
   }
-  deriving stock (Show, GHC.Generic)
+  deriving stock
+    ( -- | @since 0.1.0
+      Show
+    , -- | @since 0.1.0
+      Generic
+    )
 
 -- | @since 0.1.0
 PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
@@ -105,16 +107,12 @@ data GovernorRedeemer
     ( -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     , -- | @since 0.2.0
       Enum
     , -- | @since 0.2.0
       Bounded
     )
-  deriving anyclass
-    ( -- | @since 0.2.0
-      Generic
-    )
   deriving
     ( -- | @since 0.1.0
       PlutusTx.ToData
@@ -136,7 +134,12 @@ data Governor = Governor
   -- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
   -- See `Agora.Proposal.proposalDatumValid`.
   }
-  deriving stock (GHC.Generic)
+  deriving stock
+    ( -- | @since 0.1.0
+      Generic
+    , -- | @since 0.2.0
+      Show
+    )
 
 --------------------------------------------------------------------------------
 
@@ -158,18 +161,10 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
         )
   }
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -179,7 +174,10 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
     , -- | @since 0.1.0
       PEq
     )
-    via PIsDataReprInstances PGovernorDatum
+
+-- | @since 0.2.0
+instance DerivePlutusType PGovernorDatum where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
@@ -188,29 +186,39 @@ instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = Gove
 deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)
 
 -- | @since 0.1.0
-deriving via PAsData (PIsDataReprInstances PGovernorDatum) instance PTryFrom PData (PAsData PGovernorDatum)
+deriving anyclass instance PTryFrom PData PGovernorDatum
 
 {- | Plutarch-level version of 'GovernorRedeemer'.
 
      @since 0.1.0
 -}
-newtype PGovernorRedeemer (s :: S)
+data PGovernorRedeemer (s :: S)
-  = PGovernorRedeemer (Term s PInteger)
+  = PCreateProposal
+  | PMintGATs
+  | PMutateGovernor
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
+    , -- | @since 0.2.0
+      Enum
+    , -- | @since 0.2.0
+      Bounded
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      Generic
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
+    , -- | @since 0.2.0
+      PEq
     )
-    via (DerivePNewtype' PGovernorRedeemer)
+
+-- | @since 0.2.0
+instance PTryFrom PData (PAsData PGovernorRedeemer)
+
+-- | @since 0.2.0
+instance DerivePlutusType PGovernorRedeemer where
+  type DPTStrat _ = PlutusTypeEnumData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer
@@ -255,9 +263,9 @@ pisGovernorDatumValid = phoistAcyclic $
       foldr1
         (#&&)
         [ ptraceIfFalse "thresholds valid" $
-            pisProposalThresholdsValid # datumF.proposalThresholds
+            pisProposalThresholdsValid # pfromData datumF.proposalThresholds
         , ptraceIfFalse "timings valid" $
-            pisProposalTimingConfigValid # datumF.proposalTimings
+            pisProposalTimingConfigValid # pfromData datumF.proposalTimings
         , ptraceIfFalse "time range valid" $
             pisMaxTimeRangeWidthValid # datumF.createProposalTimeRangeMaxWidth
         ]

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,25 +35,16 @@ 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 Plutarch.Api.V1 (
   PAddress,
@@ -84,24 +56,11 @@ import Plutarch.Api.V1 (
   PTxOut,
   PValidator,
   PValidatorHash,
-  mintingPolicySymbol,
-  mkMintingPolicy,
-  mkValidator,
-  validatorHash,
  )
 import Plutarch.Api.V1.AssetClass (
   passetClass,
   passetClassValueOf,
  )
-import Plutarch.Extra.IsData (pmatchEnumFromData)
-import Plutarch.Extra.List (pfirstJust)
-import Plutarch.Extra.Map (
-  plookup,
-  plookup',
- )
-
---------------------------------------------------------------------------------
-
 import Plutarch.Api.V1.ScriptContext (
   pfindOutputsToAddress,
   pfindTxInByTxOutRef,
@@ -112,17 +71,16 @@ import Plutarch.Api.V1.ScriptContext (
  )
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
 import Plutarch.Extra.Field (pletAllC)
-import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pisDJust)
+import Plutarch.Extra.IsData (pmatchEnumFromData)
+import Plutarch.Extra.List (pfirstJust)
+import Plutarch.Extra.Map (
+  plookup,
+  plookup',
+ )
+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 (..),
- )
 
 --------------------------------------------------------------------------------
 
@@ -153,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 ""
@@ -177,12 +135,12 @@ governorPolicy gov =
           # "Governor output not found"
             #$ pfind
           # plam
-            ( \((pfield @"value" #) . pfromData -> value) ->
+            ( \((pfield @"value" #) -> value) ->
                 psymbolValueOf # ownSymbol # value #== 1
             )
           # pfromData txInfoF.outputs
 
-    let datumHash = pfield @"datumHash" # pfromData govOutput
+    let datumHash = pfield @"datumHash" # govOutput
         datum = mustFindDatum' @PGovernorDatum # datumHash # txInfoF.datums
 
     pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum
@@ -275,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'
 
@@ -292,7 +253,7 @@ governorValidator gov =
     ownInputF <- pletFieldsC @'["address", "value"] ownInput
     let ownAddress = pfromData $ ownInputF.address
 
-    (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFromC datum'
+    (oldGovernorDatum :: Term _ PGovernorDatum, _) <- ptryFromC datum'
     oldGovernorDatumF <- pletAllC oldGovernorDatum
 
     -- Check that GST will be returned to the governor.
@@ -314,9 +275,8 @@ governorValidator gov =
           passertPDJust # "Governor output doesn't have datum" # ownOutput.datumHash
     newGovernorDatum <-
       pletC $
-        pfromData $
+        passertPJust # "Ouput governor state datum not found"
-          passertPJust # "Ouput governor state datum not found"
+          #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums
-            #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums
 
     pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum
 
@@ -368,9 +328,9 @@ governorValidator gov =
           pguardC "Stake input doesn't have datum" $
             pisDJust # stakeInputF.datumHash
 
-          let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
+          let stakeInputDatum = mustFindDatum' @(PAsData PStakeDatum) # stakeInputF.datumHash # txInfoF.datums
 
-          stakeInputDatumF <- pletAllC stakeInputDatum
+          stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum
 
           pguardC "Proposals created by the stake must not exceed the number stored in the governor." $
             pnumCreatedProposals # stakeInputDatumF.lockedBy
@@ -400,14 +360,14 @@ governorValidator gov =
 
           proposalOutputDatum' <-
             pletC $
-              mustFindDatum' @PProposalDatum
+              mustFindDatum' @(PAsData PProposalDatum)
                 # outputDatumHash
                 # txInfoF.datums
 
-          proposalOutputDatum <- pletAllC proposalOutputDatum'
+          proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum'
 
           let expectedStartingTime =
-                createProposalStartingTime
+                pfromJust #$ createProposalStartingTime
                   # oldGovernorDatumF.createProposalTimeRangeMaxWidth
                   # txInfoF.validRange
 
@@ -462,7 +422,7 @@ governorValidator gov =
                   #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
 
               stakeOutputLocks =
-                pfromData $ pfield @"lockedBy" # stakeOutputDatum
+                pfromData $ pfield @"lockedBy" #$ pto $ pfromData stakeOutputDatum
 
               -- The stake should be locked by the newly created proposal.
               newLock =
@@ -493,29 +453,28 @@ governorValidator gov =
           proposalInputF <-
             pletFieldsC @'["datumHash"] $
               pfield @"resolved"
-                #$ pfromData
+                #$ passertPJust
-                $ passertPJust
+                # "Proposal input not found"
-                  # "Proposal input not found"
+                  #$ pfind
-                    #$ pfind
+                # plam
-                  # plam
+                  ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
-                    ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
+                      txOutF <- pletFieldsC @'["address", "value"] txOut
-                        txOutF <- pletFieldsC @'["address", "value"] txOut
 
-                        pure $
+                      pure $
-                          psymbolValueOf # ppstSymbol # txOutF.value #== 1
+                        psymbolValueOf # ppstSymbol # txOutF.value #== 1
-                            #&& txOutF.address #== pdata pproposalValidatorAddress
+                          #&& txOutF.address #== pdata pproposalValidatorAddress
-                    )
+                  )
-                  # pfromData txInfoF.inputs
+                # pfromData txInfoF.inputs
 
           proposalInputDatum <-
             pletC $
-              mustFindDatum' @PProposalDatum
+              mustFindDatum' @(PAsData PProposalDatum)
                 # proposalInputF.datumHash
                 # txInfoF.datums
 
           proposalInputDatumF <-
-            pletFieldsC @'["effects", "status", "thresholds", "votes"]
+            pletFieldsC @'["effects", "status", "thresholds", "votes"] $
-              proposalInputDatum
+              pto $ pfromData proposalInputDatum
 
           -- Check that the proposal state is advanced so that a proposal cannot be executed twice.
 
@@ -552,12 +511,12 @@ governorValidator gov =
           pguardC "Output GATs is more than minted GATs" $
             plength # outputsWithGAT #== gatCount
 
-          let gatOutputValidator' :: Term s (PMap _ PValidatorHash PDatumHash :--> PAsData PTxOut :--> PBool)
+          let gatOutputValidator' :: Term s (PMap _ PValidatorHash PDatumHash :--> PTxOut :--> PBool)
               gatOutputValidator' =
                 phoistAcyclic $
                   plam
-                    ( \effects (pfromData -> output') -> unTermCont $ do
+                    ( \effects output' -> unTermCont $ do
-                        output <- pletFieldsC @'["address", "datumHash"] $ output'
+                        output <- pletFieldsC @'["address", "datumHash"] output'
 
                         let scriptHash =
                               passertPJust # "GAT receiver is not a script"
@@ -608,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 $ 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 $ 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 $ 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 $ 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 $ proposalValidator params
-
-{- | Get the hash of 'Agora.Proposal.proposalValidator'.
-
-     @since 0.1.0
--}
-governorValidatorHash :: Governor -> ValidatorHash
-governorValidatorHash gov = validatorHash validator
-  where
-    validator = mkValidator $ 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 $ authorityTokenPolicy params
-    params = authorityTokenFromGovernor gov

agora/Agora/Plutarch/Orphans.hs

@@ -3,133 +3,37 @@
 {- FIXME: All of the following instances and
    types ought to belong in either plutarch or
    plutarch-extra.
-
-   A number of these have been "stolen" from Mango's
-   PR: https://github.com/Plutonomicon/plutarch/pull/438/
 -}
 
 module Agora.Plutarch.Orphans () where
 
-import Control.Arrow (first)
+import Plutarch.Api.V1 (PDatumHash (..))
-import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue)
+import Plutarch.Builtin (PIsData (..))
-import Plutarch.Builtin (PBuiltinMap)
-import Plutarch.DataRepr (PIsDataReprInstances (..))
 import Plutarch.Extra.TermCont (ptryFromC)
-import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
+import Plutarch.TryFrom (PTryFrom (..))
-import Plutarch.Reducible (Reduce, Reducible)
-import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
 import Plutarch.Unsafe (punsafeCoerce)
-import Prelude hiding ((+))
 
-instance Reducible (f x y) => Reducible (Flip f y x) where
+newtype Flip f a b = Flip (f b a) deriving stock (Generic)
-  type Reduce (Flip f y x) = Reduce (f x y)
-
-newtype Flip f a b = Flip (f b a)
-
--- | @since 0.1.0
-instance PTryFrom PData (PAsData b) => PTryFrom PData (PAsData (DerivePNewtype c b)) where
-  type
-    PTryFromExcess PData (PAsData (DerivePNewtype c b)) =
-      PTryFromExcess PData (PAsData b)
-  ptryFrom' d k =
-    ptryFrom' @_ @(PAsData b) d $ k . first punsafeCoerce
-
--- | @since 0.1.0
-instance PTryFrom PData (PAsData PPubKeyHash) where
-  type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
-  ptryFrom' opq = runTermCont $ do
-    (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
-      ptryFromC @(PAsData PByteString) opq
-    tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a PubKeyHash should be 28 bytes long")
-    pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
-
--- | @since 0.1.0
-instance AdditiveSemigroup (Term s PPOSIXTime) where
-  (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
-
--- | @since 0.1.0
-deriving via
-  PAsData (DerivePNewtype PPOSIXTime PInteger)
-  instance
-    PTryFrom PData (PAsData PPOSIXTime)
-
--- | @since 0.1.0
-deriving via
-  PAsData (PIsDataReprInstances PTxId)
-  instance
-    PTryFrom PData (PAsData PTxId)
-
--- | @since 0.1.0
-deriving via
-  PAsData (PIsDataReprInstances PTxOutRef)
-  instance
-    PTryFrom PData (PAsData PTxOutRef)
-
--- | @since 0.1.0
-deriving via
-  PAsData (DerivePNewtype (PMap g k v) (PBuiltinMap k v))
-  instance
-    ( PTryFrom PData (PAsData k)
-    , PTryFrom PData (PAsData v)
-    ) =>
-    PTryFrom PData (PAsData (PMap g k v))
-
--- | @since 0.1.0
-instance PTryFrom PData (PAsData PValidatorHash) where
-  type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
-  ptryFrom' opq = runTermCont $ do
-    (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
-      ptryFromC @(PAsData PByteString) opq
-    tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a ValidatorHash should be 28 bytes long")
-    pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
 
 -- | @since 0.1.0
 instance PTryFrom PData (PAsData PDatumHash) where
   type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
   ptryFrom' opq = runTermCont $ do
-    (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
+    (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq
-      tcont $ ptryFrom @(PAsData PByteString) opq
-    tcont $ \f -> pif (plengthBS # unwrapped #== 32) (f ()) (ptraceError "a DatumHash should be 32 bytes long")
-    pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
 
--- | @since 0.1.0
+    tcont $ \f ->
-deriving via
+      pif
-  PAsData (DerivePNewtype PCurrencySymbol PByteString)
+        -- Blake2b_256 hash: 256 bits/32 bytes.
-  instance
+        (plengthBS # unwrapped #== 32)
-    PTryFrom PData (PAsData PCurrencySymbol)
+        (f ())
+        (ptraceError "ptryFrom(PDatumHash): must be 32 bytes long")
 
--- | @since 0.1.0
+    pure (punsafeCoerce opq, pcon $ PDatumHash unwrapped)
-deriving via
-  PAsData (DerivePNewtype PTokenName PByteString)
-  instance
-    PTryFrom PData (PAsData PTokenName)
 
--- | @since 0.1.0
+-- | @since 0.2.0
-deriving via
+instance PTryFrom PData (PAsData PUnit)
-  PAsData (DerivePNewtype (PValue k v) (PMap k PCurrencySymbol (PMap k PTokenName PInteger)))
-  instance
-    PTryFrom PData (PAsData (PValue k v))
 
--- | @since 0.1.0
+-- | @since 0.2.0
-deriving via
+instance (PIsData a) => PIsData (PAsData a) where
-  PAsData (PIsDataReprInstances (PMaybeData a))
+  pfromDataImpl = punsafeCoerce
-  instance
+  pdataImpl = pdataImpl . pfromData
-    PTryFrom PData (PAsData a) => PTryFrom PData (PAsData (PMaybeData a))
-
--- | @since 0.1.0
-deriving via
-  PAsData (PIsDataReprInstances PAddress)
-  instance
-    PTryFrom PData (PAsData PAddress)
-
--- | @since 0.1.0
-deriving via
-  PAsData (PIsDataReprInstances PCredential)
-  instance
-    PTryFrom PData (PAsData PCredential)
-
--- | @since 0.1.0
-deriving via
-  PAsData (PIsDataReprInstances PStakingCredential)
-  instance
-    PTryFrom PData (PAsData PStakingCredential)

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 (..),
@@ -39,11 +40,11 @@ module Agora.Proposal (
   pisProposalThresholdsValid,
 ) where
 
+import Agora.Plutarch.Orphans ()
 import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
 import Agora.SafeMoney (GTTag)
 import Data.Tagged (Tagged)
-import GHC.Generics qualified as GHC
+import Generics.SOP qualified as SOP
-import Generics.SOP (Generic, I (I))
 import Plutarch.Api.V1 (
   KeyGuarantees (Unsorted),
   PDatumHash,
@@ -52,7 +53,7 @@ import Plutarch.Api.V1 (
   PValidatorHash,
  )
 import Plutarch.Api.V1.AssocMap qualified as PAssocMap
-import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
+import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields)
 import Plutarch.Extra.Comonad (pextract)
 import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.Function (pbuiltinUncurry)
@@ -60,13 +61,13 @@ import Plutarch.Extra.IsData (
   DerivePConstantViaDataList (..),
   DerivePConstantViaEnum (..),
   EnumIsData (..),
+  PlutusTypeEnumData,
   ProductIsData (ProductIsData),
  )
 import Plutarch.Extra.List (pfirstJust)
 import Plutarch.Extra.Map qualified as PM
 import Plutarch.Extra.Map.Unsorted qualified as PUM
 import Plutarch.Extra.Maybe (pfromJust)
-import Plutarch.Extra.Other (DerivePNewtype' (..))
 import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
 import Plutarch.Lift (
   DerivePConstantViaNewtype (..),
@@ -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
 
@@ -92,6 +92,14 @@ import PlutusTx.AssocMap qualified as AssocMap
      @since 0.1.0
 -}
 newtype ProposalId = ProposalId {proposalTag :: Integer}
+  deriving stock
+    ( -- | @since 0.1.0
+      Eq
+    , -- | @since 0.1.0
+      Show
+    , -- | @since 0.1.0
+      Generic
+    )
   deriving newtype
     ( -- | @since 0.1.0
       PlutusTx.ToData
@@ -100,14 +108,6 @@ newtype ProposalId = ProposalId {proposalTag :: Integer}
     , -- | @since 0.1.0
       PlutusTx.UnsafeFromData
     )
-  deriving stock
-    ( -- | @since 0.1.0
-      Eq
-    , -- | @since 0.1.0
-      Show
-    , -- | @since 0.1.0
-      GHC.Generic
-    )
 
 {- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this:
 
@@ -127,7 +127,7 @@ newtype ResultTag = ResultTag {getResultTag :: Integer}
     , -- | @since 0.1.0
       Ord
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
   deriving newtype
     ( -- | @since 0.1.0
@@ -186,7 +186,7 @@ data ProposalStatus
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     , -- | @since 0.2.0
       Enum
     , -- | @since 0.2.0
@@ -194,7 +194,7 @@ data ProposalStatus
     )
   deriving anyclass
     ( -- | @since 0.2.0
-      Generic
+      SOP.Generic
     )
   deriving
     ( -- | @since 0.1.0
@@ -230,9 +230,8 @@ data ProposalThresholds = ProposalThresholds
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
-  deriving anyclass (Generic)
 
 PlutusTx.makeIsDataIndexed 'ProposalThresholds [('ProposalThresholds, 0)]
 
@@ -252,19 +251,19 @@ PlutusTx.makeIsDataIndexed 'ProposalThresholds [('ProposalThresholds, 0)]
 newtype ProposalVotes = ProposalVotes
   { getProposalVotes :: AssocMap.Map ResultTag Integer
   }
-  deriving newtype
-    ( -- | @since 0.1.0
-      PlutusTx.ToData
-    , -- | @since 0.1.0
-      PlutusTx.FromData
-    )
   deriving stock
     ( -- | @since 0.1.0
       Eq
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
+    )
+  deriving newtype
+    ( -- | @since 0.1.0
+      PlutusTx.ToData
+    , -- | @since 0.1.0
+      PlutusTx.FromData
     )
 
 {- | Create a 'ProposalVotes' that has the same shape as the 'effects' field.
@@ -307,9 +306,12 @@ data ProposalDatum = ProposalDatum
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 0.2.0
+      SOP.Generic
     )
-  deriving anyclass (Generic)
   deriving
     ( -- | @since 0.1.0
       PlutusTx.ToData
@@ -367,7 +369,7 @@ data ProposalRedeemer
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
 
 -- | @since 0.1.0
@@ -379,25 +381,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
-      GHC.Generic
-    )
-
 --------------------------------------------------------------------------------
 -- Plutarch-land
 
@@ -406,19 +389,31 @@ data Proposal = Proposal
      @since 0.1.0
 -}
 newtype PResultTag (s :: S) = PResultTag (Term s PInteger)
-  deriving
+  deriving stock
-    ( -- | @since 0.1.0
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
+    ( -- @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     , -- | @since 0.1.0
       PEq
+    , -- | @since 0.2.0
+      PPartialOrd
     , -- | @since 0.1.0
       POrd
     , -- | @since 0.2.0
       PShow
     )
-    via (DerivePNewtype PResultTag PInteger)
+
+-- | @since 0.2.0
+instance DerivePlutusType PResultTag where
+  type DPTStrat _ = PlutusTypeNewtype
+
+-- | @since 0.1.0
+instance PTryFrom PData (PAsData PResultTag)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PResultTag where type PLifted PResultTag = ResultTag
@@ -429,36 +424,36 @@ deriving via
   instance
     (PConstantDecl ResultTag)
 
--- | @since 0.1.0
-deriving via
-  PAsData (DerivePNewtype PResultTag PInteger)
-  instance
-    PTryFrom PData (PAsData PResultTag)
-
 {- | Plutarch-level version of 'PProposalId'.
 
      @since 0.1.0
 -}
 newtype PProposalId (s :: S) = PProposalId (Term s PInteger)
-  deriving
+  deriving stock
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     , -- | @since 0.1.0
       PEq
+    , -- | @since 0.2.0
+      PPartialOrd
     , -- | @since 0.1.0
       POrd
     , -- | @since 0.2.0
       PShow
     )
-    via (DerivePNewtype PProposalId PInteger)
+
+-- | @since 0.2.0
+instance DerivePlutusType PProposalId where
+  type DPTStrat _ = PlutusTypeNewtype
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData (PAsData PProposalId)
-  PAsData (DerivePNewtype PProposalId PInteger)
-  instance
-    PTryFrom PData (PAsData PProposalId)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalId where type PLifted PProposalId = ProposalId
@@ -473,16 +468,24 @@ deriving via
 
      @since 0.1.0
 -}
-newtype PProposalStatus (s :: S) = PProposalStatus (Term s PInteger)
+data PProposalStatus (s :: S)
+  = -- | @since 0.2.0
+    PDraft
+  | -- | @since 0.2.0
+    PVoting
+  | -- | @since 0.2.0
+    PLocked
+  | -- | @since 0.2.0
+    PFinished
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
+    , -- | @since 0.2.0
+      Bounded
+    , -- | @since 0.2.0
+      Enum
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      Generic
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -490,13 +493,16 @@ newtype PProposalStatus (s :: S) = PProposalStatus (Term s PInteger)
     , -- | @since 0.1.0
       PEq
     )
-    via (DerivePNewtype' PProposalStatus)
+
+-- | @since 0.2.0
+instance DerivePlutusType PProposalStatus where
+  type DPTStrat _ = PlutusTypeEnumData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalStatus where type PLifted PProposalStatus = ProposalStatus
 
 -- | @since 0.1.0
-deriving via PAsData (DerivePNewtype' PProposalStatus) instance PTryFrom PData (PAsData PProposalStatus)
+instance PTryFrom PData (PAsData PProposalStatus)
 
 -- | @since 0.1.0
 deriving via (DerivePConstantViaEnum ProposalStatus PProposalStatus) instance (PConstantDecl ProposalStatus)
@@ -517,18 +523,10 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
         )
   }
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -536,13 +534,13 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
     , -- | @since 0.1.0
       PDataFields
     )
-    via (PIsDataReprInstances PProposalThresholds)
+
+-- | @since 0.2.0
+instance DerivePlutusType PProposalThresholds where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData PProposalThresholds
-  PAsData (PIsDataReprInstances PProposalThresholds)
-  instance
-    PTryFrom PData (PAsData PProposalThresholds)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
@@ -559,19 +557,23 @@ deriving via
 -}
 newtype PProposalVotes (s :: S)
   = PProposalVotes (Term s (PMap 'Unsorted PResultTag PInteger))
-  deriving
+  deriving stock
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     )
-    via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
+
+-- | @since 0.2.0
+instance DerivePlutusType PProposalVotes where
+  type DPTStrat _ = PlutusTypeNewtype
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData (PAsData PProposalVotes)
-  PAsData (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
-  instance
-    PTryFrom PData (PAsData PProposalVotes)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalVotes where type PLifted PProposalVotes = ProposalVotes
@@ -603,31 +605,23 @@ newtype PProposalDatum (s :: S) = PProposalDatum
         )
   }
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
-    , -- | @since 0.1.0
-      PDataFields
     , -- | @since 0.1.0
       PEq
     )
-    via (DerivePNewtype' PProposalDatum)
 
--- | @since 0.1.0
+-- | @since 0.2.0
-deriving via PAsData (DerivePNewtype' PProposalDatum) instance PTryFrom PData (PAsData PProposalDatum)
+instance DerivePlutusType PProposalDatum where
+  type DPTStrat _ = PlutusTypeNewtype
+
+instance PTryFrom PData (PAsData PProposalDatum)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalDatum where type PLifted PProposalDatum = ProposalDatum
@@ -645,30 +639,22 @@ data PProposalRedeemer (s :: S)
   | PUnlock (Term s (PDataRecord '[]))
   | PAdvanceProposal (Term s (PDataRecord '[]))
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     )
-    via PIsDataReprInstances PProposalRedeemer
+
+-- | @since 0.2.0
+instance DerivePlutusType PProposalRedeemer where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData PProposalRedeemer
-  PAsData (PIsDataReprInstances PProposalRedeemer)
-  instance
-    PTryFrom PData (PAsData PProposalRedeemer)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalRedeemer where type PLifted PProposalRedeemer = ProposalRedeemer

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'
@@ -174,12 +178,10 @@ proposalValidator proposal =
     PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef # txInfoF.inputs
     txOutF <- pletFieldsC @'["address", "value"] $ txOut
 
-    (pfromData -> proposalDatum, _) <-
+    proposalDatum <- pfromData . fst <$> ptryFromC @(PAsData PProposalDatum) datum
-      ptryFromC @(PAsData PProposalDatum) datum
+    proposalRedeemer <- fst <$> ptryFromC @PProposalRedeemer redeemer
-    (pfromData -> proposalRedeemer, _) <-
-      ptryFromC @(PAsData PProposalRedeemer) redeemer
 
-    proposalF <- pletAllC proposalDatum
+    proposalF <- pletAllC $ pto proposalDatum
 
     ownAddress <- pletC $ txOutF.address
 
@@ -187,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
 
@@ -211,11 +212,12 @@ proposalValidator proposal =
                 -- TODO: this is highly inefficient: O(n) for every output,
                 --       Maybe we can cache the sorted datum map?
                 let datum =
-                      mustFindDatum' @PProposalDatum
+                      pfromData $
-                        # inputF.datumHash
+                        mustFindDatum' @(PAsData PProposalDatum)
-                        # txInfoF.datums
+                          # inputF.datumHash
+                          # txInfoF.datums
 
-                    proposalId = pfield @"proposalId" # datum
+                    proposalId = pfield @"proposalId" # pto datum
 
                 pure $
                   inputF.address #== ownAddress
@@ -226,21 +228,20 @@ proposalValidator proposal =
 
     proposalOut <-
       pletC $
-        mustFindDatum' @PProposalDatum
+        pfromData $
-          # (pfield @"datumHash" # ownOutput)
+          mustFindDatum' @(PAsData PProposalDatum)
-          # txInfoF.datums
+            # (pfield @"datumHash" # ownOutput)
+            # txInfoF.datums
 
     proposalUnchanged <- pletC $ proposalOut #== proposalDatum
 
     proposalOutStatus <-
       pletC $
         pfromData $
-          pfield @"status" # proposalOut
+          pfield @"status" # pto proposalOut
 
     onlyStatusChanged <-
       pletC $
-        -- Only the status of proposals is updated.
-
         -- Only the status of proposals is updated.
         proposalOut
           #== mkRecordConstr
@@ -259,13 +260,13 @@ 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
 
-    filterStakeDatumHash :: Term _ (PAsData PTxOut :--> PMaybe (PAsData PDatumHash)) <-
+    filterStakeDatumHash :: Term _ (PTxOut :--> PMaybe (PAsData PDatumHash)) <-
       pletC $
-        plam $ \(pfromData -> txOut) -> unTermCont $ do
+        plam $ \txOut -> unTermCont $ do
           txOutF <- pletFieldsC @'["value", "datumHash"] txOut
           pure $
             pif
@@ -333,12 +334,11 @@ proposalValidator proposal =
                       let stake =
                             pfromData $
                               pfromJust
-                                #$ ptryFindDatum
+                                #$ ptryFindDatum @(PAsData PStakeDatum)
-                                  @(PAsData PStakeDatum)
                                 # pfromData dh
                                 # txInfoF.datums
 
-                      stakeF <- pletFieldsC @'["stakedAmount", "owner"] stake
+                      stakeF <- pletFieldsC @'["stakedAmount", "owner"] $ pto stake
 
                       PPair amount owners <- pmatchC l
 
@@ -369,14 +369,10 @@ proposalValidator proposal =
         stakeOutputHash <- pletC $ pfromData $ phead # stakeOutputDatumHashes
 
         stakeIn :: Term _ PStakeDatum <-
-          pletC $
+          pletC $ pfromData $ pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
-            pfromData $
-              pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
 
         stakeOut :: Term _ PStakeDatum <-
-          pletC $
+          pletC $ pfromData $ pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
-            pfromData $
-              pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
 
         stakeUnchanged <- pletC $ stakeInputHash #== stakeOutputHash
 
@@ -391,7 +387,7 @@ proposalValidator proposal =
 
         withSingleStake val =
           withSingleStake' #$ plam $ \stakeIn stakeOut stakeUnchange -> unTermCont $ do
-            stakeInF <- pletAllC stakeIn
+            stakeInF <- pletAllC $ pto stakeIn
 
             val stakeInF stakeOut stakeUnchange
 
@@ -414,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
@@ -449,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).
@@ -581,7 +578,7 @@ proposalValidator proposal =
                 $ ptraceIfFalse "Proposal unchanged" proposalUnchanged
 
             -- At last, we ensure that all locks belong to this proposal will be removed.
-            stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
+            stakeOutputLocks <- pletC $ pfield @"lockedBy" # pto stakeOut
 
             let templateStakeOut =
                   mkRecordConstr
@@ -603,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
@@ -629,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
 
@@ -652,23 +650,19 @@ 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 $
                       pany
                         # plam
                           ( \( (pfield @"value" #)
-                                . (pfield @"resolved" #)
+                                . (pfield @"resolved" #) ->
-                                . pfromData ->
                                 value
                               ) ->
                                 psymbolValueOf # gstSymbol # value #== 1
                           )
-                        # txInfoF.inputs
+                        # pfromData txInfoF.inputs
 
                   let toFailedState = unTermCont $ do
                         pguardC "Proposal should fail: not on time" $

agora/Agora/Proposal/Time.hs

@@ -30,9 +30,7 @@ module Agora.Proposal.Time (
   pisMaxTimeRangeWidthValid,
 ) where
 
-import Agora.Plutarch.Orphans ()
+import Control.Composition ((.*))
-import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, HasDatatypeInfo, I (I))
 import Plutarch.Api.V1 (
   PExtended (PFinite),
   PInterval (PInterval),
@@ -44,19 +42,19 @@ import Plutarch.Api.V1 (
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
-  PIsDataReprInstances (..),
  )
-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 Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
+import PlutusLedgerApi.V1 (POSIXTime)
-import PlutusLedgerApi.V1.Time (POSIXTime)
 import PlutusTx qualified
-import Prelude hiding ((+))
+import Prelude
 
 --------------------------------------------------------------------------------
 
@@ -67,8 +65,22 @@ import Prelude hiding ((+))
 newtype ProposalStartingTime = ProposalStartingTime
   { getProposalStartingTime :: POSIXTime
   }
-  deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
+  deriving stock
-  deriving stock (Eq, Show, GHC.Generic)
+    ( -- | @since 0.1.0
+      Eq
+    , -- | @since 0.1.0
+      Show
+    , -- | @since 0.1.0
+      Generic
+    )
+  deriving newtype
+    ( -- | @since 0.1.0
+      PlutusTx.ToData
+    , -- | @since 0.1.0
+      PlutusTx.FromData
+    , -- | @since 0.1.0
+      PlutusTx.UnsafeFromData
+    )
 
 {- | Configuration of proposal timings.
 
@@ -92,9 +104,8 @@ data ProposalTimingConfig = ProposalTimingConfig
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
-  deriving anyclass (Generic)
 
 PlutusTx.makeIsDataIndexed 'ProposalTimingConfig [('ProposalTimingConfig, 0)]
 
@@ -108,7 +119,7 @@ newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
     , -- | @since 0.1.0
       Ord
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
   deriving newtype
     ( -- | @since 0.1.0
@@ -154,41 +165,41 @@ data PProposalTime (s :: S) = PProposalTime
   }
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
     )
   deriving anyclass
     ( -- | @since 0.1.0
-      Generic
-    , -- | @since 0.1.0
       PlutusType
-    , -- | @since 0.1.0
-      HasDatatypeInfo
     , -- | @since 0.1.0
       PEq
     )
 
+instance DerivePlutusType PProposalTime where
+  type DPTStrat _ = PlutusTypeScott
+
 -- | Plutarch-level version of 'ProposalStartingTime'.
 newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
-  deriving
+  deriving stock
+    ( -- | @since 0.1.0
+      Generic
+    )
+  deriving anyclass
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     , -- | @since 0.1.0
       PEq
-    , -- | @since 0.1.0
-      POrd
     )
-    via (DerivePNewtype PProposalStartingTime PPOSIXTime)
+
+instance DerivePlutusType PProposalStartingTime where
+  type DPTStrat _ = PlutusTypeNewtype
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalStartingTime where
   type PLifted PProposalStartingTime = ProposalStartingTime
 
-deriving via
+instance PTryFrom PData (PAsData PProposalStartingTime)
-  PAsData (DerivePNewtype PProposalStartingTime PPOSIXTime)
-  instance
-    PTryFrom PData (PAsData PProposalStartingTime)
 
 -- | @since 0.1.0
 deriving via
@@ -213,18 +224,10 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
         )
   }
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -232,10 +235,12 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
     , -- | @since 0.1.0
       PDataFields
     )
-    via (PIsDataReprInstances PProposalTimingConfig)
+
+instance DerivePlutusType PProposalTimingConfig where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
-deriving via PAsData (PIsDataReprInstances PProposalTimingConfig) instance PTryFrom PData (PAsData PProposalTimingConfig)
+instance PTryFrom PData PProposalTimingConfig
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PProposalTimingConfig where
@@ -250,20 +255,28 @@ deriving via
 -- | Plutarch-level version of 'MaxTimeRangeWidth'.
 newtype PMaxTimeRangeWidth (s :: S)
   = PMaxTimeRangeWidth (Term s PPOSIXTime)
-  deriving
+  deriving stock
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     , -- | @since 0.1.0
       PEq
+    , -- | @since 0.2.0
+      PPartialOrd
     , -- | @since 0.1.0
       POrd
     )
-    via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime)
+
+instance DerivePlutusType PMaxTimeRangeWidth where
+  type DPTStrat _ = PlutusTypeNewtype
 
 -- | @since 0.1.0
-deriving via PAsData (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime) instance PTryFrom PData (PAsData PMaxTimeRangeWidth)
+instance PTryFrom PData (PAsData PMaxTimeRangeWidth)
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth
@@ -319,23 +332,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.
 
@@ -344,33 +367,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
@@ -31,20 +30,16 @@ module Agora.Stake (
   pisIrrelevant,
 ) where
 
-import Agora.Plutarch.Orphans ()
 import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
 import Agora.SafeMoney (GTTag)
 import Data.Tagged (Tagged (..))
-import GHC.Generics qualified as GHC
+import Generics.SOP qualified as SOP
-import Generics.SOP (Generic, HasDatatypeInfo, I (I))
 import Plutarch.Api.V1 (
   PMaybeData,
   PPubKeyHash,
  )
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
-  PDataFields,
-  PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Extra.Field (pletAll)
 import Plutarch.Extra.IsData (
@@ -52,33 +47,17 @@ import Plutarch.Extra.IsData (
   ProductIsData (ProductIsData),
  )
 import Plutarch.Extra.List (pnotNull)
-import Plutarch.Extra.Other (DerivePNewtype' (..))
 import Plutarch.Extra.Sum (PSum (..))
 import Plutarch.Extra.Traversable (pfoldMap)
 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
-      GHC.Generic
-    )
-
 {- | Locks that are stored in the stake datums for various purposes.
 
      NOTE: Due to retracting votes always being possible,
@@ -133,10 +112,6 @@ data ProposalLock
     ( -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.1.0
       Generic
     )
 
@@ -176,7 +151,12 @@ data StakeRedeemer
     DelegateTo PubKeyHash
   | -- | Revoke the existing delegation.
     ClearDelegate
-  deriving stock (Show, GHC.Generic)
+  deriving stock
+    ( -- | @since 0.1.0
+      Show
+    , -- | @since 0.1.0
+      Generic
+    )
 
 PlutusTx.makeIsDataIndexed
   ''StakeRedeemer
@@ -208,8 +188,16 @@ data StakeDatum = StakeDatum
   -- ^ The current proposals locking this stake. This field must be empty
   --   for the stake to be usable for deposits and withdrawals.
   }
-  deriving stock (Show, GHC.Generic)
+  deriving stock
-  deriving anyclass (Generic)
+    ( -- | @since 0.1.0
+      Show
+    , -- | @since 0.1.0
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 0.1.0
+      SOP.Generic
+    )
   deriving
     ( -- | @since 0.1.0
       PlutusTx.ToData
@@ -231,34 +219,26 @@ newtype PStakeDatum (s :: S) = PStakeDatum
         ( PDataRecord
             '[ "stakedAmount" ':= PDiscrete GTTag
              , "owner" ':= PPubKeyHash
-             , "delegatedTo" ':= PMaybeData PPubKeyHash
+             , "delegatedTo" ':= PMaybeData (PAsData PPubKeyHash)
              , "lockedBy" ':= PBuiltinList (PAsData PProposalLock)
              ]
         )
   }
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
-    , -- | @since 0.1.0
-      PDataFields
     , -- | @since 0.1.0
       PEq
     )
-    via (DerivePNewtype' PStakeDatum)
+
+instance DerivePlutusType PStakeDatum where
+  type DPTStrat _ = PlutusTypeNewtype
 
 -- | @since 0.1.0
 instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where
@@ -271,10 +251,7 @@ deriving via
     (Plutarch.Lift.PConstantDecl StakeDatum)
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData (PAsData PStakeDatum)
-  PAsData (DerivePNewtype' PStakeDatum)
-  instance
-    PTryFrom PData (PAsData PStakeDatum)
 
 {- | Plutarch-level redeemer for Stake scripts.
 
@@ -291,30 +268,23 @@ data PStakeRedeemer (s :: S)
   | PDelegateTo (Term s (PDataRecord '["pkh" ':= PPubKeyHash]))
   | PClearDelegate (Term s (PDataRecord '[]))
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
     )
   deriving anyclass
     ( -- | @since 0.1.0
-      PIsDataRepr
+      SOP.Generic
-    )
+    , -- | @since 0.1.0
-  deriving
-    ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     )
-    via PIsDataReprInstances PStakeRedeemer
+
+instance DerivePlutusType PStakeRedeemer where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData PStakeRedeemer
-  PAsData (PIsDataReprInstances PStakeRedeemer)
-  instance
-    PTryFrom PData (PAsData PStakeRedeemer)
 
 -- | @since 0.1.0
 instance Plutarch.Lift.PUnsafeLiftDecl PStakeRedeemer where
@@ -331,7 +301,13 @@ deriving via
      @since 0.2.0
 -}
 data PProposalLock (s :: S)
-  = PCreated (Term s (PDataRecord '["created" ':= PProposalId]))
+  = PCreated
+      ( Term
+          s
+          ( PDataRecord
+              '["created" ':= PProposalId]
+          )
+      )
   | PVoted
       ( Term
           s
@@ -342,20 +318,10 @@ data PProposalLock (s :: S)
           )
       )
   deriving stock
-    ( -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
     ( -- | @since 0.1.0
       Generic
-    , -- | @since 0.1.0
-      HasDatatypeInfo
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      PIsDataRepr
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
@@ -363,13 +329,15 @@ data PProposalLock (s :: S)
     , -- | @since 0.1.0
       PEq
     )
-    via (PIsDataReprInstances PProposalLock)
+
+instance DerivePlutusType PProposalLock where
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 0.1.0
-deriving via
+instance PTryFrom PData PProposalLock
-  PAsData (PIsDataReprInstances PProposalLock)
+
-  instance
+-- | @since 0.2.0
-    PTryFrom PData (PAsData PProposalLock)
+instance PTryFrom PData (PAsData PProposalLock)
 
 -- | @since 0.1.0
 instance Plutarch.Lift.PUnsafeLiftDecl PProposalLock where
@@ -399,9 +367,7 @@ instance PShow PProposalLock where
 pstakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool)
 pstakeLocked = phoistAcyclic $
   plam $ \stakeDatum ->
-    let locks :: Term _ (PBuiltinList (PAsData PProposalLock))
+    pnotNull #$ pfield @"lockedBy" @(PBuiltinList _) # pto stakeDatum
-        locks = pfield @"lockedBy" # stakeDatum
-     in pnotNull # locks
 
 {- | Get the number of *alive* proposals that were created by the given stake.
 
@@ -439,19 +405,18 @@ data PStakeRole (s :: S)
     PIrrelevant
   deriving stock
     ( -- | @since 0.2.0
-      GHC.Generic
+      Generic
     )
   deriving anyclass
     ( -- | @since 0.2.0
-      Generic
-    , -- | @since 0.2.0
       PlutusType
-    , -- | @since 0.2.0
-      HasDatatypeInfo
     , -- | @since 0.2.0
       PEq
     )
 
+instance DerivePlutusType PStakeRole where
+  type DPTStrat _ = PlutusTypeScott
+
 {- | Retutn true if the stake was used to voted on the proposal.
 
      @since 0.2.0

agora/Agora/Stake/Scripts.hs

@@ -8,19 +8,15 @@ 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,
-  pmaybeData,
-  pvalidatorHashToTokenName,
  )
 import Data.Function (on)
 import Data.Tagged (Tagged (..), untag)
@@ -35,23 +31,21 @@ 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',
   pvalueDiscrete',
  )
+import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
 import Prelude hiding (Num (..))
 
@@ -106,7 +100,11 @@ stakePolicy gtClassRef =
                     pure $
                       pif
                         (psymbolValueOf # ownSymbol # txOutF.value #== 1)
-                        ( let datum = mustFindDatum' @PStakeDatum # txOutF.datumHash # txInfoF.datums
+                        ( let datum =
+                                pfromData $
+                                  mustFindDatum' @(PAsData PStakeDatum)
+                                    # txOutF.datumHash
+                                    # txInfoF.datums
                            in pnot # (pstakeLocked # datum)
                         )
                         (pconstant False)
@@ -137,7 +135,7 @@ stakePolicy gtClassRef =
                                 PPubKeyCredential _ -> pcon PFalse
                                 PScriptCredential ((pfield @"_0" #) -> validatorHash) ->
                                   let tn :: Term _ PTokenName
-                                      tn = pvalidatorHashToTokenName validatorHash
+                                      tn = punsafeCoerce $ pfromData validatorHash
                                    in pvalueOf # outputF.value # ownSymbol # tn #== 1
                         )
                       # pfromData txInfoF.outputs
@@ -146,7 +144,9 @@ stakePolicy gtClassRef =
                 pletFieldsC @'["value", "address", "datumHash"] scriptOutputWithStakeST
               datumF <-
                 pletFieldsC @'["owner", "stakedAmount"] $
-                  mustFindDatum' @PStakeDatum # outputF.datumHash # txInfoF.datums
+                  pto $
+                    pfromData $
+                      mustFindDatum' @(PAsData PStakeDatum) # outputF.datumHash # txInfoF.datums
 
               let hasExpectedStake =
                     ptraceIfFalse "Stake ouput has expected amount of stake token" $
@@ -217,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
@@ -232,12 +237,10 @@ stakeValidator stake =
           ]
         txInfo
 
-    (pfromData -> stakeRedeemer, _) <- ptryFromC redeemer
+    stakeRedeemer <- fst <$> ptryFromC redeemer
 
-    -- TODO: Use PTryFrom
+    stakeDatum' <- pfromData . fst <$> ptryFromC datum
-    let stakeDatum' :: Term _ PStakeDatum
+    stakeDatum <- pletAllC $ pto stakeDatum'
-        stakeDatum' = pfromData $ punsafeCoerce datum
-    stakeDatum <- pletAllC stakeDatum'
 
     PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
 
@@ -252,17 +255,14 @@ stakeValidator stake =
     signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
 
     ownerSignsTransaction <- pletC $ signedBy # stakeDatum.owner
+
     delegateSignsTransaction <-
       pletC $
         pmaybeData # pconstant False
-          # plam ((signedBy #) . pdata)
+          # signedBy
           # stakeDatum.delegatedTo
 
-    stCurrencySymbol <-
+    stCurrencySymbol <- pletC $ pconstant $ stakeSTSymbol as
-      pletC $
-        pconstant $
-          mintingPolicySymbol $
-            mkMintingPolicy (stakePolicy stake.gtClassRef)
     mintedST <- pletC $ psymbolValueOf # stCurrencySymbol # txInfoF.mint
     valueSpent <- pletC $ pvalueSpent # txInfoF.inputs
     spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
@@ -288,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
 
@@ -340,10 +340,10 @@ stakeValidator stake =
                           )
                         # pfromData txInfoF.inputs
 
-                    sortTxOuts :: Term _ (PBuiltinList (PAsData PTxOut) :--> PBuiltinList (PAsData PTxOut))
+                    sortTxOuts :: Term _ (PBuiltinList PTxOut :--> PBuiltinList PTxOut)
                     sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #)
                       where
-                        getDatumHash :: Term _ (PAsData PTxOut :--> PDatumHash)
+                        getDatumHash :: Term _ (PTxOut :--> PDatumHash)
                         getDatumHash = phoistAcyclic $ plam ((pfromDJust #) . pfromData . (pfield @"datumHash" #))
 
                     sortedOwnInputs = sortTxOuts # ownInputs
@@ -360,13 +360,14 @@ stakeValidator stake =
                 pguardC "ST at inputs must be 1" $
                   spentST #== 1
 
-                ownOutput <- pletC $ pfromData $ phead # ownOutputs
+                ownOutput <- pletC $ phead # ownOutputs
 
                 stakeOut <-
                   pletC $
-                    mustFindDatum' @PStakeDatum
+                    pfromData $
-                      # (pfield @"datumHash" # ownOutput)
+                      mustFindDatum' @(PAsData PStakeDatum)
-                      # txInfoF.datums
+                        # (pfield @"datumHash" # ownOutput)
+                        # txInfoF.datums
 
                 ownOutputValue <-
                   pletC $
@@ -384,7 +385,7 @@ stakeValidator stake =
                             ( #stakedAmount .= stakeDatum.stakedAmount
                                 .& #owner .= stakeDatum.owner
                                 .& #delegatedTo .= stakeDatum.delegatedTo
-                                .& #lockedBy .= pfield @"lockedBy" # stakeOut
+                                .& #lockedBy .= pfield @"lockedBy" # pto stakeOut
                             )
                      in stakeOut #== templateStakeDatum
 
@@ -489,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
@@ -500,7 +501,7 @@ stakeValidator stake =
                                   [ pgeqByClass' (AssetClass ("", ""))
                                       # ownOutputValue
                                       # expectedValue
-                                  , pgeqByClass' (untag stake.gtClassRef)
+                                  , pgeqByClass' (untag gtClassRef)
                                       # ownOutputValue
                                       # expectedValue
                                   , pgeqBySymbol
@@ -524,7 +525,7 @@ stakeValidator stake =
                       pguardC "Cannot delegate to the owner" $
                         pnot #$ stakeDatum.owner #== pkh
 
-                      pure $ setDelegate #$ pdjust # pkh
+                      pure $ setDelegate #$ pdjust # pdata pkh
                     ------------------------------------------------------------
 
                     PClearDelegate _ ->

agora/Agora/Treasury.hs

@@ -11,14 +11,16 @@ treasury.
 module Agora.Treasury (module Agora.Treasury) where
 
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import GHC.Generics qualified as GHC
+import Generics.SOP qualified as SOP
-import Generics.SOP (Generic)
 import Plutarch.Api.V1 (PValidator)
 import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting))
 import "plutarch" Plutarch.Api.V1.Value (PValue)
 import Plutarch.Builtin (pforgetData)
-import Plutarch.Extra.IsData (DerivePConstantViaEnum (..), EnumIsData (..))
+import Plutarch.Extra.IsData (
-import Plutarch.Extra.Other (DerivePNewtype' (..))
+  DerivePConstantViaEnum (..),
+  EnumIsData (..),
+  PlutusTypeEnumData,
+ )
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC)
 import Plutarch.Lift (PConstantDecl (..), PLifted (..), PUnsafeLiftDecl)
 import Plutarch.TryFrom ()
@@ -38,7 +40,7 @@ data TreasuryRedeemer
     , -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
-      GHC.Generic
+      Generic
     , -- | @since 0.2.0
       Enum
     , -- | @since 0.2.0
@@ -46,7 +48,7 @@ data TreasuryRedeemer
     )
   deriving anyclass
     ( -- | @since 0.2.0
-      Generic
+      SOP.Generic
     )
   deriving
     ( -- | @since 0.1.0
@@ -63,23 +65,25 @@ data TreasuryRedeemer
 
      @since 0.1.0
 -}
-newtype PTreasuryRedeemer (s :: S)
+data PTreasuryRedeemer (s :: S)
-  = PTreasuryRedeemer (Term s PInteger)
+  = PSpendTreasuryGAT
   deriving stock
     ( -- | @since 0.1.0
-      GHC.Generic
+      Generic
+    , -- | @since 0.2.0
+      Bounded
+    , -- | @since 0.2.0
+      Enum
     )
   deriving anyclass
-    ( -- | @since 0.1.0
-      Generic
-    )
-  deriving
     ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
       PIsData
     )
-    via (DerivePNewtype' PTreasuryRedeemer)
+
+instance DerivePlutusType PTreasuryRedeemer where
+  type DPTStrat _ = PlutusTypeEnumData
 
 -- | @since 0.1.0
 instance PUnsafeLiftDecl PTreasuryRedeemer where

agora/Agora/Utils.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE QuantifiedConstraints #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {- |
 Module     : Agora.Utils
@@ -8,56 +9,32 @@ 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 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 (..),
  )
 
@@ -65,60 +42,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.
 
@@ -127,39 +50,13 @@ findTxOutDatum = phoistAcyclic $
 validatorHashToTokenName :: ValidatorHash -> TokenName
 validatorHashToTokenName (ValidatorHash hash) = TokenName hash
 
-{- | Plutarch level 'validatorHashToTokenName'.
-
-     @since 0.1.0
--}
-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 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
 -}
 mustFindDatum' ::
   forall (datum :: PType).
-  (PIsData datum, PTryFrom PData (PAsData datum)) =>
+  (PIsData datum, PTryFrom PData datum) =>
   forall s.
   Term
     s
@@ -169,32 +66,10 @@ 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 $ pfromData d
+    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'.
 
@@ -215,19 +90,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
@@ -245,53 +107,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

cabal.project

@@ -3,7 +3,4 @@ packages: ./.
 benchmarks: true
 tests: true
 
-package plutarch
+test-show-details: direct
-  flags: +development
-
-test-show-details: direct

flake.nix

@@ -1,263 +1,109 @@
 {
   description = "agora";
 
-  inputs.nixpkgs.follows = "plutarch/nixpkgs";
+  inputs = {
-  inputs.haskell-nix.follows = "plutarch/haskell-nix";
+    nixpkgs.follows = "plutarch/nixpkgs";
-  inputs.nixpkgs-latest.url = "github:NixOS/nixpkgs?rev=a0a69be4b5ee63f1b5e75887a406e9194012b492";
+    nixpkgs-latest.url = "github:NixOS/nixpkgs?rev=cf63df0364f67848083ff75bc8ac9b7ca7aa5a01";
-  # temporary fix for nix versions that have the transitive follows bug
+    # temporary fix for nix versions that have the transitive follows bug
-  # see https://github.com/NixOS/nix/issues/6013
+    # see https://github.com/NixOS/nix/issues/6013
-  inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; };
+    nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; };
 
-  # Plutarch and its friends
+    haskell-nix-extra-hackage.follows = "plutarch/haskell-nix-extra-hackage";
-  inputs.plutarch.url =
+    haskell-nix.follows = "plutarch/haskell-nix";
-    "github:liqwid-labs/plutarch?rev=e7ef565645146e26e75ec29fe97122a74e52c6b7";
+    iohk-nix.follows = "plutarch/iohk-nix";
-  inputs.plutarch.inputs.emanote.follows =
+    haskell-language-server.follows = "plutarch/haskell-language-server";
-    "plutarch/haskell-nix/nixpkgs-unstable";
-  inputs.plutarch.inputs.nixpkgs.follows =
-    "plutarch/haskell-nix/nixpkgs-unstable";
 
-  inputs.liqwid-plutarch-extra.url =
+    # Plutarch and its friends
-    "github:Liqwid-Labs/liqwid-plutarch-extra?ref=seungheonoh/agoraUtils";
+    plutarch = {
-  inputs.plutarch-numeric.url =
+      url = "github:Plutonomicon/plutarch-plutus?ref=staging";
-    "github:Liqwid-Labs/plutarch-numeric?ref=main";
-  inputs.plutarch-safe-money.url =
-    "github:Liqwid-Labs/plutarch-safe-money?rev=9f968b80189c7e4b335527cd5b103dc26952f667";
 
-  inputs.plutarch-script-export.url =
+      inputs.emanote.follows =
-    "github:Liqwid-Labs/plutarch-script-export?ref=main";
+        "plutarch/haskell-nix/nixpkgs-unstable";
+      inputs.nixpkgs.follows =
+        "plutarch/haskell-nix/nixpkgs-unstable";
+    };
 
-  # Testing
+    plutarch-numeric.url =
-  inputs.plutarch-quickcheck.url =
+      "github:Liqwid-Labs/plutarch-numeric?ref=main";
-    "github:liqwid-labs/plutarch-quickcheck?ref=staging";
+    plutarch-safe-money.url =
+      "github:Liqwid-Labs/plutarch-safe-money?ref=main";
+    liqwid-plutarch-extra.url =
+      "github:Liqwid-Labs/liqwid-plutarch-extra?ref=plutus-v1";
+    plutarch-quickcheck.url =
+      "github:liqwid-labs/plutarch-quickcheck?ref=staging";
+    plutarch-context-builder.url =
+      "github:Liqwid-Labs/plutarch-context-builder?ref=plutus-v1";
+    plutarch-script-export.url =
+      "github:Liqwid-Labs/plutarch-script-export?ref=main";
 
-  # PCB Rev is locked until Agora test have explicit Minting CS. Check PCB PR #12
+    liqwid-nix.url = "github:Liqwid-Labs/liqwid-nix?ref=main";
-  inputs.plutarch-context-builder.url =
+  };
-    "github:Liqwid-Labs/plutarch-context-builder?ref=2a2ca72ff310788e531cbbe379ef7b0c4cb42dc9";
 
-  outputs = inputs@{ self, nixpkgs, nixpkgs-latest, haskell-nix, plutarch, ... }:
+  outputs = inputs@{ liqwid-nix, ... }:
     let
-      supportedSystems = nixpkgs-latest.lib.systems.flakeExposed;
+      benchCheckOverlay = self: super: {
-
+        toFlake =
-      perSystem = nixpkgs.lib.genAttrs supportedSystems;
+          let
-
+            inherit (self) inputs perSystem pkgsFor';
-      pkgsFor = system: import nixpkgs {
+            flake = super.toFlake or { };
-        inherit system;
+            name = "benchCheck";
-        overlays = [ haskell-nix.overlay (import "${plutarch.inputs.iohk-nix}/overlays/crypto") ];
+          in
-        # This only does bad things for us...
+          flake // {
-        # inherit (haskell-nix) config;
+            checks = perSystem (system:
-      };
+              flake.checks.${system} // {
-      pkgsFor' = system: import nixpkgs-latest { inherit system; };
+                ${name} =
-
+                  let
-      fourmoluFor = system: (pkgsFor' system).haskell.packages.ghc922.fourmolu_0_6_0_0;
+                    pkgs' = pkgsFor' system;
-
+                    bench = flake.packages.${system}."agora:bench:agora-bench";
-      defaultGhcVersion = "ghc923";
+                  in
-
+                  pkgs'.runCommand name
-      nonReinstallablePkgs = [
+                    {
-        "array"
+                      nativeBuildInputs = [ pkgs'.diffutils ];
-        "array"
+                    } ''
-        "base"
+                    export LC_CTYPE=C.UTF-8
-        "binary"
+                    export LC_ALL=C.UTF-8
-        "bytestring"
+                    export LANG=C.UTF-8
-        "Cabal"
+                    cd ${inputs.self}
-        "containers"
+                    ${bench}/bin/agora-bench | diff bench.csv - \
-        "deepseq"
+                      || (echo "bench.csv is outdated"; exit 1)
-        "directory"
+                    mkdir "$out"
-        "exceptions"
+                  '';
-        "filepath"
+              });
-        "ghc"
-        "ghc-bignum"
-        "ghc-boot"
-        "ghc-boot"
-        "ghc-boot-th"
-        "ghc-compact"
-        "ghc-heap"
-        # "ghci"
-        # "haskeline"
-        "ghcjs-prim"
-        "ghcjs-th"
-        "ghc-prim"
-        "ghc-prim"
-        "hpc"
-        "integer-gmp"
-        "integer-simple"
-        "mtl"
-        "parsec"
-        "pretty"
-        "process"
-        "rts"
-        "stm"
-        "template-haskell"
-        "terminfo"
-        "text"
-        "time"
-        "transformers"
-        "unix"
-        "Win32"
-        "xhtml"
-      ];
-
-      haskellModules = [
-        ({ config, pkgs, hsPkgs, ... }: {
-          inherit nonReinstallablePkgs; # Needed for a lot of different things
-          packages = {
-            cardano-binary.doHaddock = false;
-            cardano-binary.ghcOptions = [ "-Wwarn" ];
-            cardano-crypto-class.components.library.pkgconfig = pkgs.lib.mkForce [ [ pkgs.libsodium-vrf ] ];
-            cardano-crypto-class.doHaddock = false;
-            cardano-crypto-class.ghcOptions = [ "-Wwarn" ];
-            cardano-crypto-praos.components.library.pkgconfig = pkgs.lib.mkForce [ [ pkgs.libsodium-vrf ] ];
-            cardano-prelude.doHaddock = false; # somehow above options are not applied?
-            cardano-prelude.ghcOptions = [ "-Wwarn" ];
-            # Workaround missing support for build-tools:
-            # https://github.com/input-output-hk/haskell.nix/issues/231
-            plutarch-test.components.exes.plutarch-test.build-tools = [
-              config.hsPkgs.hspec-discover
-            ];
           };
-        })
+      };
-      ];
+    in
-
+    (liqwid-nix.buildProject
-      myhackage = system: compiler-nix-name: plutarch.inputs.haskell-nix-extra-hackage.mkHackageFor system compiler-nix-name (
+      {
-        [
+        inherit inputs;
-          "${inputs.plutarch.inputs.flat}"
+        src = ./.;
-          "${inputs.plutarch.inputs.protolude}"
+      }
-          "${inputs.plutarch.inputs.cardano-prelude}/cardano-prelude"
+      [
-          "${inputs.plutarch.inputs.cardano-crypto}"
+        liqwid-nix.haskellProject
-          "${inputs.plutarch.inputs.cardano-base}/binary"
+        liqwid-nix.plutarchProject
-          "${inputs.plutarch.inputs.cardano-base}/cardano-crypto-class"
+        (liqwid-nix.addDependencies [
-          "${inputs.plutarch.inputs.plutus}/plutus-core"
-          "${inputs.plutarch.inputs.plutus}/plutus-ledger-api"
-          "${inputs.plutarch.inputs.plutus}/plutus-tx"
-          "${inputs.plutarch.inputs.plutus}/prettyprinter-configurable"
-          "${inputs.plutarch.inputs.plutus}/word-array"
-          "${inputs.plutarch.inputs.secp256k1-haskell}"
-          "${inputs.plutarch.inputs.plutus}/plutus-tx-plugin" # necessary for FFI tests
-
-          # Custom deps as a consumer
-          "${inputs.plutarch}"
-          "${inputs.plutarch}/plutarch-extra"
-          "${inputs.liqwid-plutarch-extra}"
           "${inputs.plutarch-numeric}"
           "${inputs.plutarch-safe-money}"
           "${inputs.plutarch-quickcheck}"
           "${inputs.plutarch-context-builder}"
+          "${inputs.liqwid-plutarch-extra}"
           "${inputs.plutarch-script-export}"
-        ]
+        ])
-      );
+        (liqwid-nix.enableFormatCheck [
-
+          "-XQuasiQuotes"
-      applyDep = pkgs: o:
+          "-XTemplateHaskell"
-        let
+          "-XTypeApplications"
-          h = myhackage pkgs.system o.compiler-nix-name;
+          "-XImportQualifiedPost"
-          o' = (plutarch.applyPlutarchDep pkgs o);
+          "-XPatternSynonyms"
-        in
+          "-XOverloadedRecordDot"
-        o' // rec {
+        ])
-          modules = haskellModules ++ [ h.module ] ++ (o'.modules or [ ]);
+        liqwid-nix.enableLintCheck
-          extra-hackages = [ (import h.hackageNix) ] ++ (o'.extra-hackages or [ ]);
+        liqwid-nix.enableCabalFormatCheck
-          extra-hackage-tarballs = { _xNJUd_plutarch-hackage = h.hackageTarball; };
+        liqwid-nix.enableNixFormatCheck
-          cabalProjectLocal = (o'.cabalProjectLocal or "") + "  , cache >= 0.1.3.0 ";
+        liqwid-nix.addBuildChecks
-        };
+        (liqwid-nix.addCommandLineTools (pkgs: _: [
-
+          pkgs.haskellPackages.hasktags
-      projectForGhc = compiler-nix-name: system:
+        ]))
-        let pkgs = pkgsFor system; in
+        benchCheckOverlay
-        let pkgs' = pkgsFor' system; in
+      ]
-        let pkgSet = pkgs.haskell-nix.cabalProject' (applyDep pkgs {
+    ).toFlake;
-          src = ./.;
-          inherit compiler-nix-name;
-          modules = [ ];
-          shell = {
-            withHoogle = true;
-
-            exactDeps = true;
-
-            # We use the ones from Nixpkgs, since they are cached reliably.
-            # Eventually we will probably want to build these with haskell.nix.
-            nativeBuildInputs = [
-              pkgs'.cabal-install
-              pkgs'.hlint
-              pkgs'.haskellPackages.cabal-fmt
-              (fourmoluFor system)
-              pkgs'.nixpkgs-fmt
-              (plutarch.hlsFor compiler-nix-name system)
-            ];
-          };
-        }); in
-        pkgSet;
-
-      projectFor = projectForGhc defaultGhcVersion;
-
-      formatCheckFor = system:
-        let
-          pkgs' = pkgsFor' system;
-        in
-        pkgs'.runCommand "format-check"
-          {
-            nativeBuildInputs = [ pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt (fourmoluFor system) pkgs'.hlint ];
-          } ''
-          export LC_CTYPE=C.UTF-8
-          export LC_ALL=C.UTF-8
-          export LANG=C.UTF-8
-          cd ${self}
-          make format_check || (echo "    Please run 'make format'" ; exit 1)
-          find -name '*.hs' -not -path './dist*/*' -not -path './haddock/*' | xargs hlint
-          mkdir $out
-        ''
-      ;
-
-      benchCheckFor = system: agora-bench:
-        let
-          pkgs = pkgsFor system;
-          pkgs' = pkgsFor' system;
-        in
-        pkgs.runCommand "bench-check"
-          {
-            bench = "${agora-bench}/bin/agora-bench";
-            nativeBuildInputs = [
-              pkgs'.diffutils
-            ];
-          } ''
-          export LC_CTYPE=C.UTF-8
-          export LC_ALL=C.UTF-8
-          export LANG=C.UTF-8
-          cd ${self}
-          make bench_check || (echo "    Please run 'make bench'" ; exit 1)
-          mkdir $out 
-        '';
-    in
-    {
-      project = perSystem projectFor;
-      flake = perSystem (system: (projectFor system).flake { });
-
-      packages = perSystem (system:
-        self.flake.${system}.packages // {
-          haddock =
-            let
-              agora-doc = self.flake.${system}.packages."agora:lib:agora".doc;
-              pkgs = pkgsFor system;
-            in
-            pkgs.runCommand "haddock-merge" { } ''
-              cd ${self}
-              mkdir $out
-              cp -r ${agora-doc}/share/doc/* $out
-            '';
-        });
-
-      # Define what we want to test
-      checks = perSystem (system:
-        self.flake.${system}.checks // {
-          formatCheck = formatCheckFor system;
-          # benchCheck = benchCheckFor system self.flake.${system}.packages."agora:bench:agora-bench";
-          agora = self.flake.${system}.packages."agora:lib:agora";
-          agora-test = self.flake.${system}.packages."agora:test:agora-test";
-          benchCheck = benchCheckFor system self.flake.${system}.packages."agora:bench:agora-bench";
-        });
-      check = perSystem (system:
-        (pkgsFor system).runCommand "combined-test"
-          {
-            checksss = builtins.attrValues self.checks.${system};
-          } ''
-          echo $checksss
-          touch $out
-        '');
-      devShell = perSystem (system: self.flake.${system}.devShell);
-    };
 }