{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoPolyKinds #-}
module Yam.Internal(
startYam
, start
) where
import Salak
import qualified Data.Vault.Lazy as L
import Network.Wai.Handler.Warp
import Servant
import Servant.Swagger
import Yam.Logger
import Yam.Middleware
import Yam.Middleware.Default
import Yam.Swagger
import Yam.Types
startYam
:: forall api. (HasSwagger api, HasServer api '[Env])
=> AppConfig
-> SwaggerConfig
-> IO LogConfig
-> Bool
-> Version
-> [AppMiddleware]
-> Proxy api
-> ServerT api App
-> IO ()
startYam ac@AppConfig{..} sw@SwaggerConfig{..} logConfig enableDefaultMiddleware vs middlewares proxy server =
withLogger name logConfig $ do
logInfo $ "Start Service [" <> name <> "] ..."
logger <- askLoggerIO
let at = runAM $ foldr1 (<>) ((if enableDefaultMiddleware then defaultMiddleware else []) <> middlewares)
at (putLogger logger $ Env L.empty Nothing ac) $ \(env, middleware) -> do
let cxt = env :. EmptyContext
pCxt = Proxy @'[Env]
portText = showText port
settings = defaultSettings
& setPort port
& setOnException (\_ _ -> return ())
& setOnExceptionResponse whenException
& setSlowlorisSize slowlorisSize
when enabled $
logInfo $ "Swagger enabled: http://localhost:" <> portText <> "/" <> pack urlDir
logInfo $ "Servant started on port(s): " <> portText
lift
$ runSettings settings
$ middleware
$ serveWithContextAndSwagger sw (baseInfo name vs port) (Proxy @(Vault :> api)) cxt
$ \v -> hoistServerWithContext proxy pCxt (transApp v env) server
transApp :: Vault -> Env -> App a -> Handler a
transApp v b = liftIO . runApp b . local (\env -> env { reqAttributes = Just v})
start
:: forall api. (HasSwagger api, HasServer api '[Env])
=> PropConfig
-> Version
-> [AppMiddleware]
-> Proxy api
-> ServerT api App
-> IO ()
start p a b c d = defaultLoadSalak p $ do
al <- require "yam.application"
sw <- require "yam.swagger"
md <- require "yam.middleware.default.enabled" .?= True
reloadable $ do
lc <- requireD "yam.logging"
liftIO $ startYam al sw lc md a b c d