yam 0.5.14 → 0.5.15

raw patch · 9 files changed

+111/−141 lines, 9 filesdep ~http-typesdep ~salakdep ~swagger2PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http-types, salak, swagger2

API changes (from Hackage documentation)

Files

• src/Yam/Internal.hs +34/−42
• src/Yam/Logger.hs +14/−20
• src/Yam/Middleware/Auth.hs +1/−1
• src/Yam/Middleware/Client.hs +3/−4
• src/Yam/Middleware/Trace.hs +7/−10
• src/Yam/Swagger.hs +27/−39
• src/Yam/Types/Env.hs +7/−7
• src/Yam/Types/Prelude.hs +11/−11
• yam.cabal +7/−7

@@ -6,7 +6,7 @@   , start   ) where -import           Data.Salak+import           Salak import qualified Data.Vault.Lazy          as L import           Network.Wai.Handler.Warp import           Servant@@ -28,53 +28,45 @@   -> 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 act = runAM $ foldr1 (<>) ((if enableDefaultMiddleware then defaultMiddleware else []) <> 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-                                 & 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 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})+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 :: Env -> App a -> Handler a-transApp b c = liftIO $ runApp b c+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])-  => Properties+  => PropConfig   -> Version   -> [AppMiddleware]   -> Proxy api   -> ServerT api App   -> IO ()-start p a b c d = do-  (lc,_) <- runLoader p $ (,) <$> load "yam.logging" <*> askSetProperties-  startYam-    (p .>> "yam.application")-    (p .>> "yam.swagger"    )-    lc-    (p .?> "yam.middleware.default.enabled" .|= True)-    a b c d+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+

