use Capture to make API more neat, update bench

This commit is contained in:
Emily Martins 2022-06-28 21:08:13 +02:00
parent 910416f4ab
commit bc501f291c
2 changed files with 33 additions and 26 deletions

View file

@ -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.

View file

@ -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