{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoPolyKinds #-}
module Yam.Internal(
startYam
, start
) where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Vault.Lazy as L
import Network.Wai.Handler.Warp
import Servant
import Servant.Server.Internal.ServantErr
import Servant.Swagger
import Yam.Logger
import Yam.Middleware
import Yam.Middleware.Trace
import Yam.Swagger
import Yam.Types
whenException :: SomeException -> Response
whenException e = responseServantErr $ fromMaybe err400 { errBody = B.pack $ show e } (fromException e :: Maybe ServantErr)
startYam
:: forall api. (HasSwagger api, HasServer api '[Env])
=> AppConfig
-> SwaggerConfig
-> LogConfig
-> TraceConfig
-> Version
-> [AppMiddleware]
-> Proxy api
-> ServerT api App
-> IO ()
startYam ac@AppConfig{..} sw@SwaggerConfig{..} logConfig traceConfig vs middlewares proxy server
= withLogger name logConfig $ do
logInfo $ "Start Service [" <> name <> "] ..."
logger <- askLoggerIO
let act = runAM $ foldr1 (<>) (traceMiddleware traceConfig : middlewares)
act (putLogger logger $ Env L.empty Nothing ac) $ \(env, middleware) -> do
let cxt = env :. EmptyContext
pCxt = Proxy :: Proxy '[Env]
portText = showText port
proxy' = Proxy :: Proxy (Vault :> api)
server' = runRequest proxy pCxt server
settings = defaultSettings
& setPort port
& setOnException (\_ _ -> return ())
& setOnExceptionResponse whenException
when enabled $
logInfo $ "Swagger enabled: http://localhost:" <> portText <> "/" <> pack urlDir
logInfo $ "Servant started on port(s): " <> portText
lift $ runSettings settings
$ middleware
$ serveWithContextAndSwagger sw ac vs proxy' cxt
$ hoistServerWithContext proxy' pCxt (transApp env) server'
runRequest :: (HasServer api context) => Proxy api -> Proxy context -> ServerT api App -> Vault -> ServerT api App
runRequest p pc a v = hoistServerWithContext p pc go a
where
{-# INLINE go #-}
go :: App a -> App a
go = local (\env -> env { reqAttributes = Just v})
transApp :: Env -> App a -> Handler a
transApp b c = liftIO $ runApp b c
start
:: forall api. (HasSwagger api, HasServer api '[Env])
=> Properties
-> Version
-> [AppMiddleware]
-> Proxy api
-> ServerT api App
-> IO ()
start p = startYam
(readConfig "yam.application" p)
(readConfig "yam.swagger" p)
(readConfig "yam.logging" p)
(readConfig "yam.trace" p)