@@ -10,25 +10,19 @@   , LogConfig(..)   ) where -import           Data.Salak-import qualified Data.Text             as T+import           Salak import qualified Data.Vault.Lazy       as L import           System.IO.Unsafe      (unsafePerformIO) import           System.Log.FastLogger import           Yam.Types.Env import           Yam.Types.Prelude -instance FromProperties LogLevel where-  fromProperties = fromProperties >=> go-    where-      go :: Property -> Return LogLevel-      go (PStr t) = return (gt $ T.toLower t)-      go _        = error "loglevel shoudbe string"-      gt "debug" = LevelDebug-      gt "info"  = LevelInfo-      gt "warn"  = LevelWarn-      gt "error" = LevelError-      gt _       = LevelOther "fatal"+instance FromEnumProp LogLevel where+  fromEnumProp "debug" = Right   LevelDebug+  fromEnumProp "info"  = Right   LevelInfo+  fromEnumProp "warn"  = Right   LevelWarn+  fromEnumProp "error" = Right   LevelError+  fromEnumProp _       = Right $ LevelOther "fatal"  {-# INLINE toStr #-} toStr :: LogLevel -> LogStr@@ -49,13 +43,13 @@ instance Default LogConfig where   def = LogConfig 4096 "" 10485760 256 LevelInfo -instance FromProperties LogConfig where-  fromProperties p = LogConfig-    <$> p .?> "buffer-size" .?= bufferSize    def-    <*> p .?> "file"        .?= file          def-    <*> p .?> "max-size"    .?= maxSize       def-    <*> p .?> "max-history" .?= rotateHistory def-    <*> p .?> "level"       .?= level         def+instance FromProp LogConfig where+  fromProp = LogConfig+    <$> "buffer-size" .?= bufferSize    def+    <*> "file"        .?= file          def+    <*> "max-size"    .?= maxSize       def+    <*> "max-history" .?= rotateHistory def+    <*> "level"       .?= level         def  newLogger :: Text -> IO LogConfig -> IO (LogFunc, IO ()) newLogger name lc = do

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP                  #-}+{-# LANGUAGE CPP #-} module Yam.Middleware.Auth(   -- * Auth Middleware     authAppMiddleware

@@ -7,9 +7,9 @@   , BaseUrl   ) where -import           Data.Salak import qualified Data.Vault.Lazy     as L import           Network.HTTP.Client+import           Salak import           Servant.Client import           System.IO.Unsafe    (unsafePerformIO) import           Yam.Middleware@@ -22,9 +22,8 @@ instance Default ClientConfig where   def = ClientConfig True -instance FromProperties ClientConfig where-  fromProperties p = ClientConfig-    <$> p .?> "enabled" .?= enabled def+instance FromProp ClientConfig where+  fromProp = ClientConfig <$> "enabled" .?= enabled def  {-# NOINLINE managerKey #-} managerKey :: L.Key Manager

@@ -12,9 +12,9 @@  import qualified Data.HashMap.Lazy as HM import           Data.Opentracing-import           Data.Salak import qualified Data.Text         as T import qualified Data.Vault.Lazy   as L+import           Salak import           System.IO.Unsafe  (unsafePerformIO) import           Yam.Logger import           Yam.Middleware@@ -29,16 +29,13 @@   = NoTracer   deriving (Eq, Show) -instance FromProperties TraceNotifyType where-  fromProperties = fromProperties >=> go-    where-      go :: Property -> Return TraceNotifyType-      go _ = return NoTracer+instance FromEnumProp TraceNotifyType where+  fromEnumProp _ = Right NoTracer -instance FromProperties TraceConfig where-  fromProperties p = TraceConfig-    <$> p .?> "enabled" .?= enabled def-    <*> p .?> "type"    .?= method  def+instance FromProp TraceConfig where+  fromProp = TraceConfig+    <$> "enabled" .?= enabled def+    <*> "type"    .?= method  def  instance Default TraceConfig where   def = TraceConfig True NoTracer

@@ -2,18 +2,16 @@ module Yam.Swagger(     SwaggerConfig(..)   , serveWithContextAndSwagger+  , baseInfo   ) where -import           Control.Lens       hiding (Context, Empty, allOf, (.=))+import           Control.Lens       hiding (Context) import           Data.Reflection-import           Data.Salak-import           Data.Swagger       hiding (name, port)-import qualified Data.Swagger       as S-import           GHC.TypeLits+import           Salak+import           Data.Swagger import           Servant import           Servant.Swagger import           Servant.Swagger.UI-import           Yam.Types.Env import           Yam.Types.Prelude  data SwaggerConfig = SwaggerConfig@@ -22,44 +20,34 @@   , enabled   :: Bool   } deriving (Eq, Show) -instance Default SwaggerConfig where-  def = SwaggerConfig "swagger-ui" "swagger-ui.json" True--instance FromProperties SwaggerConfig where-  fromProperties p = SwaggerConfig-    <$> p .?> "dir"     .?= urlDir    def-    <*> p .?> "schema"  .?= urlSchema def-    <*> p .?> "enabled" .?= enabled   def--type SAPI dir schema api = SwaggerSchemaUI dir schema :<|> api+instance FromProp SwaggerConfig where+  fromProp = SwaggerConfig+    <$> "dir"     .?= "swagger-ui" +    <*> "schema"  .?= "swagger-ui.json"+    <*> "enabled" .?= True  serveWithContextAndSwagger-  :: (HasSwagger api, HasServer api context)+  :: forall api context. (HasSwagger api, HasServer api context)   => SwaggerConfig-  -> AppConfig-  -> Version+  -> (Swagger -> Swagger)   -> Proxy api   -> Context context   -> ServerT api Handler   -> Application-serveWithContextAndSwagger SwaggerConfig{..} AppConfig{..} versions proxy cxt api =-    if enabled-      then reifySymbol urlDir $ \pd -> reifySymbol urlSchema $ \ps -> go (pd,ps) proxy cxt api-      else serveWithContext proxy cxt api+serveWithContextAndSwagger SwaggerConfig{..} g5 proxy cxt api =+  if enabled+    then reifySymbol urlDir $ \pd -> reifySymbol urlSchema $ \ps ->+         serveWithContext (go proxy pd ps) cxt (swaggerSchemaUIServer (g5 $ toSwagger proxy) :<|> api)+    else serveWithContext proxy cxt api   where-    go :: (HasSwagger api, HasServer api context, KnownSymbol d, KnownSymbol s)-        => (Proxy d, Proxy s)-        -> Proxy api-        -> Context context-        -> ServerT api Handler-        -> Application-    go pds p c api' = let p' = g2 pds in serveWithContext p' c (g3 p api' p')-    g2 :: (Proxy d, Proxy s) -> Proxy (SAPI d s api)-    g2 _ = Proxy-    g3 :: HasSwagger api => Proxy api -> Server api -> Proxy (SAPI d s api) -> Server (SAPI d s api)-    g3 p a _ = swaggerSchemaUIServer (g4 $ toSwagger p) :<|> a-    g4 s = s-      & info .~ (mempty-          & title   .~ (name <> " API Documents")-          & S.version .~ pack (showVersion versions))-      & host ?~ Host "localhost" (Just $ fromIntegral port)+    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+  & info . title   .~ n+  & info . version .~ showText v+  & host ?~ Host "localhost" (Just $ fromIntegral p)+++

