conferer-warp 0.2.0.0 → 0.3.0.0

raw patch · 5 files changed

+129/−84 lines, 5 filesdep ~confererPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: conferer

API changes (from Hackage documentation)

Files

• conferer-warp.cabal +7/−7
• src/Conferer/FetchFromConfig/Warp.hs +0/−41
• src/Conferer/FromConfig/Warp.hs +81/−0
• test/Conferer/FetchFromConfig/WarpSpec.hs +0/−36
• test/Conferer/FromConfig/WarpSpec.hs +41/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cd409fb67d42685960b7b08d341f3d9710dc50d8c228737dcf1f15c384ce6011+-- hash: b66887279007cbd1851fac75692ac5191a5f310c143b6ca1073fab9981ce1aa6  name:           conferer-warp-version:        0.2.0.0+version:        0.3.0.0 synopsis:       conferer's FromConfig instances for warp settings  description:    Library to abstract the parsing of many haskell config values from different config sources@@ -25,7 +25,7 @@  library   exposed-modules:-      Conferer.FetchFromConfig.Warp+      Conferer.FromConfig.Warp   other-modules:       Paths_conferer_warp   hs-source-dirs:@@ -33,25 +33,25 @@   default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables   build-depends:       base >=4.3 && <5-    , conferer >=0.2.0.0 && <0.3.0.0+    , conferer >=0.3.0.0 && <0.4.0.0     , http-types >=0.8.6 && <0.13     , text >=1.1 && <1.3     , wai >=3.0 && <4.0     , warp >=3.0 && <4.0   default-language: Haskell2010 -test-suite conferer-warp-test+test-suite specs   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Conferer.FetchFromConfig.WarpSpec+      Conferer.FromConfig.WarpSpec       Paths_conferer_warp   hs-source-dirs:       test   default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables   build-depends:       base >=4.3 && <5-    , conferer >=0.2.0.0 && <0.3.0.0+    , conferer >=0.3.0.0 && <0.4.0.0     , conferer-warp     , hspec     , http-types >=0.8.6 && <0.13

