-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- FromConfig instance for warp
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
module Conferer.FromConfig.Warp where

import qualified Data.Text as Text
import Data.Dynamic

import Conferer.FromConfig

import Network.Wai.Handler.Warp
import Network.Wai.Handler.Warp.Internal

instance FromConfig HostPreference where
  fromConfig :: Key -> Config -> IO HostPreference
fromConfig = forall a. (Typeable a, IsString a) => Key -> Config -> IO a
fetchFromConfigByIsString

instance FromConfig ProxyProtocol where
  fromConfig :: Key -> Config -> IO ProxyProtocol
fromConfig = forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a
fetchFromConfigWith forall a b. (a -> b) -> a -> b
$
    (\case
      Text
"proxyprotocolnone" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolNone
      Text
"none" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolNone
      Text
"proxyprotocolrequired" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolRequired
      Text
"required" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolRequired
      Text
"proxyprotocoloptional" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolOptional
      Text
"optional" -> forall a. a -> Maybe a
Just ProxyProtocol
ProxyProtocolOptional
      Text
_ -> forall a. Maybe a
Nothing
    ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower

instance DefaultConfig Settings where
  configDef :: Settings
configDef = Settings
defaultSettings

-- | Deconstruct a 'Settings' into a many key/dynamic pairs to
-- provide valid defaults for downstream 'fetchFromConfig'
deconstructSettingsToDefaults :: Settings -> [(Key, Dynamic)]
deconstructSettingsToDefaults :: Settings -> [(Key, Dynamic)]
deconstructSettingsToDefaults Settings{Bool
Port
Maybe Port
Maybe ByteString
Maybe Manager
IO ()
ByteString
HostPreference
ProxyProtocol
Maybe Request -> SomeException -> IO ()
IO () -> IO ()
SomeException -> Response
SockAddr -> IO Bool
SockAddr -> IO ()
Socket -> IO (Socket, SockAddr)
Request -> ByteString -> Integer -> IO ()
Request -> Status -> Maybe Integer -> IO ()
((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsPort :: Settings -> Port
settingsHost :: Settings -> HostPreference
settingsOnException :: Settings -> Maybe Request -> SomeException -> IO ()
settingsOnExceptionResponse :: Settings -> SomeException -> Response
settingsOnOpen :: Settings -> SockAddr -> IO Bool
settingsOnClose :: Settings -> SockAddr -> IO ()
settingsTimeout :: Settings -> Port
settingsManager :: Settings -> Maybe Manager
settingsFdCacheDuration :: Settings -> Port
settingsFileInfoCacheDuration :: Settings -> Port
settingsBeforeMainLoop :: Settings -> IO ()
settingsFork :: Settings -> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsAccept :: Settings -> Socket -> IO (Socket, SockAddr)
settingsNoParsePath :: Settings -> Bool
settingsInstallShutdownHandler :: Settings -> IO () -> IO ()
settingsServerName :: Settings -> ByteString
settingsMaximumBodyFlush :: Settings -> Maybe Port
settingsProxyProtocol :: Settings -> ProxyProtocol
settingsSlowlorisSize :: Settings -> Port
settingsHTTP2Enabled :: Settings -> Bool
settingsLogger :: Settings -> Request -> Status -> Maybe Integer -> IO ()
settingsServerPushLogger :: Settings -> Request -> ByteString -> Integer -> IO ()
settingsGracefulShutdownTimeout :: Settings -> Maybe Port
settingsGracefulCloseTimeout1 :: Settings -> Port
settingsGracefulCloseTimeout2 :: Settings -> Port
settingsMaxTotalHeaderLength :: Settings -> Port
settingsAltSvc :: Settings -> Maybe ByteString
settingsMaxBuilderResponseBufferSize :: Settings -> Port
settingsMaxBuilderResponseBufferSize :: Port
settingsAltSvc :: Maybe ByteString
settingsMaxTotalHeaderLength :: Port
settingsGracefulCloseTimeout2 :: Port
settingsGracefulCloseTimeout1 :: Port
settingsGracefulShutdownTimeout :: Maybe Port
settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
settingsLogger :: Request -> Status -> Maybe Integer -> IO ()
settingsHTTP2Enabled :: Bool
settingsSlowlorisSize :: Port
settingsProxyProtocol :: ProxyProtocol
settingsMaximumBodyFlush :: Maybe Port
settingsServerName :: ByteString
settingsInstallShutdownHandler :: IO () -> IO ()
settingsNoParsePath :: Bool
settingsAccept :: Socket -> IO (Socket, SockAddr)
settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsBeforeMainLoop :: IO ()
settingsFileInfoCacheDuration :: Port
settingsFdCacheDuration :: Port
settingsManager :: Maybe Manager
settingsTimeout :: Port
settingsOnClose :: SockAddr -> IO ()
settingsOnOpen :: SockAddr -> IO Bool
settingsOnExceptionResponse :: SomeException -> Response
settingsOnException :: Maybe Request -> SomeException -> IO ()
settingsHost :: HostPreference
settingsPort :: Port
..} =
  [ (Key
"port", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsPort)
  , (Key
"host", forall a. Typeable a => a -> Dynamic
toDyn HostPreference
settingsHost)
  , (Key
"onException", forall a. Typeable a => a -> Dynamic
toDyn Maybe Request -> SomeException -> IO ()
settingsOnException)
  , (Key
"onExceptionResponse", forall a. Typeable a => a -> Dynamic
toDyn SomeException -> Response
settingsOnExceptionResponse)
  , (Key
"onOpen", forall a. Typeable a => a -> Dynamic
toDyn SockAddr -> IO Bool
settingsOnOpen)
  , (Key
"onClose", forall a. Typeable a => a -> Dynamic
toDyn SockAddr -> IO ()
settingsOnClose)
  , (Key
"timeout", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsTimeout)
  , (Key
"manager", forall a. Typeable a => a -> Dynamic
toDyn Maybe Manager
settingsManager)
  , (Key
"fdCacheDuration", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsFdCacheDuration)
  , (Key
"fileInfoCacheDuration", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsFileInfoCacheDuration)
  , (Key
"beforeMainLoop", forall a. Typeable a => a -> Dynamic
toDyn IO ()
settingsBeforeMainLoop)
#if MIN_VERSION_warp(3,0,4)
  , (Key
"fork", forall a. Typeable a => a -> Dynamic
toDyn forall a b. (a -> b) -> a -> b
$ (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> ForkSettings
ForkSettings ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsFork)
#endif
#if MIN_VERSION_warp(3,3,23)
  , (Key
"accept", forall a. Typeable a => a -> Dynamic
toDyn Socket -> IO (Socket, SockAddr)
settingsAccept)
#endif
#if MIN_VERSION_warp(2,0,3)
  , (Key
"noParsePath", forall a. Typeable a => a -> Dynamic
toDyn Bool
settingsNoParsePath)
#endif
#if MIN_VERSION_warp(3,0,1)
  , (Key
"installShutdownHandler", forall a. Typeable a => a -> Dynamic
toDyn IO () -> IO ()
settingsInstallShutdownHandler)
#endif
#if MIN_VERSION_warp(3,0,2)
  , (Key
"serverName", forall a. Typeable a => a -> Dynamic
toDyn ByteString
settingsServerName)
#endif
#if MIN_VERSION_warp(3,0,3)
  , (Key
"maximumBodyFlush", forall a. Typeable a => a -> Dynamic
toDyn Maybe Port
settingsMaximumBodyFlush)
#endif
#if MIN_VERSION_warp(3,0,5)
  , (Key
"proxyProtocol", forall a. Typeable a => a -> Dynamic
toDyn ProxyProtocol
settingsProxyProtocol)
#endif
#if MIN_VERSION_warp(3,1,2)
  , (Key
"slowlorisSize", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsSlowlorisSize)
#endif
#if MIN_VERSION_warp(3,1,7)
  , (Key
"http2Enabled", forall a. Typeable a => a -> Dynamic
toDyn Bool
settingsHTTP2Enabled)
#endif
#if MIN_VERSION_warp(3,1,10)
  , (Key
"logger", forall a. Typeable a => a -> Dynamic
toDyn Request -> Status -> Maybe Integer -> IO ()
settingsLogger)
#endif
#if MIN_VERSION_warp(3,2,7)
  , (Key
"serverPushLogger", forall a. Typeable a => a -> Dynamic
toDyn Request -> ByteString -> Integer -> IO ()
settingsServerPushLogger)
#endif
#if MIN_VERSION_warp(3,2,8)
  , (Key
"gracefulShutdownTimeout", forall a. Typeable a => a -> Dynamic
toDyn Maybe Port
settingsGracefulShutdownTimeout)
#endif
#if MIN_VERSION_warp(3,3,5)
  , (Key
"gracefulCloseTimeout1", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsGracefulCloseTimeout1)
  , (Key
"gracefulCloseTimeout2", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsGracefulCloseTimeout2)
#endif
#if MIN_VERSION_warp(3,3,8)
  , (Key
"maxTotalHeaderLength", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsMaxTotalHeaderLength)
#endif
#if MIN_VERSION_warp(3,3,11)
  , (Key
"altSvc", forall a. Typeable a => a -> Dynamic
toDyn Maybe ByteString
settingsAltSvc)
#endif
#if MIN_VERSION_warp(3,3,22)
  , (Key
"maxBuilderResponseBufferSize", forall a. Typeable a => a -> Dynamic
toDyn Port
settingsMaxBuilderResponseBufferSize)
#endif
  ]

-- | Newtype wrapper for the 'settingsFork' value that has too much polymorphism
-- to be typeable
newtype ForkSettings = ForkSettings (((forall a. IO a -> IO a) -> IO ()) -> IO ())

instance FromConfig Settings where
  fromConfig :: Key -> Config -> IO Settings
fromConfig Key
key Config
originalConfig = do
    Config
config <- forall a.
Typeable a =>
(a -> [(Key, Dynamic)]) -> Key -> Config -> IO Config
addDefaultsAfterDeconstructingToDefaults Settings -> [(Key, Dynamic)]
deconstructSettingsToDefaults Key
key Config
originalConfig
    Port
settingsPort <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"port") Config
config
    HostPreference
settingsHost <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"host") Config
config
    Maybe Request -> SomeException -> IO ()
settingsOnException <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"onException") Config
config
    SomeException -> Response
settingsOnExceptionResponse <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"onExceptionResponse") Config
config
    SockAddr -> IO Bool
settingsOnOpen <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"onOpen") Config
config
    SockAddr -> IO ()
settingsOnClose <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"onClose") Config
config
    Port
settingsTimeout <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"timeout") Config
config
    Maybe Manager
settingsManager <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"manager") Config
config
    Port
settingsFdCacheDuration <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"fdCacheDuration") Config
config
    Port
settingsFileInfoCacheDuration <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"fileInfoCacheDuration") Config
config
    IO ()
settingsBeforeMainLoop <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"beforeMainLoop") Config
config
#if MIN_VERSION_warp(3,0,4)
    (ForkSettings ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsFork) <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"fork") Config
config
#endif
#if MIN_VERSION_warp(3,3,23)
    Socket -> IO (Socket, SockAddr)
settingsAccept <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"accept") Config
config
#endif
#if MIN_VERSION_warp(2,0,3)
    Bool
settingsNoParsePath <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"noParsePath") Config
config
#endif
#if MIN_VERSION_warp(3,0,1)
    IO () -> IO ()
settingsInstallShutdownHandler <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"installShutdownHandler") Config
config
#endif
#if MIN_VERSION_warp(3,0,2)
    ByteString
settingsServerName <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"serverName") Config
config
#endif
#if MIN_VERSION_warp(3,0,3)
    Maybe Port
settingsMaximumBodyFlush <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"maximumBodyFlush") Config
config
#endif
#if MIN_VERSION_warp(3,0,5)
    ProxyProtocol
settingsProxyProtocol <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"proxyProtocol") Config
config
#endif
#if MIN_VERSION_warp(3,1,2)
    Port
settingsSlowlorisSize <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"slowlorisSize") Config
config
#endif
#if MIN_VERSION_warp(3,1,7)
    Bool
settingsHTTP2Enabled <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"http2Enabled") Config
config
#endif
#if MIN_VERSION_warp(3,1,10)
    Request -> Status -> Maybe Integer -> IO ()
settingsLogger <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"logger") Config
config
#endif
#if MIN_VERSION_warp(3,2,7)
    Request -> ByteString -> Integer -> IO ()
settingsServerPushLogger <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"serverPushLogger") Config
config
#endif
#if MIN_VERSION_warp(3,2,8)
    Maybe Port
settingsGracefulShutdownTimeout <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"gracefulShutdownTimeout") Config
config
#endif
#if MIN_VERSION_warp(3,3,5)
    Port
settingsGracefulCloseTimeout1 <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"gracefulCloseTimeout1") Config
config
    Port
settingsGracefulCloseTimeout2 <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"gracefulCloseTimeout2") Config
config
#endif
#if MIN_VERSION_warp(3,3,8)
    Port
