Fix validate treasury

.gitignore

@@ -171,3 +171,5 @@ Pods
 dist-newstyle
 temp/
 result/
+# The scripts (result of running 'make run-create-scripts')
+triphut-dao-scripts.json

Makefile

@@ -13,6 +13,21 @@ run-build:
 	@rm -rf ./result
 	@rm -rf ./dist-newstyle
 
+# Build and run 'create-scripts'
+run-create-scripts:
+	@rm -rf ./result
+	@nix build .#dao-scripts
+	@./result/bin/create-scripts compile
+	@rm -rf ./result
+	@rm -rf ./dist-newstyle
+
+# Build but don't run 'create-scripts', for testing it compiles
+build-create-scripts:
+	@rm -rf ./result
+	@nix build .#dao-scripts
+	@rm -rf ./result
+	@rm -rf ./dist-newstyle
+
 clean:
 	@rm -rf ./result
 	@rm -rf ./dao/dist-newstyle

dao/app/Main.hs

@@ -1,9 +1,66 @@
--- {-# LANGUAGE RecordWildCards #-}
--- {-# OPTIONS_GHC -fno-warn-orphans #-}
-
 module Main (main) where
 
-import Prelude (IO, putStrLn)
+import Control.Applicative ((<*), (<**>), (<*>))
+import Data.Kind (Type)
+import Options.Applicative (
+  Parser,
+  ParserInfo,
+  auto,
+  command,
+  customExecParser,
+  fullDesc,
+  help,
+  helper,
+  info,
+  long,
+  metavar,
+  option,
+  prefs,
+  progDesc,
+  showDefault,
+  showHelpOnEmpty,
+  showHelpOnError,
+  strOption,
+  subparser,
+  value,
+ )
+import Scripts.Compile (CompileMode (COMPILE_DEBUG, COMPILE_PROD), CompileOpts (CompileOpts), compile)
+import Prelude (IO, ($), (<$>), (<>))
+
+newtype Command = Compile CompileOpts
+
+compileOpts :: Parser CompileOpts
+compileOpts =
+  CompileOpts
+    <$> option
+      auto
+      ( long "mode"
+          <> metavar "COMPILE_MODE"
+          <> help "Mode of compilation COMPILE_DEBUG|COMPILE_PROD"
+          -- <> value COMPILE_PROD
+          <> value COMPILE_DEBUG
+          <> showDefault
+      )
+    <*> strOption
+      ( long "file"
+          <> metavar "COMPILE_FILE"
+          <> help "A JSON file to store the compiled scripts"
+          <> value "triphut-dao-scripts.json"
+          <> showDefault
+      )
+
+options :: Parser Command
+options =
+  subparser $
+    command
+      "compile"
+      (info (Compile <$> compileOpts <* helper) (progDesc "Compile scripts and write them to a file"))
+
+parserInfo :: ParserInfo Command
+parserInfo = info (options <**> helper) (fullDesc <> progDesc "Create Scripts CLI")
 
 main :: IO ()
-main = putStrLn "Nothing yet"
+main = do
+  cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo
+  case cmd of
+    Compile opts -> compile opts

dao/app/Scripts/Compile.hs

@@ -0,0 +1,103 @@
+module Scripts.Compile (CompileOpts (..), CompileMode (..), compile) where
+
+import Prelude (IO, Eq, FilePath, Read, Show, print, return, ($), (.), (>>=))
+import Data.ByteString qualified as BS
+import Data.ByteString.Short qualified as SBS (fromShort)
+import Dao.Configuration.Script 
+  ( configPolicyCompiledCode
+  , configValidatorCompiledCode
+  )
+import Dao.Index.Script (indexPolicyCompiledCode, indexValidatorCompiledCode)
+import Dao.Vote.Script 
+  ( votePolicyCompiledCode
+  , voteValidatorCompiledCode
+  , fungiblePolicyCompiledCode
+  , voteNftPolicyCompiledCode
+  )
+import Dao.Tally.Script (tallyPolicyCompiledCode, tallyValidatorCompiledCode)
+import Dao.Treasury.Script (treasuryValidatorCompiledCode, treasuryPolicyCompiledCode)
+import LambdaBuffers.ApplicationConfig.Scripts 
+  (Scripts 
+    (Scripts
+    , scripts'configPolicy
+    , scripts'configPolicyDebug
+    , scripts'configValidator
+    , scripts'configValidatorDebug
+    , scripts'indexPolicy
+    , scripts'indexPolicyDebug
+    , scripts'indexValidator
+    , scripts'indexValidatorDebug
+    , scripts'tallyPolicy
+    , scripts'tallyPolicyDebug
+    , scripts'tallyValidator
+    , scripts'tallyValidatorDebug
+    , scripts'votePolicy
+    , scripts'votePolicyDebug
+    , scripts'voteValidator
+    , scripts'voteValidatorDebug
+    , scripts'treasuryValidator
+    , scripts'treasuryValidatorDebug
+    , scripts'treasuryPolicy
+    , scripts'treasuryPolicyDebug
+    , scripts'fungiblePolicy
+    , scripts'voteNftPolicy
+    , scripts'voteNftPolicyDebug
+    )
+  , Script (Script)
+  )
+import LambdaBuffers.Runtime.Prelude (toJsonBytes)
+import PlutusLedgerApi.V2 (serialiseCompiledCode)
+import PlutusTx (BuiltinData, CompiledCode)
+import PlutusTx.Plugin ()
+import Dao.ScriptArgument (ConfigPolicyParams)
+import Plutonomy
+import Data.Either (Either (Left, Right), either)
+import Data.Maybe (Maybe (Just, Nothing))
+
+data CompileMode = COMPILE_PROD | COMPILE_DEBUG deriving stock (Show, Read, Eq)
+
+data CompileOpts = CompileOpts
+  { co'Mode :: CompileMode
+  , co'File :: FilePath
+  }
+  deriving stock (Show, Eq)
+
+compile :: CompileOpts -> IO ()
+compile opts = do
+  let scripts =
+        toJsonBytes $
+          Scripts
+            { scripts'configPolicy = Script (scriptToCborOptimised configPolicyCompiledCode)
+            , scripts'configPolicyDebug = Script (scriptToCbor configPolicyCompiledCode)
+            , scripts'configValidator = Script (scriptToCborOptimised configValidatorCompiledCode)
+            , scripts'configValidatorDebug = Script (scriptToCbor configValidatorCompiledCode)
+            , scripts'indexPolicy = Script (scriptToCborOptimised indexPolicyCompiledCode)
+            , scripts'indexPolicyDebug = Script (scriptToCbor indexPolicyCompiledCode)
+            , scripts'indexValidator = Script (scriptToCborOptimised indexValidatorCompiledCode)
+            , scripts'indexValidatorDebug = Script (scriptToCbor indexValidatorCompiledCode)
+            , scripts'tallyPolicy = Script (scriptToCborOptimised tallyPolicyCompiledCode)
+            , scripts'tallyPolicyDebug = Script (scriptToCbor tallyPolicyCompiledCode)
+            , scripts'tallyValidator = Script (scriptToCborOptimised tallyValidatorCompiledCode)
+            , scripts'tallyValidatorDebug = Script (scriptToCbor tallyValidatorCompiledCode)
+            , scripts'votePolicy = Script (scriptToCborOptimised votePolicyCompiledCode)
+            , scripts'votePolicyDebug = Script (scriptToCbor votePolicyCompiledCode)
+            , scripts'voteValidator = Script (scriptToCborOptimised voteValidatorCompiledCode)
+            , scripts'voteValidatorDebug = Script (scriptToCbor voteValidatorCompiledCode)
+            , scripts'treasuryValidator = Script (scriptToCborOptimised treasuryValidatorCompiledCode)
+            , scripts'treasuryValidatorDebug = Script (scriptToCbor treasuryValidatorCompiledCode)
+            , scripts'treasuryPolicyDebug = Script (scriptToCbor treasuryPolicyCompiledCode)
+            , scripts'treasuryPolicy = Script (scriptToCborOptimised treasuryPolicyCompiledCode)
+            , scripts'fungiblePolicy = Script (scriptToCborOptimised fungiblePolicyCompiledCode)
+            , scripts'voteNftPolicy = Script (scriptToCborOptimised voteNftPolicyCompiledCode)
+            , scripts'voteNftPolicyDebug = Script (scriptToCbor voteNftPolicyCompiledCode)
+            }
+  BS.writeFile (co'File opts) scripts
+
+scriptToCborOptimised :: forall a. CompiledCode a -> BS.ByteString
+scriptToCborOptimised = scriptToCbor . optimiseScript
+
+scriptToCbor :: forall a. CompiledCode a -> BS.ByteString
+scriptToCbor = SBS.fromShort . serialiseCompiledCode
+
+optimiseScript :: forall a. CompiledCode a -> CompiledCode a
+optimiseScript = optimizeUPLCWith aggressiveOptimizerOptions

dao/build.nix

@@ -1,6 +1,6 @@
 { inputs, ... }:
 {
-  perSystem = { config, system, inputs', pkgs, ... }:
+  perSystem = { config, system, inputs', ... }:
     let
       hsFlake = inputs.lbf.lib.${system}.haskellPlutusFlake {
         src = ./.;
@@ -21,6 +21,7 @@
 
           # Lambda Buffers types
           "${config.packages.dao-lb-types}"
+          "${config.packages.dao-lb-config}"
 
           # LBs PlutusTx
           "${inputs'.lbf.packages.lbf-plutus-haskell}"
@@ -42,7 +43,7 @@
       packages = {
         dao-lib = hsFlake.packages."dao:lib:dao";
 
-        dao-app = hsFlake.packages."dao:exe:create-sc";
+        dao-scripts = hsFlake.packages."dao:exe:create-scripts";
 
         dao-test = hsFlake.packages."dao:test:dao-test";
       };

dao/dao-lib/Dao/Configuration/Script.hs

@@ -7,19 +7,20 @@ Description: Dao configuration related scripts. It includes:
 module Dao.Configuration.Script (
   -- * Minting policy
   mkConfigurationNftPolicy,
+  configPolicyCompiledCode,
 
   -- * Validator
   validateConfiguration,
-  configurationValidatorCompiledCode,
+  configValidatorCompiledCode,
 ) where
 
 import Dao.ScriptArgument (
-  ConfigurationValidatorConfig (
-    ConfigurationValidatorConfig,
-    cvcConfigNftCurrencySymbol,
-    cvcConfigNftTokenName
+  ConfigPolicyParams (ConfigPolicyParams, cpInitialUtxo, cpTokenName),
+  ValidatorParams (
+    ValidatorParams,
+    vpConfigSymbol,
+    vpConfigTokenName
   ),
-  NftConfig (NftConfig, ncInitialUtxo, ncTokenName),
  )
 import Dao.Shared (
   convertDatum,
@@ -28,7 +29,8 @@ import Dao.Shared (
   hasSymbolInValue,
   hasTokenInValue,
   hasTokenInValueNoErrors,
-  wrapValidate',
+  untypedPolicy,
+  untypedValidator,
  )
 import LambdaBuffers.ApplicationTypes.Configuration (
   DynamicConfigDatum (
@@ -82,11 +84,13 @@ import PlutusTx.Prelude (
   Bool,
   BuiltinData,
   Integer,
+  Maybe (Just),
   any,
   divide,
   filter,
   traceError,
   traceIfFalse,
+  ($),
   (&&),
   (*),
   (+),
@@ -99,16 +103,16 @@ import PlutusTx.Prelude (
 
    This policy performs the following checks:
 
-    - The UTXO, referenced in the `ncInitialUtxo` field of
-      the `NftConfig` argument, is spent in the transaction.
-    - The token name matches the `ncTokenName` field of the `NftConfig` argument.
+    - The UTXO, referenced in the `cpInitialUtxo` field of
+      the `ConfigPolicyParams` argument, is spent in the transaction.
+    - The token name matches the `cpTokenName` field of the `ConfigPolicyParams` argument.
     - Exactly one config NFT is minted with the valid token name.
     - There is exactly one output containing the NFT.
     - This output contains a valid 'LambdaBuffers.ApplicationTypes.Configuration.DynamicConfigDatum' datum.
 -}
-mkConfigurationNftPolicy :: NftConfig -> BuiltinData -> ScriptContext -> Bool
+mkConfigurationNftPolicy :: ConfigPolicyParams -> BuiltinData -> ScriptContext -> Bool
 mkConfigurationNftPolicy
-  NftConfig {..}
+  ConfigPolicyParams {..}
   _
   ScriptContext
     { scriptContextTxInfo = TxInfo {..}
@@ -128,21 +132,27 @@ mkConfigurationNftPolicy
 
       -- Ensure that the reference UTXO is spent
       hasUTxO :: Bool
-      !hasUTxO = any (\i -> txInInfoOutRef i == ncInitialUtxo) txInfoInputs
+      !hasUTxO = any (\i -> txInInfoOutRef i == cpInitialUtxo) txInfoInputs
 
       -- Ensure that only one valid token is minted
-      -- The token name must match the `ncTokenName` from `NftConfig` argument
+      -- The token name must match the `cpTokenName` from `ConfigPolicyParams` argument
       onlyOneTokenMinted :: Bool
       !onlyOneTokenMinted =
         hasSingleTokenWithSymbolAndTokenName
           txInfoMint
           thisCurrencySymbol
-          ncTokenName
+          cpTokenName
      in
       traceIfFalse "Referenced UTXO should be spent" hasUTxO
         && traceIfFalse "Exactly one valid token should be minted" onlyOneTokenMinted
 mkConfigurationNftPolicy _ _ _ = traceError "Wrong type of script purpose!"
 
+configPolicyCompiledCode :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
+configPolicyCompiledCode = $$(PlutusTx.compile [||untypedConfigPolicy||])
+
+untypedConfigPolicy :: BuiltinData -> BuiltinData -> BuiltinData -> ()
+untypedConfigPolicy = untypedPolicy mkConfigurationNftPolicy
+
 {- | Validator for proposal upgrades.
 
    This validator performs the following checks:
@@ -164,13 +174,13 @@ mkConfigurationNftPolicy _ _ _ = traceError "Wrong type of script purpose!"
         sum to a time before the transaction's validity range.
 -}
 validateConfiguration ::
-  ConfigurationValidatorConfig ->
+  ValidatorParams ->
   DynamicConfigDatum ->
   BuiltinData ->
   ScriptContext ->
   Bool
 validateConfiguration
-  ConfigurationValidatorConfig {..}
+  ValidatorParams {..}
   DynamicConfigDatum {..}
   _
   ScriptContext
@@ -183,7 +193,7 @@ validateConfiguration
 
       -- Ensure there is a config token in the inputs
       hasConfigurationNft :: Bool
-      !hasConfigurationNft = hasOneOfToken cvcConfigNftCurrencySymbol cvcConfigNftTokenName thisScriptValue
+      !hasConfigurationNft = hasOneOfToken vpConfigSymbol vpConfigTokenName thisScriptValue
 
       -- Helper for filtering for tally UTXO in the reference inputs
       hasTallyNft :: Value -> Bool
@@ -243,15 +253,6 @@ validateConfiguration
         && traceIfFalse "Tallying not over. Try again later" isAfterTallyEndTime
 validateConfiguration _ _ _ _ = traceError "Wrong script purpose"
 
-configurationValidatorCompiledCode ::
-  ConfigurationValidatorConfig ->
-  CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
-configurationValidatorCompiledCode config =
-  $$(PlutusTx.compile [||wrapValidateConfiguration||]) `applyCode` liftCode config
-
-wrapValidateConfiguration :: ConfigurationValidatorConfig -> BuiltinData -> BuiltinData -> BuiltinData -> ()
-wrapValidateConfiguration = wrapValidate' validateConfiguration
-
 ownValue :: [TxInInfo] -> TxOutRef -> Value
 ownValue ins txOutRef = go ins
   where
@@ -261,3 +262,9 @@ ownValue ins txOutRef = go ins
         if txInInfoOutRef == txOutRef
           then txOutValue
           else go xs
+
+configValidatorCompiledCode :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> ())
+configValidatorCompiledCode = $$(PlutusTx.compile [||untypedConfigValidator||])
+
+untypedConfigValidator :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> ()
+untypedConfigValidator = untypedValidator validateConfiguration