@@ -7,7 +7,7 @@   , setAttr   ) where -import           Data.Salak+import           Salak import qualified Data.Vault.Lazy   as L import           Yam.Types.Prelude @@ -17,14 +17,14 @@   , slowlorisSize :: Int -- Bytes   } deriving (Eq, Show) -instance FromProperties AppConfig where-  fromProperties p = AppConfig-    <$> p .?> "name"           .?= name def-    <*> p .?> "port"           .?= port def-    <*> p .?> "slowloris-size" .?= slowlorisSize def- instance Default AppConfig where   def = AppConfig "application" 8888 2048++instance FromProp AppConfig where+  fromProp = AppConfig+    <$> "name"           .?= name def+    <*> "port"           .?= port def+    <*> "slowloris-size" .?= slowlorisSize def  data Env = Env   { attributes    :: Vault

@@ -40,33 +40,33 @@   ) where  import           Control.Applicative-import           Control.Exception                  hiding (Handler)+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 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.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.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.IO.Unsafe               (unsafePerformIO) import           System.Random.MWC #if MIN_VERSION_servant_server(0,16,0) import           Servant.Server.Internal.ServerError

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: yam-version: 0.5.14+version: 0.5.15 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -57,20 +57,20 @@         data-default >=0.7.1.1 && <0.8,         fast-logger >=2.4.13 && <2.5,         http-client >=0.5.14 && <0.7,-        http-types >=0.12.2 && <0.13,+        http-types >=0.12.3 && <0.13,         lens ==4.17.*,         menshen >=0.0.1 && <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.8 && <0.3,+        salak >=0.1.10 && <0.3,         scientific >=0.3.6.2 && <0.4,         servant-client >=0.15 && <0.17,         servant-server >=0.15 && <0.17,         servant-swagger >=1.1.7 && <1.2,         servant-swagger-ui >=0.3.2.3.19.3 && <0.4,-        swagger2 >=2.3.1 && <2.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,@@ -126,20 +126,20 @@         fast-logger >=2.4.13 && <2.5,         hspec ==2.*,         http-client >=0.5.14 && <0.7,-        http-types >=0.12.2 && <0.13,+        http-types >=0.12.3 && <0.13,         lens ==4.17.*,         menshen >=0.0.1 && <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.8 && <0.3,+        salak >=0.1.10 && <0.3,         scientific >=0.3.6.2 && <0.4,         servant-client >=0.15 && <0.17,         servant-server >=0.15 && <0.17,         servant-swagger >=1.1.7 && <1.2,         servant-swagger-ui >=0.3.2.3.19.3 && <0.4,-        swagger2 >=2.3.1 && <2.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,