From 564b1c4e665b89c64f50cfb433584971dd3fae74 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 20 Jun 2022 15:59:35 +0200 Subject: [PATCH] init servant-based API for script exporting --- agora-scripts/API.hs | 130 +++++++++++++++++++++++++++++++++++++++ agora-scripts/Options.hs | 21 +++---- agora-scripts/Scripts.hs | 108 +------------------------------- agora.cabal | 10 ++- 4 files changed, 149 insertions(+), 120 deletions(-) create mode 100644 agora-scripts/API.hs diff --git a/agora-scripts/API.hs b/agora-scripts/API.hs new file mode 100644 index 0000000..bba06a3 --- /dev/null +++ b/agora-scripts/API.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE TemplateHaskell #-} +{- | +Module : API +Maintainer : emi@haskell.fyi +Description: API for script exporter. + +API for script exporter. +-} + +module API (AgoraScripts(..), ScriptParams(..), API, agoraScripts, runServer) where + +import Servant.API (type (:>), ReqBody, JSON, Post) +import PlutusLedgerApi.V1 (TxOutRef) +import Data.Tagged (Tagged) +import Agora.SafeMoney (GTTag) +import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol) +import qualified Data.Aeson as Aeson +import qualified GHC.Generics as GHC +import Agora.ScriptInfo (PolicyInfo, ValidatorInfo, mkPolicyInfo, mkValidatorInfo) +import Agora.Stake (Stake(..)) +import Agora.Proposal (Proposal(..)) +import Agora.AuthorityToken (AuthorityToken(..), authorityTokenPolicy) +import Agora.Governor (Governor(..)) +import Development.GitRev (gitBranch, gitHash) +import qualified Agora.Governor as Governor +import qualified PlutusLedgerApi.V1.Value as Value +import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy) +import Agora.Governor.Scripts (governorPolicy, authorityTokenSymbolFromGovernor, authorityTokenFromGovernor, proposalFromGovernor, stakeFromGovernor, governorValidator) +import Agora.Treasury (treasuryValidator) +import Agora.Proposal.Scripts (proposalValidator, proposalPolicy) +import Agora.Stake.Scripts (stakeValidator, stakePolicy) +import qualified Servant.Server as Servant +import Data.Proxy (Proxy(Proxy)) +import qualified Network.Wai.Handler.Warp as Warp +import Data.Function ((&)) +import qualified Network.Wai as Wai +import qualified Network.HTTP.Types as Http +import Prettyprinter (layoutPretty, defaultLayoutOptions, hsep, viaShow, (<+>)) +import Prettyprinter.Render.String (renderString) +import Options (Options(..)) +import Text.Printf (printf) + +-- | Params required for creating script export. +data ScriptParams = ScriptParams + { governorInitialSpend :: TxOutRef + , gtClassRef :: Tagged GTTag AssetClass + , maximumCosigners :: Integer + } + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + deriving stock (Show, Eq, GHC.Generic) + +-- | Scripts that get exported. +data AgoraScripts = AgoraScripts + { gitRev :: String + , governorPolicyInfo :: PolicyInfo + , governorValidatorInfo :: ValidatorInfo + , stakePolicyInfo :: PolicyInfo + , stakeValidatorInfo :: ValidatorInfo + , proposalPolicyInfo :: PolicyInfo + , proposalValidatorInfo :: ValidatorInfo + , treasuryValidatorInfo :: ValidatorInfo + , authorityTokenPolicyInfo :: PolicyInfo + } + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + deriving stock (Show, Eq, GHC.Generic) + +-- | Servant API type for script generation. +type API = "generate-scripts" :> ReqBody '[JSON] ScriptParams :> Post '[JSON] AgoraScripts + +-- | Run a Warp server that exposes a script generation endpoint. +runServer :: Options -> IO () +runServer options = do + let settings = + Warp.defaultSettings + & Warp.setPort options.port + & Warp.setLogger + ( \req status _maybeFileSize -> + putStrLn . renderString . layoutPretty defaultLayoutOptions $ + hsep + [ "[info]" + , "[" <> "Status:" <+> viaShow (Http.statusCode status) <> "]" + , viaShow $ Wai.requestMethod req + , viaShow $ Wai.rawPathInfo req + ] + ) + + printf "[info] Running 'agora-scripts' on :%d\n" (Warp.getPort settings) + Warp.runSettings settings $ Servant.serve (Proxy @API) (pure . agoraScripts) + +-- | Create scripts from params. +agoraScripts :: ScriptParams -> AgoraScripts +agoraScripts params = + AgoraScripts + { gitRev = revision + , governorPolicyInfo = mkPolicyInfo (governorPolicy governor) + , governorValidatorInfo = mkValidatorInfo (governorValidator governor) + , stakePolicyInfo = mkPolicyInfo (stakePolicy params.gtClassRef) + , stakeValidatorInfo = mkValidatorInfo (stakeValidator stake) + , proposalPolicyInfo = mkPolicyInfo (proposalPolicy governorSTAssetClass) + , proposalValidatorInfo = mkValidatorInfo (proposalValidator proposal) + , treasuryValidatorInfo = mkValidatorInfo (treasuryValidator authorityTokenSymbol) + , authorityTokenPolicyInfo = mkPolicyInfo (authorityTokenPolicy authorityToken) + } + where + revision :: String + revision = $(gitBranch) <> "@" <> $(gitHash) + + governor :: Governor + governor = + Governor + { Governor.gstOutRef = params.governorInitialSpend + , Governor.gtClassRef = params.gtClassRef + , Governor.maximumCosigners = params.maximumCosigners + } + + authorityToken :: AuthorityToken + 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 diff --git a/agora-scripts/Options.hs b/agora-scripts/Options.hs index e56d09a..38f473f 100644 --- a/agora-scripts/Options.hs +++ b/agora-scripts/Options.hs @@ -9,30 +9,23 @@ module Options (Options (..), parseOptions) where import Options.Applicative ((<**>)) import Options.Applicative qualified as Opt +import qualified Network.Wai.Handler.Warp as Warp data Options = Options - { config :: FilePath - , output :: FilePath + { port :: Warp.Port } deriving stock (Show, Eq) opt :: Opt.Parser Options opt = Options - <$> Opt.strOption - ( Opt.long "config" - <> Opt.short 'c' - <> Opt.metavar "CONFIG_PATH" - <> Opt.value "./agora-scripts/agora-params.json" + <$> Opt.option Opt.auto + ( Opt.long "port" + <> Opt.short 'p' + <> Opt.metavar "PORT" + <> Opt.value 3939 <> Opt.help "The path where the script configuration is." ) - <*> Opt.strOption - ( Opt.long "output" - <> Opt.short 'o' - <> Opt.metavar "OUTPUT_PATH" - <> Opt.value "./agora-scripts/agora-scripts.json" - <> Opt.help "Output where generated scripts will be." - ) parseOptions :: IO Options parseOptions = Opt.execParser p diff --git a/agora-scripts/Scripts.hs b/agora-scripts/Scripts.hs index 132f5ce..fd72c4f 100644 --- a/agora-scripts/Scripts.hs +++ b/agora-scripts/Scripts.hs @@ -9,113 +9,11 @@ Export scripts given configuration. -} module Main (main) where -import Agora.AuthorityToken (AuthorityToken, authorityTokenPolicy) -import Agora.Governor (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.ScriptInfo (PolicyInfo, ValidatorInfo, mkPolicyInfo, mkValidatorInfo) -import Agora.Stake (Stake) -import Agora.Stake.Scripts (stakePolicy, stakeValidator) -import Agora.Treasury (treasuryValidator) -import Control.Monad ((>=>)) -import Data.Aeson qualified as Aeson -import Data.Tagged (Tagged) -import Development.GitRev (gitBranch, gitHash) -import GHC.Generics qualified as GHC -import Options (Options (..), parseOptions) -import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy) -import PlutusLedgerApi.V1 (TxOutRef) -import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol) -import PlutusLedgerApi.V1.Value qualified as Value -import System.Exit (exitFailure) -import Text.Printf (printf) - --- | Params required for creating script export. -data ScriptParams = ScriptParams - { governorInitialSpend :: TxOutRef - , gtClassRef :: Tagged GTTag AssetClass - , maximumCosigners :: Integer - } - deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) - deriving stock (Show, Eq, GHC.Generic) - --- | Scripts that get exported. -data AgoraScripts = AgoraScripts - { gitRev :: String - , governorPolicyInfo :: PolicyInfo - , governorValidatorInfo :: ValidatorInfo - , stakePolicyInfo :: PolicyInfo - , stakeValidatorInfo :: ValidatorInfo - , proposalPolicyInfo :: PolicyInfo - , proposalValidatorInfo :: ValidatorInfo - , treasuryValidatorInfo :: ValidatorInfo - , authorityTokenPolicyInfo :: PolicyInfo - } - deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) - deriving stock (Show, Eq, GHC.Generic) +import Options (parseOptions) +import API (runServer) main :: IO () main = do options <- parseOptions - params <- - Aeson.eitherDecodeFileStrict @ScriptParams options.config - >>= either (putStrLn >=> const exitFailure) pure - - let scripts = agoraScripts params - - Aeson.encodeFile options.output scripts - - printf "Done! Wrote to %s\n" options.output - --- | Create scripts from params. -agoraScripts :: ScriptParams -> AgoraScripts -agoraScripts params = - AgoraScripts - { gitRev = revision - , governorPolicyInfo = mkPolicyInfo (governorPolicy governor) - , governorValidatorInfo = mkValidatorInfo (governorValidator governor) - , stakePolicyInfo = mkPolicyInfo (stakePolicy params.gtClassRef) - , stakeValidatorInfo = mkValidatorInfo (stakeValidator stake) - , proposalPolicyInfo = mkPolicyInfo (proposalPolicy governorSTAssetClass) - , proposalValidatorInfo = mkValidatorInfo (proposalValidator proposal) - , treasuryValidatorInfo = mkValidatorInfo (treasuryValidator authorityTokenSymbol) - , authorityTokenPolicyInfo = mkPolicyInfo (authorityTokenPolicy authorityToken) - } - where - revision :: String - revision = $(gitBranch) <> "@" <> $(gitHash) - - governor :: Governor - governor = - Governor - { Governor.gstOutRef = params.governorInitialSpend - , Governor.gtClassRef = params.gtClassRef - , Governor.maximumCosigners = params.maximumCosigners - } - - authorityToken :: AuthorityToken - 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 + runServer options diff --git a/agora.cabal b/agora.cabal index 8e8ba53..2e90362 100644 --- a/agora.cabal +++ b/agora.cabal @@ -234,11 +234,19 @@ executable agora-scripts import: lang, deps, exe-opts main-is: Scripts.hs hs-source-dirs: agora-scripts - other-modules: Options + other-modules: + Options + API build-depends: , agora , gitrev , optparse-applicative + , servant + , servant-server + , warp + , wai + , http-types + , prettyprinter executable agora-purescript-bridge import: lang, deps, exe-opts