@@ -1,41 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Conferer.FetchFromConfig.Warp-  (-  -- * How to use this-  -- | FetchFromConfig instance for warp server settings-  ---  -- @-  -- import Conferer-  -- import Conferer.FetchFromConfig.Warp ()-  ---  -- main = do-  --   config <- 'defaultConfig' \"awesomeapp\"-  --   warpSettings <- 'getFromConfig' \"warp\" config-  -- @-  ) where--import Conferer.Core-import Conferer.Types-import Conferer.FetchFromConfig.Basics-import Data.Maybe (catMaybes)-import Network.Wai.Handler.Warp-import Data.String (fromString)-import Data.Text (unpack)-import Data.Maybe (fromMaybe)--instance FetchFromConfig HostPreference where-  fetch = fetchFromConfigWith (pure . fromString . unpack)--instance FetchFromConfig Settings where-  fetch k config = do-    port <- fetch (k /. "port") config-    timeout <- fetch (k /. "timeout") config-    host <- fetch (k /. "host") config-    serverName <- fetch (k /. "serverName") config-    let overriders = catMaybes [-                      setTimeout <$> timeout,-                      setHost <$> host,-                      setPort <$> port,-                      setServerName <$> serverName-                    ]-    return $ return $ foldr ($) defaultSettings overriders

@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+module Conferer.FromConfig.Warp+  (+  -- * How to use this+  -- | FromConfig instance for warp server settings+  --+  -- @+  -- import Conferer+  -- import Conferer.FromConfig.Warp ()+  --+  -- main = do+  --   config <- 'defaultConfig' \"awesomeapp\"+  --   warpSettings <- 'getFromConfig' \"warp\" config+  -- @+  ) where++import Conferer.Core+import Conferer.Types+import Conferer.FromConfig.Basics+import Data.Maybe (catMaybes)+import Network.Wai.Handler.Warp+import Network.Wai.Handler.Warp.Internal+import Data.String (fromString)+import Data.Text (unpack)+import Data.Maybe (fromMaybe)++instance FromConfig HostPreference where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigByIsString++instance FromConfig ProxyProtocol where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigWith+    (\text -> case text of+                "ProxyProtocolNone" -> Just ProxyProtocolNone+                "ProxyProtocolRequired" -> Just ProxyProtocolRequired+                "ProxyProtocolOptional" -> Just ProxyProtocolOptional+                _ -> Nothing+    )++instance DefaultConfig Settings where+  configDef = defaultSettings++instance FromConfig Settings where+  fetchFromConfig key config = return Nothing+  updateFromConfig key config settings = do+    pure settings+      >>= findKeyAndApplyConfig config key "port" settingsPort (\v c -> c { settingsPort = v })+      >>= findKeyAndApplyConfig config key "host" settingsHost (\v c -> c { settingsHost = v })+      >>= findKeyAndApplyConfig config key "timeout" settingsTimeout (\v c -> c { settingsTimeout = v })+      >>= findKeyAndApplyConfig config key "fdCacheDuration" settingsFdCacheDuration (\v c -> c { settingsFdCacheDuration = v })+      >>= findKeyAndApplyConfig config key "fileInfoCacheDuration" settingsFileInfoCacheDuration (\v c -> c { settingsFileInfoCacheDuration = v })+#if MIN_VERSION_warp(2,0,3)+      >>= findKeyAndApplyConfig config key "noParsePath" settingsNoParsePath (\v c -> c { settingsNoParsePath = v })+#endif+#if MIN_VERSION_warp(3,0,2)+      >>= findKeyAndApplyConfig config key "serverName" settingsServerName (\v c -> c { settingsServerName = v })+#endif+#if MIN_VERSION_warp(3,0,3)+      >>= findKeyAndApplyConfig config key "maximumBodyFlush" settingsMaximumBodyFlush (\v c -> c { settingsMaximumBodyFlush = v })+#endif+#if MIN_VERSION_warp(3,0,5)+      >>= findKeyAndApplyConfig config key "proxyProtocol" settingsProxyProtocol (\v c -> c { settingsProxyProtocol = v })+#endif+#if MIN_VERSION_warp(3,1,2)+      >>= findKeyAndApplyConfig config key "slowlorisSize" settingsSlowlorisSize (\v c -> c { settingsSlowlorisSize = v })+#endif+#if MIN_VERSION_warp(3,1,7)+      >>= findKeyAndApplyConfig config key "http2Enabled" settingsHTTP2Enabled (\v c -> c { settingsHTTP2Enabled = v })+#endif+#if MIN_VERSION_warp(3,2,8)+      >>= findKeyAndApplyConfig config key "gracefulShutdownTimeout" settingsGracefulShutdownTimeout (\v c -> c { settingsGracefulShutdownTimeout = v })+#endif+#if MIN_VERSION_warp(3,3,5)+      >>= findKeyAndApplyConfig config key "gracefulCloseTimeout1" settingsGracefulCloseTimeout1 (\v c -> c { settingsGracefulCloseTimeout1 = v })+      >>= findKeyAndApplyConfig config key "gracefulCloseTimeout2" settingsGracefulCloseTimeout2 (\v c -> c { settingsGracefulCloseTimeout2 = v })+#endif+#if MIN_VERSION_warp(3,3,8)+      >>= findKeyAndApplyConfig config key "maxTotalHeaderLength" settingsMaxTotalHeaderLength (\v c -> c { settingsMaxTotalHeaderLength = v })+#endif

@@ -1,36 +0,0 @@-module Conferer.FetchFromConfig.WarpSpec where--import           Test.Hspec-import           Conferer.Types-import           Data.Text-import           Conferer-import           Conferer.FetchFromConfig.Warp ()-import           Network.Wai.Handler.Warp--configWith :: [(Key, Text)] -> IO Config-configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)--portAndHostShouldBe :: Maybe Settings -> (Port, HostPreference) -> Expectation-portAndHostShouldBe fetchedSettings (port, host) = do-  getPort <$> fetchedSettings `shouldBe` Just port-  getHost <$> fetchedSettings `shouldBe` Just host--spec :: Spec-spec = do-  let defaultPort = getPort defaultSettings-      defaultHost = getHost defaultSettings-  describe "fetching a warp configuration without overriding anything" $ do-    it "returns warp default config" $ do-      let config = emptyConfig-      fetchedValue <- fetch "." config-      fetchedValue `portAndHostShouldBe` (defaultPort, defaultHost)-  describe "fetching a warp configuration overridnig its port" $ do-    it "returns a warp config with its port set to the overriden one" $ do-      config <- configWith [("warp.port", "9999")]-      fetchedValue <- fetch "warp" config-      fetchedValue `portAndHostShouldBe` (9999, defaultHost)-  describe "fetching a warp configuration overriding its host" $ do-    it "returns a warp config with its host set to the overriden one" $ do-      config <- configWith [("warp.host", "!6")]-      fetchedValue <- fetch "warp" config-      fetchedValue `portAndHostShouldBe` (defaultPort, "!6")

@@ -0,0 +1,41 @@+module Conferer.FromConfig.WarpSpec where++import           Test.Hspec+import           Conferer.Types+import           Data.Text+import           Conferer+import           Conferer.FromConfig.Basics+import           Conferer.FromConfig.Warp ()+import           Network.Wai.Handler.Warp+import           Data.Typeable++configWith :: [(Key, Text)] -> IO Config+configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)++fetch :: (FromConfig a, Typeable a, DefaultConfig a) => Key -> Config -> IO (Maybe a)+fetch = safeGetFromConfig++portAndHostShouldBe :: Maybe Settings -> (Port, HostPreference) -> Expectation+portAndHostShouldBe fetchedSettings (port, host) = do+  getPort <$> fetchedSettings `shouldBe` Just port+  getHost <$> fetchedSettings `shouldBe` Just host++spec :: Spec+spec = do+  let defaultPort = getPort defaultSettings+      defaultHost = getHost defaultSettings+  describe "fetching a warp configuration without overriding anything" $ do+    it "returns warp default config" $ do+      let config = emptyConfig+      fetchedValue <- fetch "." config+      fetchedValue `portAndHostShouldBe` (defaultPort, defaultHost)+  describe "fetching a warp configuration overridnig its port" $ do+    it "returns a warp config with its port set to the overriden one" $ do+      config <- configWith [("warp.port", "9999")]+      fetchedValue <- fetch "warp" config+      fetchedValue `portAndHostShouldBe` (9999, defaultHost)+  describe "fetching a warp configuration overriding its host" $ do+    it "returns a warp config with its host set to the overriden one" $ do+      config <- configWith [("warp.host", "!6")]+      fetchedValue <- fetch "warp" config+      fetchedValue `portAndHostShouldBe` (defaultPort, "!6")