settingsMaxTotalHeaderLength <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"maxTotalHeaderLength") Config
config
#endif
#if MIN_VERSION_warp(3,3,11)
    Maybe ByteString
settingsAltSvc <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"altSvc") Config
config
#endif
#if MIN_VERSION_warp(3,3,22)
    Port
settingsMaxBuilderResponseBufferSize <- forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"maxBuilderResponseBufferSize") Config
config
#endif
    forall (m :: * -> *) a. Monad m => a -> m a
return Settings{Bool
Port
Maybe Port
Maybe ByteString
Maybe Manager
IO ()
ByteString
HostPreference
ProxyProtocol
Maybe Request -> SomeException -> IO ()
IO () -> IO ()
SomeException -> Response
SockAddr -> IO Bool
SockAddr -> IO ()
Socket -> IO (Socket, SockAddr)
Request -> ByteString -> Integer -> IO ()
Request -> Status -> Maybe Integer -> IO ()
((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsMaxBuilderResponseBufferSize :: Port
settingsAltSvc :: Maybe ByteString
settingsMaxTotalHeaderLength :: Port
settingsGracefulCloseTimeout2 :: Port
settingsGracefulCloseTimeout1 :: Port
settingsGracefulShutdownTimeout :: Maybe Port
settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
settingsLogger :: Request -> Status -> Maybe Integer -> IO ()
settingsHTTP2Enabled :: Bool
settingsSlowlorisSize :: Port
settingsProxyProtocol :: ProxyProtocol
settingsMaximumBodyFlush :: Maybe Port
settingsServerName :: ByteString
settingsInstallShutdownHandler :: IO () -> IO ()
settingsNoParsePath :: Bool
settingsAccept :: Socket -> IO (Socket, SockAddr)
settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsBeforeMainLoop :: IO ()
settingsFileInfoCacheDuration :: Port
settingsFdCacheDuration :: Port
settingsManager :: Maybe Manager
settingsTimeout :: Port
settingsOnClose :: SockAddr -> IO ()
settingsOnOpen :: SockAddr -> IO Bool
settingsOnExceptionResponse :: SomeException -> Response
settingsOnException :: Maybe Request -> SomeException -> IO ()
settingsHost :: HostPreference
settingsPort :: Port
settingsPort :: Port
settingsHost :: HostPreference
settingsOnException :: Maybe Request -> SomeException -> IO ()
settingsOnExceptionResponse :: SomeException -> Response
settingsOnOpen :: SockAddr -> IO Bool
settingsOnClose :: SockAddr -> IO ()
settingsTimeout :: Port
settingsManager :: Maybe Manager
settingsFdCacheDuration :: Port
settingsFileInfoCacheDuration :: Port
settingsBeforeMainLoop :: IO ()
settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
settingsAccept :: Socket -> IO (Socket, SockAddr)
settingsNoParsePath :: Bool
settingsInstallShutdownHandler :: IO () -> IO ()
settingsServerName :: ByteString
settingsMaximumBodyFlush :: Maybe Port
settingsProxyProtocol :: ProxyProtocol
settingsSlowlorisSize :: Port
settingsHTTP2Enabled :: Bool
settingsLogger :: Request -> Status -> Maybe Integer -> IO ()
settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
settingsGracefulShutdownTimeout :: Maybe Port
settingsGracefulCloseTimeout1 :: Port
settingsGracefulCloseTimeout2 :: Port
settingsMaxTotalHeaderLength :: Port
settingsAltSvc :: Maybe ByteString
settingsMaxBuilderResponseBufferSize :: Port
..}