diff --git a/agora-scripts/Options.hs b/agora-scripts/Options.hs new file mode 100644 index 0000000..f6c4d10 --- /dev/null +++ b/agora-scripts/Options.hs @@ -0,0 +1,45 @@ +{- | +Module : Options +Maintainer : emi@haskell.fyi +Description: Command line options for 'agora-scripts'. + +Command line options for 'agora-scripts'. +-} +module Options (Options (..), parseOptions) where + +import Options.Applicative ((<**>)) +import Options.Applicative qualified as Opt + +data Options = Options + { config :: FilePath + , output :: FilePath + } + deriving stock (Show, Eq) + +opt :: Opt.Parser Options +opt = + Options + <$> Opt.strOption + ( Opt.long "config" + <> Opt.short 'c' + <> Opt.metavar "CONFIG_PATH" + <> Opt.value "./" + <> Opt.help "The path where the script configuration is." + ) + <*> Opt.strOption + ( Opt.long "output" + <> Opt.short 'o' + <> Opt.metavar "OUTPUT_PATH" + <> Opt.value "./" + <> Opt.help "Output where generated scripts will be." + ) + +parseOptions :: IO Options +parseOptions = Opt.execParser p + where + p = + Opt.info + (opt <**> Opt.helper) + ( Opt.fullDesc + <> Opt.progDesc "Generate Agora scripts for off-chain use." + ) diff --git a/agora-scripts/Scripts.hs b/agora-scripts/Scripts.hs new file mode 100644 index 0000000..7d171d1 --- /dev/null +++ b/agora-scripts/Scripts.hs @@ -0,0 +1,66 @@ +{- | +Module : Scripts +Maintainer : emi@haskell.fyi +Description: Export scripts given configuration. + +Export scripts given configuration. +-} +module Scripts (main) where + +import Agora.Governor (Governor (Governor)) +import Agora.Governor qualified as Governor +import Agora.Governor.Scripts (governorPolicy) +import Agora.SafeMoney (GTTag) +import Agora.ScriptInfo (PolicyInfo, mkPolicyInfo) +import Control.Monad ((>=>)) +import Data.Aeson qualified as Aeson +import GHC.Generics qualified as GHC +import Options (Options (..), parseOptions) +import Plutarch.SafeMoney (Tagged) +import Plutus.V1.Ledger.Api (TxOutRef) +import Plutus.V1.Ledger.Value (AssetClass) +import System.Exit (exitFailure) + +data ScriptsConfig = ScriptsConfig + { governorInitialSpend :: TxOutRef + , gtClassRef :: Tagged GTTag AssetClass + , maximumCosigners :: Integer + } + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + deriving stock (Show, Eq, GHC.Generic) + +data AgoraScripts = AgoraScripts + { governorPolicyInfo :: PolicyInfo + } + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + deriving stock (Show, Eq, GHC.Generic) + +main :: IO () +main = do + putStrLn "Hello, world!" + + options <- parseOptions + + params <- + Aeson.eitherDecodeFileStrict @ScriptsConfig options.config + >>= either (putStrLn >=> const exitFailure) pure + + let scripts = agoraScripts params + + print params + print scripts + + pure () + +agoraScripts :: ScriptsConfig -> AgoraScripts +agoraScripts config = + AgoraScripts + { governorPolicyInfo = mkPolicyInfo (governorPolicy governor) + } + where + governor = + Governor + { Governor.gstOutRef = config.governorInitialSpend + , Governor.gtClassRef = config.gtClassRef + , Governor.maximumCosigners = config.maximumCosigners + } diff --git a/agora.cabal b/agora.cabal index 7d01530..be3d748 100644 --- a/agora.cabal +++ b/agora.cabal @@ -146,18 +146,21 @@ library Agora.Utils Agora.Utils.Value + Agora.ScriptInfo + Agora.Aeson.Orphans + other-modules: hs-source-dirs: agora library pprelude + default-language: Haskell2010 + exposed-modules: PPrelude + hs-source-dirs: agora + build-depends: , base , plutarch - exposed-modules: PPrelude - hs-source-dirs: agora - default-language: Haskell2010 - library agora-testlib import: lang, deps, test-deps exposed-modules: Test.Util @@ -165,7 +168,6 @@ library agora-testlib library agora-sample import: lang, deps, test-deps - build-depends: agora-testlib exposed-modules: Sample.Effect.TreasuryWithdrawal Sample.Governor @@ -173,9 +175,10 @@ library agora-sample Sample.Shared Sample.Stake Sample.Treasury - hs-source-dirs: agora-sample + build-depends: agora-testlib + test-suite agora-test import: lang, deps, test-deps type: exitcode-stdio-1.0 @@ -205,16 +208,26 @@ benchmark agora-bench , agora , agora-sample +executable agora-scripts + import: lang, deps, exe-opts + main-is: Scripts.hs + hs-source-dirs: agora-scripts + other-modules: + Options + build-depends: + , agora + , optparse-applicative + executable agora-purescript-bridge import: lang, deps, exe-opts main-is: Bridge.hs + hs-source-dirs: agora-purescript-bridge + other-modules: + AgoraTypes + Options + build-depends: , agora , optparse-applicative , path , purescript-bridge - - hs-source-dirs: agora-purescript-bridge - other-modules: - AgoraTypes - Options diff --git a/agora/Agora/Aeson/Orphans.hs b/agora/Agora/Aeson/Orphans.hs new file mode 100644 index 0000000..522643a --- /dev/null +++ b/agora/Agora/Aeson/Orphans.hs @@ -0,0 +1,146 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Agora.Aeson.Orphans (AsBase16Bytes (..)) where + +-------------------------------------------------------------------------------- + +import Data.Coerce (Coercible, coerce) +import Prelude + +-------------------------------------------------------------------------------- + +import Codec.Serialise qualified as Codec +import Data.Aeson qualified as Aeson +import Data.Aeson.Types qualified as Aeson +import Data.ByteString.Lazy qualified as Lazy +import Data.Text qualified as T +import Data.Text.Encoding qualified as T + +-------------------------------------------------------------------------------- + +import Plutus.V1.Ledger.Api qualified as Plutus +import Plutus.V1.Ledger.Bytes qualified as Plutus +import Plutus.V1.Ledger.Value qualified as Plutus + +-------------------------------------------------------------------------------- + +newtype AsBase16Bytes a = AsBase16Bytes {unAsBase16Bytes :: a} +newtype AsBase16Codec a = AsBase16Codec {unAsBase16Codec :: a} + +deriving via + (Plutus.CurrencySymbol, Plutus.TokenName) + instance + Aeson.ToJSON Plutus.AssetClass + +deriving via + (Plutus.CurrencySymbol, Plutus.TokenName) + instance + Aeson.FromJSON Plutus.AssetClass + +deriving via + AsBase16Bytes Plutus.TxId + instance + Aeson.FromJSON Plutus.TxId + +deriving via + AsBase16Bytes Plutus.TxId + instance + Aeson.ToJSON Plutus.TxId + +deriving anyclass instance Aeson.FromJSON Plutus.TxOutRef +deriving anyclass instance Aeson.ToJSON Plutus.TxOutRef + +instance (Coercible a Plutus.LedgerBytes) => Aeson.ToJSON (AsBase16Bytes a) where + toJSON = + Aeson.String + . Plutus.encodeByteString + . Plutus.bytes + . coerce @(AsBase16Bytes a) @Plutus.LedgerBytes + +instance (Coercible Plutus.LedgerBytes a) => Aeson.FromJSON (AsBase16Bytes a) where + parseJSON v = + Aeson.parseJSON @T.Text v + >>= either (Aeson.parserThrowError []) (pure . coerce @_ @(AsBase16Bytes a)) + . Plutus.fromHex + . T.encodeUtf8 + +instance (Codec.Serialise a) => Aeson.ToJSON (AsBase16Codec a) where + toJSON = + Aeson.String + . Plutus.encodeByteString + . Lazy.toStrict + . Codec.serialise @a + . (.unAsBase16Codec) + +instance (Codec.Serialise a) => Aeson.FromJSON (AsBase16Codec a) where + parseJSON v = + Aeson.parseJSON @T.Text v + >>= either (Aeson.parserThrowError [] . show) (pure . AsBase16Codec) + . Codec.deserialiseOrFail + . Lazy.fromStrict + . T.encodeUtf8 + +-------------------------------------------------------------------------------- + +deriving via + (AsBase16Bytes Plutus.CurrencySymbol) + instance + (Aeson.ToJSON Plutus.CurrencySymbol) +deriving via + (AsBase16Bytes Plutus.CurrencySymbol) + instance + (Aeson.FromJSON Plutus.CurrencySymbol) + +deriving via + (AsBase16Bytes Plutus.TokenName) + instance + (Aeson.ToJSON Plutus.TokenName) +deriving via + (AsBase16Bytes Plutus.TokenName) + instance + (Aeson.FromJSON Plutus.TokenName) + +deriving via + (AsBase16Bytes Plutus.ValidatorHash) + instance + (Aeson.ToJSON Plutus.ValidatorHash) +deriving via + (AsBase16Bytes Plutus.ValidatorHash) + instance + (Aeson.FromJSON Plutus.ValidatorHash) + +deriving via + (AsBase16Codec Plutus.Validator) + instance + (Aeson.ToJSON Plutus.Validator) +deriving via + (AsBase16Codec Plutus.Validator) + instance + (Aeson.FromJSON Plutus.Validator) + +deriving via + (AsBase16Codec Plutus.MintingPolicy) + instance + (Aeson.ToJSON Plutus.MintingPolicy) +deriving via + (AsBase16Codec Plutus.MintingPolicy) + instance + (Aeson.FromJSON Plutus.MintingPolicy) + +deriving via + (AsBase16Codec Plutus.Script) + instance + (Aeson.ToJSON Plutus.Script) +deriving via + (AsBase16Codec Plutus.Script) + instance + (Aeson.FromJSON Plutus.Script) + +deriving via + Integer + instance + (Aeson.ToJSON Plutus.POSIXTime) +deriving via + Integer + instance + (Aeson.FromJSON Plutus.POSIXTime) diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index f94ae8d..2a469ea 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -8,6 +8,9 @@ Tags and extras for "Plutarch.SafeMoney". module Agora.SafeMoney ( ADATag, GTTag, + GovernorSTTag, + StakeSTTag, + ProposalSTTag, adaRef, ) where @@ -18,7 +21,7 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) import Plutarch.SafeMoney -------------------------------------------------------------------------------- --- Example tags +-- Tags -- | Governance token. data GTTag @@ -26,6 +29,15 @@ data GTTag -- | ADA. data ADATag +-- | Governor ST token. +data GovernorSTTag + +-- | Stake ST token. +data StakeSTTag + +-- | Proposal ST token. +data ProposalSTTag + -------------------------------------------------------------------------------- -- | Resolves ada tags. diff --git a/agora/Agora/ScriptInfo.hs b/agora/Agora/ScriptInfo.hs new file mode 100644 index 0000000..54a709e --- /dev/null +++ b/agora/Agora/ScriptInfo.hs @@ -0,0 +1,59 @@ +{- | +Module : Agora.ScriptInfo +Maintainer : emi@haskell.fyi +Description: Exportable script bundles for off-chain consumption. + +Exportable script bundles for off-chain consumption. +-} +module Agora.ScriptInfo ( + -- * Types + PolicyInfo (..), + ValidatorInfo (..), + + -- * Introduction functions + mkValidatorInfo, + mkPolicyInfo, +) where + +import Agora.Aeson.Orphans () +import Data.Aeson qualified as Aeson +import GHC.Generics qualified as GHC +import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash) +import Plutus.V1.Ledger.Api (MintingPolicy, Validator, ValidatorHash) +import Plutus.V1.Ledger.Value (CurrencySymbol) + +-- | Bundle containing a 'Validator' and its hash. +data ValidatorInfo = ValidatorInfo + { script :: Validator + , hash :: ValidatorHash + } + deriving stock (Show, Eq, GHC.Generic) + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + +-- | Create a 'ValidatorInfo' given a Plutarch term. +mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo +mkValidatorInfo term = + ValidatorInfo + { script = validator + , hash = validatorHash validator + } + where + validator = mkValidator term + +-- | Bundle containing a 'MintingPolicy' and its symbol. +data PolicyInfo = PolicyInfo + { policy :: MintingPolicy + , currencySymbol :: CurrencySymbol + } + deriving stock (Show, Eq, GHC.Generic) + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + +-- | Create a 'PolicyInfo' given a Plutarch term. +mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo +mkPolicyInfo term = + PolicyInfo + { policy = policy + , currencySymbol = mintingPolicySymbol policy + } + where + policy = mkMintingPolicy term