init servant-based API for script exporting
This commit is contained in:
Emily Martins
parent
bd790fa622
commit
564b1c4e66
4 changed files with 149 additions and 120 deletions
130
agora-scripts/API.hs
Normal file
130
agora-scripts/API.hs
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
10
agora.cabal
10
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue