{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoPolyKinds #-}
module Yam(
start
, start'
, serveWarp
, AppConfig(..)
, AppT
, AppV
, AppIO
, AppSimple
, Simple
, runAppT
, runVault
, throwS
, AppMiddleware(..)
, emptyAM
, simpleContext
, simpleConfig
, simpleConfig'
, simpleMiddleware
, HealthStatus(..)
, HealthResult(..)
, mergeHealth
, LogConfig(..)
, HasLogger
, LogFuncHolder
, VaultHolder
, Context(..)
, HasContextEntry(..)
, TryContextEntry(..)
, getEntry
, tryEntry
, SwaggerConfig(..)
, serveWithContextAndSwagger
, baseInfo
, SwaggerTag
, spanNoNotifier
, Span(..)
, SpanContext(..)
, SpanTag(..)
, SpanReference(..)
, showText
, randomString
, randomCode
, decodeUtf8
, encodeUtf8
, pack
, liftIO
, fromMaybe
, throw
, logInfo
, logError
, logWarn
, logDebug
, RunSalak(..)
) where
import qualified Control.Category as C
import Control.Monad.IO.Unlift
import Control.Monad.Logger.CallStack
import Data.Opentracing
import Data.Text (pack)
import Network.Wai
import Salak
import Servant
import Servant.Swagger
import Yam.App
import Yam.Config
import Yam.Logger
import Yam.Middleware
import Yam.Middleware.Error
import Yam.Middleware.Trace
import Yam.Prelude
import Yam.Server
import Yam.Server.Health
import Yam.Swagger
start
:: forall file api cxt
. ( HasLoad file
, HasLogger cxt
, HasServer api cxt
, HasSwagger api)
=> String
-> file
-> Version
-> RunSalak (AppMiddleware Simple cxt)
-> Proxy api
-> RunSalak (ServerT api (AppV cxt IO))
-> IO ()
start cfg file = start' (loadSalakFile cfg file)
start'
:: forall api cxt
.(HasLogger cxt
, HasServer api cxt
, HasSwagger api)
=> LoadSalakT IO ()
-> Version
-> RunSalak (AppMiddleware Simple cxt)
-> Proxy api
-> RunSalak (ServerT api (AppV cxt IO))
-> IO ()
start' load ver mkAMD pSer mkSer = loadAndRunSalak load $ do
c <- requireD "logging"
app@AppConfig{..} <- require "application"
sw@SwaggerConfig{..} <- require "swagger"
withLogger name c $ \logger -> unSalak $ do
let portText = showText port
baseCxt = (LF logger :. EmptyContext)
logInfo $ "Start Service [" <> name <> "] ..."
amd <- mkAMD
ser <- mkSer
f <- askUnliftIO
liftX $ runAM amd baseCxt id emptyHealth $ \cxt middleware hr -> lift $ unliftIO f $ do
(en, aep) <- actuatorEndpoint hr
readLogs >>= mapM_ (logInfo . ("Parsing " <>))
when enabled $
logInfo $ "Swagger enabled: http://localhost:" <> portText <> "/" <> pack urlDir
logInfo $ "Servant started on port(s): " <> portText
let go :: forall a. (HasSwagger a, HasServer a cxt) => Proxy a -> ServerT a (AppV cxt IO) -> RunSalak ()
go x y = liftIO
$ serveWarp app
$ traceMiddleware (\v -> runAppT (VH v :. cxt) . spanNoNotifier)
$ middleware
$ errorMiddleware baseCxt
$ serveWithContextAndSwagger sw (baseInfo hostname name ver port) (Proxy @(Vault :> a)) cxt
$ \v -> hoistServerWithContext x (Proxy @cxt) (nt cxt v) y
if en
then go (Proxy @(api :<|> ActuatorEndpoint)) (ser :<|> aep)
else go pSer ser
serveWarp :: AppConfig -> Application -> IO ()
serveWarp AppConfig{..} = runSettings
$ defaultSettings
& setPort port
& setOnException (\_ _ -> return ())
& setOnExceptionResponse whenException
& setSlowlorisSize slowlorisSize
spanNoNotifier :: Span -> AppV cxt IO ()
spanNoNotifier _ = return ()
emptyAM :: AppMiddleware cxt cxt
emptyAM = C.id
type Simple = '[LogFuncHolder]
type AppSimple = AppV Simple IO