init servant-based API for script exporting

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

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
+  { port :: Warp.Port
-  , output :: FilePath
   }
   deriving stock (Show, Eq)
 
 opt :: Opt.Parser Options
 opt =
   Options
-    <$> Opt.strOption
+    <$> Opt.option Opt.auto
-      ( Opt.long "config"
+      ( Opt.long "port"
-          <> Opt.short 'c'
+          <> Opt.short 'p'
-          <> Opt.metavar "CONFIG_PATH"
+          <> Opt.metavar "PORT"
-          <> Opt.value "./agora-scripts/agora-params.json"
+          <> 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

agora-scripts/Scripts.hs

@@ -9,113 +9,11 @@ Export scripts given configuration.
 -}
 module Main (main) where
 
-import Agora.AuthorityToken (AuthorityToken, authorityTokenPolicy)
+import Options (parseOptions)
-import Agora.Governor (Governor (Governor))
+import API (runServer)
-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)
 
 main :: IO ()
 main = do
   options <- parseOptions
 
-  params <-
+  runServer options
-    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

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