yam 0.5.17 → 0.6.0
raw patch · 20 files changed
+593/−641 lines, 20 filesdep −http-clientdep −servant-clientdep ~fast-loggerdep ~menshendep ~salak
Dependencies removed: http-client, servant-client
Dependency ranges changed: fast-logger, menshen, salak, servant-server, unordered-containers
Files
- README.md +21/−4
- src/Data/Opentracing/Tracer.hs +1/−1
- src/Yam.hs +179/−15
- src/Yam/App.hs +75/−0
- src/Yam/Config.hs +26/−0
- src/Yam/Internal.hs +0/−55
- src/Yam/Logger.hs +32/−32
- src/Yam/Middleware.hs +0/−58
- src/Yam/Middleware/Auth.hs +0/−76
- src/Yam/Middleware/Client.hs +0/−47
- src/Yam/Middleware/Default.hs +0/−15
- src/Yam/Middleware/Error.hs +13/−0
- src/Yam/Middleware/Trace.hs +55/−56
- src/Yam/Prelude.hs +129/−0
- src/Yam/Swagger.hs +25/−15
- src/Yam/Types.hs +0/−61
- src/Yam/Types/Env.hs +0/−47
- src/Yam/Types/Prelude.hs +0/−113
- test/Spec.hs +9/−8
- yam.cabal +28/−38
README.md view
@@ -1,19 +1,36 @@ # yam +| package name | version |+|-|-|+| yam |[](https://hackage.haskell.org/package/yam)|+| yam-datasource |[](https://hackage.haskell.org/package/yam-datasource)|+| yam-redis |[](https://hackage.haskell.org/package/yam-redis)|++[](http://stackage.org/lts/package/yam)+[](http://stackage.org/nightly/package/yam)+[](https://travis-ci.org/leptonyu/yam)+ Servant based Web Wrapper for Production in Haskell. ```Haskell -import qualified Data.Salak as S+import Salak+import Salak.Yaml+import Servant import Yam+import qualified Control.Category as C+import Data.Version type API = "hello" :> Get '[PlainText] Text -service :: ServerT API App+service :: ServerT API AppSimple service = return "world" -main = start S.empty [] (Proxy :: Proxy API) service-+main = runSalakWith "app" YAML $ do+ al <- require "yam.application"+ sw <- require "yam.swagger"+ lc <- requireD "yam.logging"+ start al sw (makeVersion []) lc spanNoNotifier emptyAM serveWarp (Proxy @API) service ```
src/Data/Opentracing/Tracer.hs view
@@ -18,7 +18,7 @@ import qualified Data.HashMap.Lazy as HM import Data.Opentracing.Types -- import Data.Time.Clock.POSIX-import Yam.Types.Prelude+import Yam.Prelude type SpanName = Text
src/Yam.hs view
@@ -1,22 +1,186 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE NoPolyKinds #-}+-- |+-- Module: Yam+-- Copyright: (c) 2019 Daniel YU+-- License: BSD3+-- Maintainer: leptonyu@gmail.com+-- Stability: experimental+-- Portability: portable+--+-- A out-of-the-box wrapper of [servant](https://hackage.haskell.org/package/servant-server),+-- providing configuration loader [salak](https://hackage.haskell.org/package/salak) and flexible extension with 'AppMiddleware'.+-- module Yam(- -- * Application- module Yam.Internal- , module Yam.Types+ -- * How to use this library+ -- $use++ -- * Yam Server+ start+ , serveWarp+ -- ** Application Configuration+ , AppConfig(..)+ -- ** Application Context+ , AppT+ , AppV+ , AppIO+ , AppSimple+ , Simple+ , runAppT+ , runVault+ , throwS+ -- ** Application Middleware+ , AppMiddleware(..)+ , emptyAM+ , simpleContext+ , simpleConfig+ , simpleConfig'+ , simpleMiddleware -- * Modules- , module Yam.Logger- , module Yam.Swagger- -- * Middlewares- , module Yam.Middleware- , module Yam.Middleware.Auth- , module Yam.Middleware.Client- , module Yam.Middleware.Trace+ -- ** Logger+ , LogConfig(..)+ , HasLogger+ , LogFuncHolder+ , VaultHolder+ -- ** Context+ , Context(..)+ , HasContextEntry(..)+ , TryContextEntry(..)+ , getEntry+ , tryEntry+ -- ** Swagger+ , SwaggerConfig(..)+ , serveWithContextAndSwagger+ , baseInfo+ -- * Reexport+ , spanNoNotifier+ , Span(..)+ , SpanContext(..)+ , SpanTag(..)+ , SpanReference(..)+ , showText+ , randomString+ , randomCode+ , decodeUtf8+ , encodeUtf8+ , pack+ , liftIO+ , fromMaybe+ , throw ) where -import Yam.Internal+import qualified Control.Category as C+import Control.Monad.Logger.CallStack+import Data.Opentracing+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.Auth-import Yam.Middleware.Client+import Yam.Middleware.Error import Yam.Middleware.Trace+import Yam.Prelude import Yam.Swagger-import Yam.Types++-- | Application Middleware.+newtype AppMiddleware a b = AppMiddleware+ { runAM :: Context a -> Middleware -> (Context b -> Middleware -> LoggingT IO ()) -> LoggingT IO () }++instance C.Category AppMiddleware where+ id = AppMiddleware $ \a m f -> f a m+ (AppMiddleware fbc) . (AppMiddleware fab) = AppMiddleware $ \a m f -> fab a m $ \b m1 -> fbc b m1 f++-- | Simple Application Middleware, just provide a config to context.+simpleContext :: a -> AppMiddleware cxt (a ': cxt)+simpleContext a = AppMiddleware $ \c m f -> f (a :. c) m++-- | Simple Application Middleware, just provide a config to context.+simpleConfig' :: (HasSalak cxt, FromProp a) => Text -> (a -> AppT cxt (LoggingT IO) b) -> AppMiddleware cxt (b ': cxt)+simpleConfig' key g = AppMiddleware $ \c m f -> runAppT c (require key) >>= \a -> runAppT c (g a) >>= \b -> f (b :. c) m++-- | Simple Application Middleware, just provide a config to context.+simpleConfig :: (HasSalak cxt, FromProp a) => Text -> AppMiddleware cxt (a ': cxt)+simpleConfig key = simpleConfig' key return++-- | Simple Application Middleware, promote a 'Middleware' to 'AppMiddleware'+simpleMiddleware :: Middleware -> AppMiddleware cxt cxt+simpleMiddleware m = AppMiddleware $ \c m2 f -> f c (m . m2)++-- | Standard Starter of Yam.+start+ :: forall api cxt+ . ( HasServer api cxt+ , HasSwagger api)+ => AppConfig -- ^ Application Config+ -> SwaggerConfig -- ^ SwaggerConfig+ -> Version -- ^ Application Version+ -> IO LogConfig -- ^ Logger Config+ -> (Span -> AppV cxt IO ()) -- ^ Opentracing notifier+ -> AppMiddleware Simple cxt -- ^ Application Middleware+ -> (AppConfig -> Application -> IO ()) -- ^ Run Application+ -> Proxy api -- ^ Application API Proxy+ -> ServerT api (AppV cxt IO) -- ^ Application API Server+ -> IO ()+start ac@AppConfig{..} sw@SwaggerConfig{..} vs logConfig f am runHttp p api =+ withLogger name logConfig $ \logger -> do+ logInfo $ "Start Service [" <> name <> "] ..."+ let portText = showText port+ baseCxt = LF logger :. EmptyContext+ runAM am baseCxt id $ \cxt middleware -> do+ when enabled $+ logInfo $ "Swagger enabled: http://localhost:" <> portText <> "/" <> pack urlDir+ logInfo $ "Servant started on port(s): " <> portText+ liftIO+ $ runHttp ac+ $ traceMiddleware (\v -> runAppT (VH v :. cxt) . f)+ $ middleware+ $ errorMiddleware baseCxt+ $ serveWithContextAndSwagger sw (baseInfo hostname name vs port) (Proxy @(Vault :> api)) cxt+ $ \v -> hoistServerWithContext p (Proxy @cxt) (nt cxt v) api++-- | default http server by warp.+serveWarp :: AppConfig -> Application -> IO ()+serveWarp AppConfig{..} = runSettings+ $ defaultSettings+ & setPort port+ & setOnException (\_ _ -> return ())+ & setOnExceptionResponse whenException+ & setSlowlorisSize slowlorisSize++-- | Empty span notifier.+spanNoNotifier :: Span -> AppV cxt IO ()+spanNoNotifier _ = return ()++-- | Empty Application Middleware.+emptyAM :: AppMiddleware cxt cxt+emptyAM = C.id++-- | Simple Application context+type Simple = '[LogFuncHolder]++-- | Simple Application with logger context.+type AppSimple = AppV Simple IO+++-- $use+--+-- > import Salak+-- > import Salak.Yaml+-- > import Servant+-- > import Yam+-- > import qualified Control.Category as C+-- > import Data.Version+-- >+-- > type API = "hello" :> Get '[PlainText] Text+-- >+-- > service :: ServerT API AppSimple+-- > service = return "world"+-- >+-- > main = runSalakWith "app" YAML $ do+-- > al <- require "yam.application"+-- > sw <- require "yam.swagger"+-- > lc <- requireD "yam.logging"+-- > start al sw (makeVersion []) lc spanNoNotifier emptyAM serveWarp (Proxy @API) service+
+ src/Yam/App.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+module Yam.App where++import Control.Monad.IO.Unlift+import Control.Monad.Logger.CallStack+import Control.Monad.Reader+import Data.Menshen+import Salak+import Servant+import Yam.Logger+import Yam.Prelude++-- | Application Context Monad.+newtype AppT cxt m a = AppT { runAppT' :: ReaderT (Context cxt) m a } deriving (Functor, Applicative, Monad)++-- | Application on IO.+type AppIO cxt = AppT cxt IO++-- | Application with 'Vault'+type AppV cxt = AppT (VaultHolder : cxt)++instance MonadTrans (AppT cxt) where+ lift = AppT . lift++instance MonadIO m => MonadIO (AppT cxt m) where+ liftIO = AppT . liftIO++instance Monad m => MonadReader (Context cxt) (AppT cxt m) where+ ask = AppT ask+ local f (AppT a) = AppT $ local f a++instance MonadUnliftIO m => MonadUnliftIO (AppT cxt m) where+ askUnliftIO = do+ cxt <- ask+ uio <- lift askUnliftIO+ return (UnliftIO $ unliftIO uio . runAppT cxt)++instance (HasLogger cxt, MonadIO m) => HasValid (AppT cxt m) where+ invalid a = throwS err400 (pack $ toI18n a)++instance (HasLogger cxt, MonadIO m) => MonadLogger (AppT cxt m) where+ monadLoggerLog a b c d = do+ f <- getEntry+ v <- tryEntry+ liftIO $ getLogger v f a b c (toLogStr d)++instance (HasLogger cxt, MonadIO m) => MonadLoggerIO (AppT cxt m) where+ askLoggerIO = do+ f <- getEntry+ v <- tryEntry+ return (getLogger v f)++-- | Get entry from 'AppT'+getEntry :: (HasContextEntry cxt entry, Monad m) => AppT cxt m entry+getEntry = asks getContextEntry++-- | Try get entry from 'AppT'+tryEntry :: (TryContextEntry cxt entry, Monad m) => AppT cxt m (Maybe entry)+tryEntry = asks tryContextEntry++-- | Run Application with context.+runAppT :: Context cxt -> AppT cxt m a -> m a+runAppT c a = runReaderT (runAppT' a) c++instance (HasContextEntry cxt SourcePack, Monad m) => HasSourcePack (AppT cxt m) where+ askSourcePack = getEntry++type HasSalak cxt = HasContextEntry cxt SourcePack++-- | Run Application with 'Vault'.+runVault :: MonadIO m => Context cxt -> Vault -> AppV cxt IO a -> m a+runVault c v a = liftIO $ runAppT (VH v :. c) a++nt :: Context cxt -> Vault -> AppV cxt IO a -> Handler a+nt = runVault
+ src/Yam/Config.hs view
@@ -0,0 +1,26 @@+module Yam.Config(+ AppConfig(..)+ , module Network.Wai.Handler.Warp+ ) where++import Network.Wai.Handler.Warp+import Salak+import Yam.Prelude++-- | Application Configuration.+data AppConfig = AppConfig+ { name :: Text -- ^ Application name.+ , hostname :: String -- ^ Applicatoin hostname, used in swagger.+ , port :: Int -- ^ Application http port.+ , slowlorisSize :: Int -- ^ Slowloris size in Bytes, show in 'Settings'+ } deriving (Eq, Show)++instance Default AppConfig where+ def = AppConfig "application" "localhost" 8888 2048++instance FromProp AppConfig where+ fromProp = AppConfig+ <$> "name" .?: name+ <*> "host" .?: hostname+ <*> "port" .?: port+ <*> "slowloris-size" .?: slowlorisSize
− src/Yam/Internal.hs
@@ -1,55 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE NoPolyKinds #-}-module Yam.Internal(- -- * Application Functions- startYam- ) where--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})--
src/Yam/Logger.hs view
@@ -1,21 +1,22 @@-{-# LANGUAGE ImplicitParams #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Yam.Logger( -- * Logger Function withLogger- , putLogger- , setExtendLog , getLogger , extensionLogKey- , throwS , LogConfig(..)+ , HasLogger+ , LogFuncHolder(..)+ , VaultHolder(..) ) where +import Control.Monad.Logger.CallStack+import qualified Data.Vault.Lazy as L+import Data.Word import Salak-import qualified Data.Vault.Lazy as L-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafePerformIO) import System.Log.FastLogger-import Yam.Types.Env-import Yam.Types.Prelude+import Yam.Prelude instance FromEnumProp LogLevel where fromEnumProp "debug" = Right LevelDebug@@ -32,12 +33,13 @@ toStr LevelError = "ERROR" toStr (LevelOther l) = toLogStr l +-- | Logger config data LogConfig = LogConfig- { bufferSize :: Word16- , file :: FilePath- , maxSize :: Word32- , rotateHistory :: Word16- , level :: LogLevel+ { bufferSize :: Word16 -- ^ Logger buffer size.+ , file :: FilePath -- ^ Logger file path.+ , maxSize :: Word32 -- ^ Max logger file size.+ , rotateHistory :: Word16 -- ^ Max number of logger files should be reserved.+ , level :: LogLevel -- ^ Log level to show. } deriving (Eq, Show) instance Default LogConfig where@@ -68,31 +70,29 @@ let locate = if ll /= LevelError then "" else " @" <> toLogStr loc_filename <> toLogStr (show loc_start) in toLogStr t <> " " <> toStr ll <> xn <> toLogStr loc_module <> locate <> " - " <> s <> "\n" -withLogger :: Text -> IO LogConfig -> LoggingT IO a -> IO a-withLogger n lc action = bracket (newLogger n lc) snd $ \(f,_) -> runLoggingT action f+withLogger :: Text -> IO LogConfig -> (LogFunc -> LoggingT IO a) -> IO a+withLogger n lc action = bracket (newLogger n lc) snd $ \(f,_) -> runLoggingT (askLoggerIO >>= action) f addTrace :: LogFunc -> Text -> LogFunc addTrace f tid a b c d = let p = "[" <> toLogStr tid <> "] " in f a b c (p <> d) -{-# NOINLINE loggerKey #-}-loggerKey :: L.Key LogFunc-loggerKey = unsafePerformIO newKey- {-# NOINLINE extensionLogKey #-} extensionLogKey :: L.Key Text-extensionLogKey = unsafePerformIO newKey--setExtendLog :: (Text -> Text) -> Env -> Env-setExtendLog f env = let mt = fromMaybe "" $ getAttr extensionLogKey env in setAttr extensionLogKey (f mt) env--putLogger :: LogFunc -> Env -> Env-putLogger = setAttr loggerKey+extensionLogKey = unsafePerformIO L.newKey -getLogger :: Env -> LogFunc-getLogger env =- let trace :: Maybe Text = getAttr extensionLogKey env- logger :: Maybe LogFunc = getAttr loggerKey env- {-# INLINE nlf #-}+getLogger :: Maybe VaultHolder -> LogFuncHolder -> LogFunc+getLogger (Just (VH vault)) (LF logger) =+ let {-# INLINE nlf #-} nlf x (Just t) = addTrace x t nlf x _ = x- in maybe (\_ _ _ _ -> return ()) (`nlf` trace) logger+ in nlf logger $ L.lookup extensionLogKey vault+getLogger _ (LF logger) = logger++-- | Holder for 'LogFunc'+newtype LogFuncHolder = LF LogFunc+-- | Holder for 'Vault'+newtype VaultHolder = VH L.Vault++-- | Context with logger.+type HasLogger cxt = (HasContextEntry cxt LogFuncHolder, TryContextEntry cxt VaultHolder)+
− src/Yam/Middleware.hs
@@ -1,58 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ImplicitParams #-}-module Yam.Middleware(- AppMiddleware(..)- , simpleAppMiddleware- , simpleWebMiddleware- , simplePoolMiddleware- , runMiddleware- ) where--import Yam.Logger-import Yam.Types---- | Application Middleware-newtype AppMiddleware = AppMiddleware {runAM :: Env -> ((Env, Middleware)-> LoggingT IO ()) -> LoggingT IO ()}--instance Monoid AppMiddleware where- mempty = AppMiddleware $ \a f -> f (a,id)-#if __GLASGOW_HASKELL__ >= 804-instance Semigroup AppMiddleware where- (<>) = _append-#else- mappend = _append-#endif---_append (AppMiddleware am) (AppMiddleware bm) = AppMiddleware $ \e f -> am e $ \(e', mw) -> bm e' $ \(e'',mw') -> f (e'', mw . mw')---- | Simple AppMiddleware-simpleAppMiddleware :: HasCallStack => (Bool, Text) -> Key a -> a -> AppMiddleware-simpleAppMiddleware (enabled,amname) k v =- v `seq` if enabled- then AppMiddleware $ \e f -> do- logInfoCS ?callStack $ "app:" <> amname <> " enabled"- f (setAttr k v e, id)- else mempty--simpleWebMiddleware :: HasCallStack => (Bool, Text) -> Middleware -> AppMiddleware-simpleWebMiddleware (enabled,amname) m =- if enabled- then AppMiddleware $ \e f -> do- logInfoCS ?callStack $ "web:" <> amname <> " enabled"- f (e,m)- else mempty--simplePoolMiddleware :: HasCallStack => (Bool, Text) -> Key a -> App a -> (a -> App ()) -> AppMiddleware-simplePoolMiddleware (enabled, amname) key open close =- if enabled- then AppMiddleware $ \e f -> do- logInfoCS ?callStack $ "pool:" <> amname <> " enabled"- lf <- askLoggerIO- liftIO $ bracket (runApp e open) (runApp e . close) $ \a -> runLoggingT (f (setAttr key a e, id)) lf- else mempty--runMiddleware :: MonadIO m => AppMiddleware -> App a -> m ()-runMiddleware (AppMiddleware f) a = liftIO $ withLogger "test" def $ do- lf <- askLoggerIO- f (putLogger lf def) $ \(e,_) -> liftIO $ void $ runApp e a
− src/Yam/Middleware/Auth.hs
@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}-module Yam.Middleware.Auth(- -- * Auth Middleware- authAppMiddleware- , CheckAuth- , HasAuthKey(..)- , AuthChecker(..)- ) where-import Control.Lens-import Data.Swagger-import qualified Data.Vault.Lazy as L-import Servant-#if MIN_VERSION_servant_server(0,16,0)-import Servant.Server.Internal.Delayed-import Servant.Server.Internal.DelayedIO-#else-import Servant.Server.Internal.RoutingApplication-#endif-import Servant.Swagger-import Servant.Swagger.Internal-import System.IO.Unsafe (unsafePerformIO)-import Yam.Logger-import Yam.Middleware-import Yam.Types--data CheckAuth (principal :: *)--newtype AuthChecker principal = AuthChecker { runCheckAuth :: Request -> App principal }--instance Default (AuthChecker principal) where- def = AuthChecker $ \_ -> throwS err401 "No Auth Checker"--class HasAuthKey principal where- authKey :: Key (AuthChecker principal)- authKey = unsafePerformIO newKey- toLog :: principal -> Text--instance ( HasContextEntry context Env- , HasServer api context- , HasAuthKey principal)- => HasServer (CheckAuth principal :> api) context where- type ServerT (CheckAuth principal :> api) m = principal -> ServerT api m- hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s- route _ context server = route (Proxy :: Proxy api) context $ server `addFixAuthCheck` authCheck- where- env :: Env- env = getContextEntry context- checker :: Request -> App principal- checker = runCheckAuth $ reqAttr authKey env- authCheck :: DelayedIO principal- authCheck = withRequest $ \req -> liftIO $ runApp env { reqAttributes = Just (vault req)} (checker req)- -- Fix Origin `addAuthCheck`, add logger info- addFixAuthCheck- :: Delayed env (principal -> b)- -> DelayedIO principal- -> Delayed env b- addFixAuthCheck Delayed{..} new =- Delayed- { authD = (,) <$> authD <*> new- , serverD = \ c p h (y, v) b req -> ($ v) <$> serverD c p h y b req { vault = L.adjust (\x -> x <> "," <> toLog v) extensionLogKey $ vault req}- , ..- }--instance (HasSwagger api, ToParamSchema principal) => HasSwagger (CheckAuth principal :> api) where- toSwagger _ = toSwagger (Proxy :: Proxy api)- & addParam param- where- param = mempty- & Data.Swagger.name .~ "Authorization"- & required ?~ True- & schema .~ ParamOther (mempty- & in_ .~ ParamHeader- & paramSchema .~ toParamSchema (Proxy :: Proxy principal))--authAppMiddleware :: HasAuthKey principal => AuthChecker principal -> AppMiddleware-authAppMiddleware = simpleAppMiddleware (True, "Auth Plugin") authKey
− src/Yam/Middleware/Client.hs
@@ -1,47 +0,0 @@-module Yam.Middleware.Client(- -- * Client Middleware- ClientConfig(..)- , runClient- , clientMiddleware- , parseBaseUrl- , BaseUrl- ) where--import qualified Data.Vault.Lazy as L-import Network.HTTP.Client-import Salak-import Servant.Client-import System.IO.Unsafe (unsafePerformIO)-import Yam.Middleware-import Yam.Types--data ClientConfig = ClientConfig- { enabled :: Bool- } deriving (Eq, Show)--instance Default ClientConfig where- def = ClientConfig True--instance FromProp ClientConfig where- fromProp = ClientConfig <$> "enabled" .?: enabled--{-# NOINLINE managerKey #-}-managerKey :: L.Key Manager-managerKey = unsafePerformIO newKey--clientMiddleware :: ClientConfig -> AppMiddleware-clientMiddleware ClientConfig{..} = AppMiddleware $ \e f -> do- mg <- liftIO $ newManager defaultManagerSettings { managerModifyRequest = go e}- f (setAttr managerKey mg e, id)- where- go env req = do- runApp env $ logDebug $ showText req- return req--runClient :: ClientM a -> BaseUrl -> App a-runClient action url = do- mg <- requireAttr managerKey- c <- liftIO $ runClientM action $ mkClientEnv mg url- case c of- Left e -> throw e- Right a -> return a
− src/Yam/Middleware/Default.hs
@@ -1,15 +0,0 @@-module Yam.Middleware.Default(- -- * Default Middleware- defaultMiddleware- ) where--import Yam.Middleware-import Yam.Middleware.Client-import Yam.Middleware.Trace-import Yam.Types.Prelude--defaultMiddleware :: [AppMiddleware]-defaultMiddleware =- [ traceMiddleware def- , clientMiddleware def- ]
+ src/Yam/Middleware/Error.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Yam.Middleware.Error where++import Network.Wai+import Servant+import Yam.App+import Yam.Logger+import Yam.Prelude++errorMiddleware :: HasLogger cxt => Context cxt -> Middleware+errorMiddleware cxt app req resH = app req resH `catch` (\e -> go e >> resH (whenException e))+ where+ go = runVault cxt (vault req) . logError . showText
src/Yam/Middleware/Trace.hs view
@@ -1,8 +1,8 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module Yam.Middleware.Trace( -- * Trace Middleware- MonadTracer(..)- , MonadTracing(..)- , TraceConfig(..)+ TraceConfig(..)+ , Span(..) , hTraceId , hParentTraceId , hSpanId@@ -10,15 +10,19 @@ , traceMiddleware ) where -import qualified Data.HashMap.Lazy as HM+import Control.Monad.State+import Data.Default+import qualified Data.HashMap.Lazy as HM import Data.Opentracing-import qualified Data.Text as T-import qualified Data.Vault.Lazy as L+import qualified Data.Text as T+import qualified Data.Vault.Lazy as L+import Network.HTTP.Types+import Network.Wai import Salak-import System.IO.Unsafe (unsafePerformIO)+import Servant+import System.IO.Unsafe (unsafePerformIO) import Yam.Logger-import Yam.Middleware-import Yam.Types+import Yam.Prelude data TraceConfig = TraceConfig { enabled :: Bool@@ -40,30 +44,13 @@ instance Default TraceConfig where def = TraceConfig True NoTracer -notifier :: TraceNotifyType -> Span -> App ()-notifier _ _ = return ()- {-# NOINLINE spanContextKey #-} spanContextKey :: L.Key SpanContext-spanContextKey = unsafePerformIO newKey+spanContextKey = unsafePerformIO L.newKey {-# NOINLINE spanKey #-} spanKey :: L.Key Span-spanKey = unsafePerformIO newKey--instance MonadTracer App where- askSpanContext = requireAttr spanContextKey--instance MonadTracing App where- runInSpan name notify action = do- s <- askAttr spanKey- n <- case s of- Just sp -> newChildSpan name sp- _ -> newSpan name- notify n- a <- withAttr spanKey n $ action n- finishSpan n >>= notify- return a+spanKey = unsafePerformIO L.newKey hTraceId :: HeaderName hTraceId = "X-B3-TraceId"@@ -77,45 +64,57 @@ hSampled :: HeaderName hSampled = "X-B3-Sampled" -parseSpan :: RequestHeaders -> Env -> IO Env-parseSpan headers env =- let sc = fromMaybe (SpanContext "" HM.empty) $ getAttr spanContextKey env+parseSpan :: RequestHeaders -> Vault -> IO Vault+parseSpan headers vault =+ let sc = fromMaybe (SpanContext "" HM.empty) $ L.lookup spanContextKey vault in case Prelude.lookup hTraceId headers of Just tid -> let sc' = sc { traceId = tid }- in return $ env- & setAttr spanContextKey sc'- & go (fromMaybe (traceId sc') $ Prelude.lookup hSpanId headers) sc'+ in return $ vault+ & L.insert spanContextKey sc'+ & go (fromMaybe tid $ Prelude.lookup hSpanId headers) sc' _ -> do c <- newContext- return $ setAttr spanContextKey c env+ return $ L.insert spanContextKey c vault where- go spanId context env' =+ go spanId context vault' = let name = "-" startTime = undefined finishTime = Nothing tags = HM.empty logs = HM.empty references = []- in setAttr spanKey Span{..} env'+ in L.insert spanKey Span{..} vault' -traceMw :: Env -> (Span -> App ()) -> Middleware-traceMw env' notify app req resH = do- env <- parseSpan (requestHeaders req) env'- runApp env $- runInSpan (decodeUtf8 (requestMethod req) <> " /" <> T.intercalate "/" (pathInfo req)) notify $ \s@Span{..} -> do- let SpanContext{..} = context- tid = decodeUtf8 $ traceId <> "," <> spanId- v = L.insert extensionLogKey tid (vault req)- v' = L.insert spanKey s v- rh' = resH . mapResponseHeaders (\hs -> (hTraceId, traceId):(hSpanId, spanId):hs)- c e = do- runApp env { reqAttributes = Just v} (logError $ showText e)- rh' $ whenException e- liftIO (app req {vault = v'} rh' `catch` c)+instance MonadIO m => MonadTracer (StateT Request m) where+ askSpanContext = do+ req <- get+ v <- liftIO $ parseSpan (requestHeaders req) (vault req)+ put req { vault = v}+ return $ fromJust $ L.lookup spanContextKey v -traceMiddleware :: TraceConfig -> AppMiddleware-traceMiddleware TraceConfig{..}- = AppMiddleware $ \env f -> if enabled- then f (env, traceMw env $ notifier method)- else f (env, id)+instance MonadIO m => MonadTracing (StateT Request m) where+ runInSpan name nt a = do+ req <- get+ n <- case L.lookup spanKey $ vault req of+ Just sp -> newChildSpan name sp+ _ -> newSpan name+ nt n+ a' <- a n+ finishSpan n >>= nt+ return a'++traceMiddleware :: (Vault -> Span -> IO ()) -> Middleware+traceMiddleware notify app req resH = (`evalStateT` req)+ $ runInSpan (decodeUtf8 (requestMethod req) <> " /" <> T.intercalate "/" (pathInfo req)) go+ $ \s@Span{..} -> do+ let SpanContext{..} = context+ tid = decodeUtf8 $ traceId <> "," <> spanId+ v = L.insert extensionLogKey tid (vault req)+ v' = L.insert spanKey s v+ rh' = resH . mapResponseHeaders (\hs -> (hTraceId, traceId):(hSpanId, spanId):hs)+ liftIO (app req {vault = v'} rh')+ where+ go s = do+ req' <- get+ liftIO (notify (vault req') s)
+ src/Yam/Prelude.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImplicitParams #-}++module Yam.Prelude(+ -- * Utilities+ randomString+ , showText+ , throwS+ , randomCode+ , whenException+ -- * Reexport Functions+ , LogFunc+ , Default(..)+ , Text+ , pack+ , HasCallStack+ , MonadError(..)+ , MonadUnliftIO(..)+ , SomeException(..)+ , fromException+ , bracket+ , throw+ , try+ , catch+ , when+ , (<>)+ , LogLevel(..)+ , logInfo+ , logError+ , logWarn+ , logDebug+ , Loc(..)+ , MonadIO(..)+ , HasContextEntry(..)+ , TryContextEntry(..)+ , fromMaybe+ , (&)+ , decodeUtf8+ , encodeUtf8+ , fromJust+ , Version+ , Middleware+ ) where++import Control.Exception hiding (Handler)+import Control.Monad+import Control.Monad.Except+import Control.Monad.IO.Unlift+import Control.Monad.Logger.CallStack+import Data.Aeson+import qualified Data.Binary as B+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base16.Lazy as B16+import qualified Data.ByteString.Lazy as L+import Data.Default+import Data.Function+import Data.Maybe+import Data.Monoid ((<>))+import Data.Text (Text, pack)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.Vector as V+import Data.Version+import Data.Word+import GHC.Stack+import Network.Wai+import Servant+import Servant.Server.Internal.ServerError+import System.IO.Unsafe (unsafePerformIO)+import System.Random.MWC++type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()++{-# NOINLINE randomGen #-}+randomGen :: GenIO+randomGen = unsafePerformIO createSystemRandom++-- | Utility+randomString :: IO ByteString+randomString = L.toStrict . B16.encode . B.encode <$> (uniform randomGen :: IO Word64)++-- | Show text.+{-# INLINE showText #-}+showText :: Show a => a -> Text+showText = pack . show++data WebErrResult = WebErrResult+ { message :: Text+ }++instance ToJSON WebErrResult where+ toJSON WebErrResult{..} = object [ "message" .= message ]++-- | throw 'ServerError' with message+throwS+ :: (HasCallStack, MonadIO m, MonadLogger m)+ => ServerError -- ^ Server error+ -> Text -- ^ message+ -> m a+throwS e msg = do+ logErrorCS ?callStack msg+ liftIO $ throw e { errBody = encode $ WebErrResult msg}++-- | Convert exception to 'Response'+whenException :: SomeException -> Response+whenException e = responseServerError $ fromMaybe err400 { errBody = encode $ WebErrResult $ showText e} (fromException e :: Maybe ServerError)++-- | Utility+randomCode :: V.Vector Char -> Int -> IO String+randomCode seed v = do+ let l = V.length seed+ vs <- replicateM v (uniformR (0, l - 1) randomGen)+ return $ (seed V.!) <$> vs++-- | This class provide a optional supports for get entry from 'Context'.+class TryContextEntry (cxt :: [*]) (entry :: *) where+ tryContextEntry :: Context cxt -> Maybe entry++instance {-# OVERLAPPABLE #-} TryContextEntry as entry => TryContextEntry (a ': as) entry where+ tryContextEntry (_ :. as) = tryContextEntry as++instance {-# OVERLAPPABLE #-} TryContextEntry a entry where+ tryContextEntry _ = Nothing++instance TryContextEntry (entry ': as) entry where+ tryContextEntry (a :. _) = Just a++++
src/Yam/Swagger.hs view
@@ -7,32 +7,35 @@ import Control.Lens hiding (Context) import Data.Reflection-import Salak import Data.Swagger+import Data.Version (showVersion)+import Salak import Servant import Servant.Swagger import Servant.Swagger.UI-import Yam.Types.Prelude+import Yam.Prelude +-- | Swagger Configuration data SwaggerConfig = SwaggerConfig- { urlDir :: String- , urlSchema :: String- , enabled :: Bool+ { urlDir :: String -- ^ Url path for swagger.+ , urlSchema :: String -- ^ Api schema path for swagger.+ , enabled :: Bool -- ^ If enable swagger. } deriving (Eq, Show) instance FromProp SwaggerConfig where fromProp = SwaggerConfig- <$> "dir" .?= "swagger-ui" + <$> "dir" .?= "swagger-ui" <*> "schema" .?= "swagger-ui.json" <*> "enabled" .?= True +-- | Serve with swagger. serveWithContextAndSwagger :: forall api context. (HasSwagger api, HasServer api context)- => SwaggerConfig- -> (Swagger -> Swagger)- -> Proxy api- -> Context context- -> ServerT api Handler+ => SwaggerConfig -- ^ Swagger configuration.+ -> (Swagger -> Swagger) -- ^ Swagger modification.+ -> Proxy api -- ^ Application API Proxy.+ -> Context context -- ^ Application context.+ -> ServerT api Handler -- ^ Application API Server -> Application serveWithContextAndSwagger SwaggerConfig{..} g5 proxy cxt api = if enabled@@ -43,11 +46,18 @@ go :: forall dir schema. Proxy api -> Proxy dir -> Proxy schema -> Proxy (SwaggerSchemaUI dir schema :<|> api) go _ _ _ = Proxy -baseInfo :: Text -> Version -> Int -> Swagger -> Swagger-baseInfo n v p s = s+-- | Swagger modification+baseInfo+ :: String -- ^ Hostname+ -> Text -- ^ Server Name+ -> Version -- ^ Server version+ -> Int -- ^ Port+ -> Swagger -- ^ Old swagger+ -> Swagger+baseInfo hostName n v p s = s & info . title .~ n- & info . version .~ showText v- & host ?~ Host "localhost" (Just $ fromIntegral p)+ & info . version .~ pack (showVersion v)+ & host ?~ Host hostName (Just $ fromIntegral p)
− src/Yam/Types.hs
@@ -1,61 +0,0 @@-module Yam.Types(- -- * App Monad- App- , runApp- , runTestApp- , askApp- , askAttr- , withAttr- , requireAttr- , module Yam.Types.Env- , module Yam.Types.Prelude- ) where--import Data.Menshen-import Servant (err400)-import Yam.Logger-import Yam.Types.Env-import Yam.Types.Prelude--newtype App a = App { runApp' :: ReaderT Env IO a } deriving- ( Functor- , Applicative- , Monad- , MonadIO- , MonadReader Env)--instance HasValid App where- invalid a = throwS err400 (pack $ toI18n a)--runApp :: MonadIO m => Env -> App a -> m a-runApp e a = liftIO $ runReaderT (runApp' a) e--runTestApp :: Key a -> a -> App b -> IO b-runTestApp k v a = runApp def $ withAttr k v a--instance MonadUnliftIO App where- withRunInIO f = do- env <- ask- App $ withRunInIO (\g -> f $ g . lift . runApp env)--instance MonadLogger App where- monadLoggerLog a b c d = do- env <- ask- liftIO $ getLogger env a b c $ toLogStr d--instance MonadLoggerIO App where- askLoggerIO = asks getLogger--askApp :: App AppConfig-askApp = asks application--requireAttr :: Key a -> App a-requireAttr k = fromJust <$> askAttr k--askAttr :: Key a -> App (Maybe a)-askAttr = asks . getAttr--withAttr :: Key a -> a -> App b -> App b-withAttr k v = local (setAttr k v)--
− src/Yam/Types/Env.hs
@@ -1,47 +0,0 @@-module Yam.Types.Env(- -- * Environment- AppConfig(..)- , Env(..)- , getAttr- , reqAttr- , setAttr- ) where--import Salak-import qualified Data.Vault.Lazy as L-import Yam.Types.Prelude--data AppConfig = AppConfig- { name :: Text- , port :: Int- , slowlorisSize :: Int -- Bytes- } deriving (Eq, Show)--instance Default AppConfig where- def = AppConfig "application" 8888 2048--instance FromProp AppConfig where- fromProp = AppConfig- <$> "name" .?: name- <*> "port" .?: port- <*> "slowloris-size" .?: slowlorisSize--data Env = Env- { attributes :: Vault- , reqAttributes :: Maybe Vault- , application :: AppConfig- }--instance Default Env where- def = Env L.empty Nothing def--getAttr :: L.Key a -> Env -> Maybe a-getAttr k Env{..} = (reqAttributes >>= L.lookup k) <|> L.lookup k attributes--reqAttr :: Default a => L.Key a -> Env -> a-reqAttr k = fromMaybe def . getAttr k--setAttr :: L.Key a -> a -> Env -> Env-setAttr k v Env{..} = case reqAttributes of- Just av -> Env attributes (Just $ L.insert k v av) application- _ -> Env (L.insert k v attributes) reqAttributes application
− src/Yam/Types/Prelude.hs
@@ -1,113 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE UndecidableInstances #-}--module Yam.Types.Prelude(- -- * Utilities- randomString- , showText- , throwS- , randomCode- , whenException- -- * Reexport Functions- , LogFunc- , Default(..)- , Text- , pack- , HasCallStack- , MonadError(..)- , MonadUnliftIO(..)- , SomeException(..)- , fromException- , bracket- , throw- , try- , catch- , (<>)- , module Data.Proxy- , module Data.Vault.Lazy- , module Data.Maybe- , module Data.Word- , module Data.Text.Encoding- , module Data.Function- , module Data.Version- , module Control.Applicative- , module Control.Monad- , module Control.Monad.Reader- , module Control.Monad.Logger.CallStack- , module Network.Wai- , module Network.HTTP.Types- ) where--import Control.Applicative-import Control.Exception hiding (Handler)-import Control.Monad-import Control.Monad.Except-import Control.Monad.IO.Unlift-import Control.Monad.Logger.CallStack-import Control.Monad.Reader-import Data.Aeson-import qualified Data.Binary as B-import Data.ByteString (ByteString)-import qualified Data.ByteString.Base16.Lazy as B16-import qualified Data.ByteString.Lazy as L-import Data.Default-import Data.Function-import Data.Maybe-import Data.Monoid ((<>))-import Data.Proxy-import Data.Text (Text, pack)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Vault.Lazy (Key, Vault, newKey)-import qualified Data.Vector as V-import Data.Version-import Data.Word-import GHC.Stack-import Network.HTTP.Types-import Network.Wai-import Servant-import System.IO.Unsafe (unsafePerformIO)-import System.Random.MWC-#if MIN_VERSION_servant_server(0,16,0)-import Servant.Server.Internal.ServerError-type ServantErr = ServerError-responseServantErr = responseServerError-#else-import Servant.Server.Internal.ServantErr-#endif--type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()--{-# NOINLINE randomGen #-}-randomGen :: GenIO-randomGen = unsafePerformIO createSystemRandom---- | Utility-randomString :: IO ByteString-randomString = L.toStrict . B16.encode . B.encode <$> (uniform randomGen :: IO Word64)--{-# INLINE showText #-}-showText :: Show a => a -> Text-showText = pack . show--data WebErrResult = WebErrResult- { message :: Text- }--instance ToJSON WebErrResult where- toJSON WebErrResult{..} = object [ "message" .= message ]--throwS :: (HasCallStack, MonadIO m, MonadLogger m) => ServantErr -> Text -> m a-throwS e msg = do- logErrorCS ?callStack msg- liftIO $ throw e { errBody = encode $ WebErrResult msg}--whenException :: SomeException -> Response-whenException e = responseServantErr $ fromMaybe err400 (fromException e :: Maybe ServantErr)---- | Utility-randomCode :: V.Vector Char -> Int -> IO String-randomCode seed v = do- let l = V.length seed- vs <- sequence $ replicate v $ uniformR (0,l-1) randomGen- return $ (seed V.!) <$> vs
test/Spec.hs view
@@ -7,17 +7,18 @@ import qualified Data.ByteString as B import Test.Hspec import Test.QuickCheck.Monadic-import Yam+import Yam.Prelude +main :: IO () main = hspec spec spec :: Spec spec = do describe "Yam.Config" specConfig--specConfig = do- context "randomTest" $ do- it "random" $ do- monadicIO $ do- s <- run $ randomString- assert (B.length s == 16)+ where+ specConfig = do+ context "randomTest" $ do+ it "random" $ do+ monadicIO $ do+ s <- run $ randomString+ assert (B.length s == 16)
yam.cabal view
@@ -1,13 +1,15 @@ cabal-version: 1.12 name: yam-version: 0.5.17+version: 0.6.0 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU maintainer: Daniel YU <leptonyu@gmail.com> author: Daniel YU-homepage: https://github.com/leptonyu/yam/yam#readme-synopsis: Yam Web+homepage: https://github.com/leptonyu/yam#readme+synopsis: A wrapper of servant+description:+ A out-of-the-box wrapper of [servant](https://hackage.haskell.org/package/servant-server). category: Web build-type: Simple extra-source-files:@@ -17,19 +19,15 @@ library exposed-modules: Yam- Yam.Internal- Yam.Middleware- Yam.Middleware.Default- Yam.Middleware.Auth- Yam.Middleware.Trace- Yam.Middleware.Client- Yam.Swagger- Yam.Types- Yam.Logger hs-source-dirs: src other-modules:- Yam.Types.Prelude- Yam.Types.Env+ Yam.Swagger+ Yam.Logger+ Yam.App+ Yam.Prelude+ Yam.Config+ Yam.Middleware.Trace+ Yam.Middleware.Error Data.Opentracing Data.Opentracing.Types Data.Opentracing.Tracer@@ -47,7 +45,7 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ ghc-options: -Wall build-depends: aeson >=1.4.2.0 && <1.5, base >=4.10 && <5,@@ -55,25 +53,23 @@ binary >=0.8.6.0 && <0.9, bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8,- fast-logger >=2.4.13 && <2.5,- http-client >=0.5.14 && <0.7,+ fast-logger >=2.4.15 && <2.5, http-types >=0.12.3 && <0.13, lens ==4.17.*,- menshen >=0.0.2 && <0.1,+ menshen >=0.0.3 && <0.1, monad-logger >=0.3.30 && <0.4, mtl >=2.2.2 && <2.3, mwc-random >=0.14.0.0 && <0.15, reflection >=2.1.4 && <2.2,- salak >=0.1.10 && <0.3,+ salak >=0.2.9 && <0.3, scientific >=0.3.6.2 && <0.4,- servant-client >=0.15 && <0.17,- servant-server >=0.15 && <0.17,+ servant-server ==0.16.*, servant-swagger >=1.1.7 && <1.2, servant-swagger-ui >=0.3.2.3.19.3 && <0.4, swagger2 >=2.3.1.1 && <2.4, text >=1.2.3.1 && <1.3, unliftio-core >=0.1.2.0 && <0.2,- unordered-containers >=0.2.9.0 && <0.3,+ unordered-containers >=0.2.10.0 && <0.3, vault >=0.3.1.2 && <0.4, vector >=0.12.0.2 && <0.13, wai >=3.2.2 && <3.3,@@ -89,17 +85,13 @@ Data.Opentracing.Tracer Data.Opentracing.Types Yam- Yam.Internal+ Yam.App+ Yam.Config Yam.Logger- Yam.Middleware- Yam.Middleware.Auth- Yam.Middleware.Client- Yam.Middleware.Default+ Yam.Middleware.Error Yam.Middleware.Trace+ Yam.Prelude Yam.Swagger- Yam.Types- Yam.Types.Env- Yam.Types.Prelude Paths_yam default-language: Haskell2010 default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals@@ -114,7 +106,7 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ ghc-options: -Wall build-depends: QuickCheck >=2.12.6.1 && <2.14, aeson >=1.4.2.0 && <1.5,@@ -123,26 +115,24 @@ binary >=0.8.6.0 && <0.9, bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8,- fast-logger >=2.4.13 && <2.5,+ fast-logger >=2.4.15 && <2.5, hspec ==2.*,- http-client >=0.5.14 && <0.7, http-types >=0.12.3 && <0.13, lens ==4.17.*,- menshen >=0.0.2 && <0.1,+ menshen >=0.0.3 && <0.1, monad-logger >=0.3.30 && <0.4, mtl >=2.2.2 && <2.3, mwc-random >=0.14.0.0 && <0.15, reflection >=2.1.4 && <2.2,- salak >=0.1.10 && <0.3,+ salak >=0.2.9 && <0.3, scientific >=0.3.6.2 && <0.4,- servant-client >=0.15 && <0.17,- servant-server >=0.15 && <0.17,+ servant-server ==0.16.*, servant-swagger >=1.1.7 && <1.2, servant-swagger-ui >=0.3.2.3.19.3 && <0.4, swagger2 >=2.3.1.1 && <2.4, text >=1.2.3.1 && <1.3, unliftio-core >=0.1.2.0 && <0.2,- unordered-containers >=0.2.9.0 && <0.3,+ unordered-containers >=0.2.10.0 && <0.3, vault >=0.3.1.2 && <0.4, vector >=0.12.0.2 && <0.13, wai >=3.2.2 && <3.3,