use Capture to make API more neat, update bench
This commit is contained in:
parent
910416f4ab
commit
bc501f291c
2 changed files with 33 additions and 26 deletions
|
|
@ -52,12 +52,12 @@ builders =
|
||||||
def
|
def
|
||||||
& insertBuilder "governorPolicy" ((.governorPolicyInfo) . agoraScripts)
|
& insertBuilder "governorPolicy" ((.governorPolicyInfo) . agoraScripts)
|
||||||
& insertBuilder "governorValidator" ((.governorValidatorInfo) . agoraScripts)
|
& insertBuilder "governorValidator" ((.governorValidatorInfo) . agoraScripts)
|
||||||
& insertBuilder "stakePolicyInfo" ((.stakePolicyInfo) . agoraScripts)
|
& insertBuilder "stakePolicy" ((.stakePolicyInfo) . agoraScripts)
|
||||||
& insertBuilder "stakeValidatorInfo" ((.stakeValidatorInfo) . agoraScripts)
|
& insertBuilder "stakeValidator" ((.stakeValidatorInfo) . agoraScripts)
|
||||||
& insertBuilder "proposalPolicyInfo" ((.proposalPolicyInfo) . agoraScripts)
|
& insertBuilder "proposalPolicy" ((.proposalPolicyInfo) . agoraScripts)
|
||||||
& insertBuilder "proposalValidatorInfo" ((.proposalValidatorInfo) . agoraScripts)
|
& insertBuilder "proposalValidator" ((.proposalValidatorInfo) . agoraScripts)
|
||||||
& insertBuilder "treasuryValidatorInfo" ((.treasuryValidatorInfo) . agoraScripts)
|
& insertBuilder "treasuryValidator" ((.treasuryValidatorInfo) . agoraScripts)
|
||||||
& insertBuilder "authorityTokenPolicyInfo" ((.authorityTokenPolicyInfo) . agoraScripts)
|
& insertBuilder "authorityTokenPolicy" ((.authorityTokenPolicyInfo) . agoraScripts)
|
||||||
|
|
||||||
{- | Create scripts from params.
|
{- | Create scripts from params.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -23,9 +23,9 @@ import Network.Wai.Middleware.Cors (CorsResourcePolicy (corsRequestHeaders), cor
|
||||||
import Prettyprinter (Pretty (pretty), defaultLayoutOptions, hsep, layoutPretty, viaShow)
|
import Prettyprinter (Pretty (pretty), defaultLayoutOptions, hsep, layoutPretty, viaShow)
|
||||||
import Prettyprinter.Render.String (renderString)
|
import Prettyprinter.Render.String (renderString)
|
||||||
import ScriptExport.Options (Options (..))
|
import ScriptExport.Options (Options (..))
|
||||||
import ScriptExport.Types (Builders, ScriptQuery, runQuery)
|
import ScriptExport.Types (Builders, ScriptQuery (ScriptQuery), runQuery)
|
||||||
import ScriptExport.Types qualified as Builders
|
import ScriptExport.Types qualified as Builders
|
||||||
import Servant.API (Get, JSON, Post, ReqBody, (:<|>) (..), type (:>))
|
import Servant.API (Capture, Get, JSON, Post, ReqBody, (:<|>) (..), type (:>))
|
||||||
import Servant.Server qualified as Servant
|
import Servant.Server qualified as Servant
|
||||||
import System.Clock (TimeSpec (TimeSpec))
|
import System.Clock (TimeSpec (TimeSpec))
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
@ -35,11 +35,14 @@ import Text.Printf (printf)
|
||||||
@since 0.2.0
|
@since 0.2.0
|
||||||
-}
|
-}
|
||||||
type API =
|
type API =
|
||||||
|
-- /query-script/:name
|
||||||
"query-script"
|
"query-script"
|
||||||
:> ReqBody '[JSON] ScriptQuery
|
:> Capture "name" Text
|
||||||
|
:> ReqBody '[JSON] Aeson.Value
|
||||||
:> Post '[JSON] Aeson.Value
|
:> Post '[JSON] Aeson.Value
|
||||||
|
-- /info
|
||||||
:<|> "info"
|
:<|> "info"
|
||||||
:> Get '[JSON] ServerInfo
|
:> Get '[JSON] ServerInfo
|
||||||
|
|
||||||
{- | Information about the server.
|
{- | Information about the server.
|
||||||
|
|
||||||
|
|
@ -67,37 +70,41 @@ data ServerInfo = ServerInfo
|
||||||
-- | Run a Warp server that exposes a script generation endpoint.
|
-- | Run a Warp server that exposes a script generation endpoint.
|
||||||
runServer :: Text -> Builders -> Options -> IO ()
|
runServer :: Text -> Builders -> Options -> IO ()
|
||||||
runServer revision builders options = do
|
runServer revision builders options = do
|
||||||
let settings =
|
let logger req status _maybeFileSize =
|
||||||
|
putStrLn . renderString . layoutPretty defaultLayoutOptions $
|
||||||
|
hsep
|
||||||
|
[ "[info]"
|
||||||
|
, viaShow $ Wai.requestMethod req
|
||||||
|
, viaShow $ Wai.rawPathInfo req
|
||||||
|
, "(" <> pretty (Http.statusCode status) <> ")"
|
||||||
|
]
|
||||||
|
|
||||||
|
settings =
|
||||||
Warp.defaultSettings
|
Warp.defaultSettings
|
||||||
& Warp.setPort options.port
|
& Warp.setPort options.port
|
||||||
& Warp.setLogger
|
& Warp.setLogger logger
|
||||||
( \req status _maybeFileSize ->
|
|
||||||
putStrLn . renderString . layoutPretty defaultLayoutOptions $
|
|
||||||
hsep
|
|
||||||
[ "[info]"
|
|
||||||
, viaShow $ Wai.requestMethod req
|
|
||||||
, viaShow $ Wai.rawPathInfo req
|
|
||||||
, "(" <> pretty (Http.statusCode status) <> ")"
|
|
||||||
]
|
|
||||||
)
|
|
||||||
|
|
||||||
corsPolicy =
|
corsPolicy =
|
||||||
simpleCorsResourcePolicy
|
simpleCorsResourcePolicy
|
||||||
{ -- NOTE: Webpack dev server requires this for CORS workaround.
|
{ -- NOTE: Webpack dev server requires this for CORS workaround.
|
||||||
corsRequestHeaders = "content-type" : corsRequestHeaders simpleCorsResourcePolicy
|
corsRequestHeaders = "content-type" : corsRequestHeaders simpleCorsResourcePolicy
|
||||||
}
|
}
|
||||||
|
|
||||||
corsMiddleware = cors . const $ Just corsPolicy
|
corsMiddleware = cors . const $ Just corsPolicy
|
||||||
|
|
||||||
-- Scripts stay cached for five minutes
|
serverInfo =
|
||||||
query <- cachedForM (Just $ TimeSpec 300 0) (`runQuery` builders)
|
|
||||||
|
|
||||||
let serverInfo =
|
|
||||||
ServerInfo
|
ServerInfo
|
||||||
{ revision = revision
|
{ revision = revision
|
||||||
, exposedBuilders = Builders.toList builders
|
, exposedBuilders = Builders.toList builders
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- Scripts stay cached for five minutes
|
||||||
|
query <- cachedForM (Just $ TimeSpec 300 0) (`runQuery` builders)
|
||||||
|
|
||||||
|
let handler = (\name -> query . ScriptQuery name) :<|> pure serverInfo
|
||||||
|
|
||||||
printf "[info] Running 'agora-scripts' on :%d\n" (Warp.getPort settings)
|
printf "[info] Running 'agora-scripts' on :%d\n" (Warp.getPort settings)
|
||||||
Servant.serve (Proxy @API) (query :<|> pure serverInfo)
|
|
||||||
|
Servant.serve (Proxy @API) handler
|
||||||
& corsMiddleware
|
& corsMiddleware
|
||||||
& Warp.runSettings settings
|
& Warp.runSettings settings
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue