module IHP.FrameworkConfig where

import IHP.Prelude
import System.Directory (getCurrentDirectory)
import IHP.Environment
import qualified Data.Text as Text
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import qualified Web.Cookie as Cookie
import IHP.Mail.Types
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.TMap as TMap
import qualified Data.Typeable as Typeable
import IHP.View.Types
import IHP.View.CSSFramework
import IHP.Log.Types
import IHP.Log (makeRequestLogger, defaultRequestLogger)
import Network.Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Middleware.Cors as Cors
import qualified Network.Wai.Parse as WaiParse
import qualified System.Posix.Env.ByteString as Posix
import Data.String.Interpolate.IsString (i)
import qualified Control.Exception as Exception
import IHP.ModelSupport

newtype AppHostname = AppHostname Text
newtype AppPort = AppPort Int
newtype BaseUrl = BaseUrl Text

-- | Provides IHP with a middleware to log requests and responses.
--
-- By default this uses the RequestLogger middleware from wai-extra. Take a look at the wai-extra
-- documentation when you want to customize the request logging.
--
-- See https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html
--
--
-- Set @requestLoggerMiddleware = \application -> application@ to disable request logging.
newtype RequestLoggerMiddleware = RequestLoggerMiddleware Middleware

-- | Provides the default settings for the session cookie.
--
-- - Max Age: 30 days
-- - Same Site Policy: Lax
-- - HttpOnly (no access through JS)
-- - secure, when baseUrl is a https url
--
-- Override this to set e.g. a custom max age or change the default same site policy.
--
-- __Example: Set max age to 90 days__
-- > sessionCookie = defaultIHPSessionCookie { Cookie.setCookieMaxAge = Just (fromIntegral (60 * 60 * 24 * 90)) }
newtype SessionCookie = SessionCookie Cookie.SetCookie

-- | How long db connection are kept alive inside the connecton pool when they're idle
newtype DBPoolIdleTime = DBPoolIdleTime NominalDiffTime

-- | Max number of db connections the connection pool can open to the database
newtype DBPoolMaxConnections = DBPoolMaxConnections Int

newtype DatabaseUrl = DatabaseUrl ByteString

type ConfigBuilder = State.StateT TMap.TMap IO ()

-- | Interface for exception tracking services such as sentry
newtype ExceptionTracker = ExceptionTracker { ExceptionTracker -> Maybe Request -> SomeException -> IO ()
onException :: Maybe Request -> SomeException -> IO () }

-- | Typically "http://localhost:8001", Url where the IDE is running
newtype IdeBaseUrl = IdeBaseUrl Text

-- | Postgres role to be used for making queries with Row level security enabled
newtype RLSAuthenticatedRole = RLSAuthenticatedRole Text

newtype AssetVersion = AssetVersion Text

newtype CustomMiddleware = CustomMiddleware Middleware

newtype DataSyncMaxSubscriptionsPerConnection = DataSyncMaxSubscriptionsPerConnection Int
newtype DataSyncMaxTransactionsPerConnection = DataSyncMaxTransactionsPerConnection Int

-- | Puts an option into the current configuration
--
-- In case an option already exists with the same type, it will not be overriden:
--
-- > option Production
-- > option Development
-- > findOption @Environment
--
-- This code will return 'Production' as the second call to 'option' is ignored to not override the existing option.
option :: forall option. Typeable option => option -> State.StateT TMap.TMap IO ()
option :: option -> StateT TMap IO ()
option !option
value = (TMap -> TMap) -> StateT TMap IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\TMap
map -> if TMap -> Bool
forall a. Typeable a => TMap -> Bool
TMap.member @option TMap
map then TMap
map else option -> TMap -> TMap
forall a. Typeable a => a -> TMap -> TMap
TMap.insert option
value TMap
map)
{-# INLINABLE option #-}

ihpDefaultConfig :: ConfigBuilder
ihpDefaultConfig :: StateT TMap IO ()
ihpDefaultConfig = do
    Environment
ihpEnv <- ByteString -> Environment -> StateT TMap IO Environment
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_ENV" Environment
Development
    Environment -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option Environment
ihpEnv

    AppHostname -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (AppHostname -> StateT TMap IO ())
-> AppHostname -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Text -> AppHostname
AppHostname Text
"localhost"

    AppPort
port :: AppPort <- ByteString -> AppPort -> StateT TMap IO AppPort
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"PORT" (Int -> AppPort
AppPort Int
defaultPort)
    AppPort -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option AppPort
port

    ExceptionTracker -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (ExceptionTracker -> StateT TMap IO ())
-> ExceptionTracker -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe Request -> SomeException -> IO ()) -> ExceptionTracker
ExceptionTracker Maybe Request -> SomeException -> IO ()
Warp.defaultOnException

    Environment
environment <- Typeable Environment => StateT TMap IO Environment
forall option. Typeable option => StateT TMap IO option
findOption @Environment

    Logger
defaultLogger <- IO Logger -> StateT TMap IO Logger
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Environment -> IO Logger
defaultLoggerForEnv Environment
environment)
    Logger -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option Logger
defaultLogger
    Logger
logger <- Typeable Logger => StateT TMap IO Logger
forall option. Typeable option => StateT TMap IO option
findOption @Logger

    IPAddrSource
requestLoggerIpAddrSource <- ByteString -> IPAddrSource -> StateT TMap IO IPAddrSource
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_REQUEST_LOGGER_IP_ADDR_SOURCE" IPAddrSource
RequestLogger.FromSocket

    RequestLoggerMiddleware
reqLoggerMiddleware <- IO RequestLoggerMiddleware
-> StateT TMap IO RequestLoggerMiddleware
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RequestLoggerMiddleware
 -> StateT TMap IO RequestLoggerMiddleware)
-> IO RequestLoggerMiddleware
-> StateT TMap IO RequestLoggerMiddleware
forall a b. (a -> b) -> a -> b
$
            case Environment
environment of
                Environment
Development -> do
                                    Middleware
reqLogger <- (Logger
logger Logger -> (Logger -> IO Middleware) -> IO Middleware
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Logger -> IO Middleware
defaultRequestLogger)
                                    RequestLoggerMiddleware -> IO RequestLoggerMiddleware
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Middleware -> RequestLoggerMiddleware
RequestLoggerMiddleware Middleware
reqLogger)
                Environment
Production  ->  do
                                    Middleware
reqLogger <- (Logger
logger Logger -> (Logger -> IO Middleware) -> IO Middleware
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> RequestLoggerSettings -> Logger -> IO Middleware
makeRequestLogger RequestLoggerSettings
forall a. Default a => a
def { outputFormat :: OutputFormat
RequestLogger.outputFormat = IPAddrSource -> OutputFormat
RequestLogger.Apache IPAddrSource
requestLoggerIpAddrSource })
                                    RequestLoggerMiddleware -> IO RequestLoggerMiddleware
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Middleware -> RequestLoggerMiddleware
RequestLoggerMiddleware Middleware
reqLogger)


    RequestLoggerMiddleware -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (RequestLoggerMiddleware -> StateT TMap IO ())
-> RequestLoggerMiddleware -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ RequestLoggerMiddleware
reqLoggerMiddleware

    Maybe CorsResourcePolicy -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (Maybe CorsResourcePolicy -> StateT TMap IO ())
-> Maybe CorsResourcePolicy -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Maybe CorsResourcePolicy
defaultCorsResourcePolicy

    MailServer -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (MailServer -> StateT TMap IO ())
-> MailServer -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ MailServer
Sendmail

    ByteString
databaseUrl <- IO ByteString -> StateT TMap IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
defaultDatabaseUrl

    DatabaseUrl -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (DatabaseUrl -> StateT TMap IO ())
-> DatabaseUrl -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> DatabaseUrl
DatabaseUrl ByteString
databaseUrl
    DBPoolIdleTime -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (DBPoolIdleTime -> StateT TMap IO ())
-> DBPoolIdleTime -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> DBPoolIdleTime
DBPoolIdleTime (NominalDiffTime -> DBPoolIdleTime)
-> NominalDiffTime -> DBPoolIdleTime
forall a b. (a -> b) -> a -> b
$
            case Environment
environment of
                Environment
Development -> NominalDiffTime
2
                Environment
Production -> NominalDiffTime
60
    DBPoolMaxConnections -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (DBPoolMaxConnections -> StateT TMap IO ())
-> DBPoolMaxConnections -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Int -> DBPoolMaxConnections
DBPoolMaxConnections Int
20

    (AppPort Int
port) <- Typeable AppPort => StateT TMap IO AppPort
forall option. Typeable option => StateT TMap IO option
findOption @AppPort

    -- The IHP_BASEURL env var can override the hardcoded base url in Config.hs
    Maybe Text
ihpBaseUrlEnvVar <- ByteString -> StateT TMap IO (Maybe Text)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
envOrNothing ByteString
"IHP_BASEURL"
    case Maybe Text
ihpBaseUrlEnvVar of 
        Just Text
baseUrl -> BaseUrl -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (Text -> BaseUrl
BaseUrl Text
baseUrl)
        Maybe Text
Nothing -> do
            (AppHostname Text
appHostname) <- Typeable AppHostname => StateT TMap IO AppHostname
forall option. Typeable option => StateT TMap IO option
findOption @AppHostname
            BaseUrl -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (BaseUrl -> StateT TMap IO ()) -> BaseUrl -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Text -> BaseUrl
BaseUrl (Text
"http://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
appHostname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80 then Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
port else Text
""))

    (BaseUrl Text
currentBaseUrl) <- Typeable BaseUrl => StateT TMap IO BaseUrl
forall option. Typeable option => StateT TMap IO option
findOption @BaseUrl
    SessionCookie -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (SessionCookie -> StateT TMap IO ())
-> SessionCookie -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ SetCookie -> SessionCookie
SessionCookie (Text -> SetCookie
defaultIHPSessionCookie Text
currentBaseUrl)

    ParseRequestBodyOptions -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option ParseRequestBodyOptions
WaiParse.defaultParseRequestBodyOptions

    CSSFramework -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option CSSFramework
bootstrap

    Bool -> StateT TMap IO () -> StateT TMap IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Environment
environment Environment -> Environment -> Bool
forall a. Eq a => a -> a -> Bool
== Environment
Development) do
        Text
ihpIdeBaseUrl <- ByteString -> Text -> StateT TMap IO Text
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_IDE_BASEURL" (Text
"http://localhost:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
port Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        IdeBaseUrl -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (Text -> IdeBaseUrl
IdeBaseUrl Text
ihpIdeBaseUrl)

    Text
rlsAuthenticatedRole <- ByteString -> Text -> StateT TMap IO Text
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_RLS_AUTHENTICATED_ROLE" Text
"ihp_authenticated"
    RLSAuthenticatedRole -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (RLSAuthenticatedRole -> StateT TMap IO ())
-> RLSAuthenticatedRole -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Text -> RLSAuthenticatedRole
RLSAuthenticatedRole Text
rlsAuthenticatedRole

    StateT TMap IO ()
initAssetVersion

    Int
dataSyncMaxSubscriptionsPerConnection <- ByteString -> Int -> StateT TMap IO Int
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_DATASYNC_MAX_SUBSCRIPTIONS_PER_CONNECTION" Int
128
    Int
dataSyncMaxTransactionsPerConnection <- ByteString -> Int -> StateT TMap IO Int
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"IHP_DATASYNC_MAX_TRANSACTIONS_PER_CONNECTION" Int
10
    DataSyncMaxSubscriptionsPerConnection -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (DataSyncMaxSubscriptionsPerConnection -> StateT TMap IO ())
-> DataSyncMaxSubscriptionsPerConnection -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Int -> DataSyncMaxSubscriptionsPerConnection
DataSyncMaxSubscriptionsPerConnection Int
dataSyncMaxSubscriptionsPerConnection
    DataSyncMaxTransactionsPerConnection -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (DataSyncMaxTransactionsPerConnection -> StateT TMap IO ())
-> DataSyncMaxTransactionsPerConnection -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Int -> DataSyncMaxTransactionsPerConnection
DataSyncMaxTransactionsPerConnection Int
dataSyncMaxTransactionsPerConnection
    
    CustomMiddleware -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (CustomMiddleware -> StateT TMap IO ())
-> CustomMiddleware -> StateT TMap IO ()
forall a b. (a -> b) -> a -> b
$ Middleware -> CustomMiddleware
CustomMiddleware Middleware
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-# INLINABLE ihpDefaultConfig #-}


-- | Returns a env variable. The raw string
-- value is parsed before returning it. So the return value type depends on what
-- you expect (e.g. can be Text, Int some custom type).
--
-- When the parameter is missing or cannot be parsed, an error is raised and
-- the app startup is aborted. Use 'envOrDefault' when you want to get a
-- default value instead of an error, or 'paramOrNothing' to get @Nothing@
-- when the env variable is missing.
--
-- You can define a custom env variable parser by defining a 'EnvVarReader' instance.
--
-- __Example:__ Accessing a env var PORT.
--
-- Let's say an env var PORT is set to 1337
--
-- > export PORT=1337
--
-- We can read @PORT@ like this:
--
-- > port <- env @Int "PORT"
--
-- __Example:__ Missing env vars
--
-- Let's say the @PORT@ env var is not defined. In that case we'll get an
-- error when trying to access it:
--
-- >>> port <- env @Int "PORT"
-- "Env var 'PORT' not set, but it's required for the app to run"
--
env :: forall result monad. (MonadIO monad) => EnvVarReader result => ByteString -> monad result
env :: ByteString -> monad result
env ByteString
name = ByteString -> result -> monad result
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
name (Text -> result
forall a. Text -> a
error [i|Env var '#{name}' not set, but it's required for the app to run|])

envOrDefault :: (MonadIO monad) => EnvVarReader result => ByteString -> result -> monad result
envOrDefault :: ByteString -> result -> monad result
envOrDefault ByteString
name result
defaultValue = result -> Maybe result -> result
forall a. a -> Maybe a -> a
fromMaybe result
defaultValue (Maybe result -> result) -> monad (Maybe result) -> monad result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> monad (Maybe result)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
envOrNothing ByteString
name

envOrNothing :: (MonadIO monad) => EnvVarReader result => ByteString -> monad (Maybe result)
envOrNothing :: ByteString -> monad (Maybe result)
envOrNothing ByteString
name = IO (Maybe result) -> monad (Maybe result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe result) -> monad (Maybe result))
-> IO (Maybe result) -> monad (Maybe result)
forall a b. (a -> b) -> a -> b
$ (ByteString -> result) -> Maybe ByteString -> Maybe result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> result
parseString (Maybe ByteString -> Maybe result)
-> IO (Maybe ByteString) -> IO (Maybe result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO (Maybe ByteString)
Posix.getEnv ByteString
name
    where
        parseString :: ByteString -> result
parseString ByteString
string = case ByteString -> Either Text result
forall valueType.
EnvVarReader valueType =>
ByteString -> Either Text valueType
envStringToValue ByteString
string of
            Left Text
errorMessage -> Text -> result
forall a. Text -> a
error [i|Env var '#{name}' is invalid: #{errorMessage}|]
            Right result
value -> result
value

class EnvVarReader valueType where
    envStringToValue :: ByteString -> Either Text valueType

instance EnvVarReader Environment where
    envStringToValue :: ByteString -> Either Text Environment
envStringToValue ByteString
"Production"  = Environment -> Either Text Environment
forall a b. b -> Either a b
Right Environment
Production
    envStringToValue ByteString
"Development" = Environment -> Either Text Environment
forall a b. b -> Either a b
Right Environment
Development
    envStringToValue ByteString
otherwise     = Text -> Either Text Environment
forall a b. a -> Either a b
Left Text
"Should be set to 'Development' or 'Production'"

instance EnvVarReader Int where
    envStringToValue :: ByteString -> Either Text Int
envStringToValue ByteString
string = case Text -> Maybe Int
textToInt (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
string) of
        Just Int
integer -> Int -> Either Text Int
forall a b. b -> Either a b
Right Int
integer
        Maybe Int
Nothing -> Text -> Either Text Int
forall a b. a -> Either a b
Left [i|Expected integer, got #{string}|]

instance EnvVarReader Text where
    envStringToValue :: ByteString -> Either Text Text
envStringToValue ByteString
string = Text -> Either Text Text
forall a b. b -> Either a b
Right (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
string)

instance EnvVarReader ByteString where
    envStringToValue :: ByteString -> Either Text ByteString
envStringToValue ByteString
string = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
string

instance EnvVarReader AppPort where
    envStringToValue :: ByteString -> Either Text AppPort
envStringToValue ByteString
string = Int -> AppPort
AppPort (Int -> AppPort) -> Either Text Int -> Either Text AppPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text Int
forall valueType.
EnvVarReader valueType =>
ByteString -> Either Text valueType
envStringToValue ByteString
string

instance EnvVarReader RequestLogger.IPAddrSource where
    envStringToValue :: ByteString -> Either Text IPAddrSource
envStringToValue ByteString
"FromHeader" = IPAddrSource -> Either Text IPAddrSource
forall a b. b -> Either a b
Right IPAddrSource
RequestLogger.FromHeader
    envStringToValue ByteString
"FromSocket" = IPAddrSource -> Either Text IPAddrSource
forall a b. b -> Either a b
Right IPAddrSource
RequestLogger.FromSocket
    envStringToValue ByteString
otherwise    = Text -> Either Text IPAddrSource
forall a b. a -> Either a b
Left Text
"Expected 'FromHeader' or 'FromSocket'"


initAssetVersion :: ConfigBuilder
initAssetVersion :: StateT TMap IO ()
initAssetVersion = do
    Maybe Text
ihpCloudContainerId <- ByteString -> StateT TMap IO (Maybe Text)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
envOrNothing ByteString
"IHP_CLOUD_CONTAINER_ID"
    Maybe Text
ihpAssetVersion <- ByteString -> StateT TMap IO (Maybe Text)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
envOrNothing ByteString
"IHP_ASSET_VERSION"
    let assetVersion :: Text
assetVersion = [ Maybe Text
ihpCloudContainerId, Maybe Text
ihpAssetVersion]
            [Maybe Text] -> ([Maybe Text] -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
            [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Text] -> Maybe Text
forall a. [a] -> Maybe a
head
            Maybe Text -> (Maybe Text -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"dev"
    AssetVersion -> StateT TMap IO ()
forall option. Typeable option => option -> StateT TMap IO ()
option (Text -> AssetVersion
AssetVersion Text
assetVersion)

findOption :: forall option. Typeable option => State.StateT TMap.TMap IO option
findOption :: StateT TMap IO option
findOption = option -> Maybe option -> option
forall a. a -> Maybe a -> a
fromMaybe (Text -> option
forall a. Text -> a
error Text
optionNotFoundErrorMessage) (Maybe option -> option)
-> StateT TMap IO (Maybe option) -> StateT TMap IO option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Typeable option => StateT TMap IO (Maybe option)
forall option. Typeable option => StateT TMap IO (Maybe option)
findOptionOrNothing @option
    where
        optionNotFoundErrorMessage :: Text
optionNotFoundErrorMessage = Text
"findOption: Could not find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
show (option -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf (option
forall a. HasCallStack => a
undefined :: option))
{-# INLINABLE findOption #-}

findOptionOrNothing :: forall option. Typeable option => State.StateT TMap.TMap IO (Maybe option)
findOptionOrNothing :: StateT TMap IO (Maybe option)
findOptionOrNothing = do
    TMap
options <- StateT TMap IO TMap
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
    TMap
options
        TMap -> (TMap -> Maybe option) -> Maybe option
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Typeable option => TMap -> Maybe option
forall a. Typeable a => TMap -> Maybe a
TMap.lookup @option
        Maybe option
-> (Maybe option -> StateT TMap IO (Maybe option))
-> StateT TMap IO (Maybe option)
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Maybe option -> StateT TMap IO (Maybe option)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINABLE findOptionOrNothing #-}

buildFrameworkConfig :: ConfigBuilder -> IO FrameworkConfig
buildFrameworkConfig :: StateT TMap IO () -> IO FrameworkConfig
buildFrameworkConfig StateT TMap IO ()
appConfig = do
    let resolve :: StateT TMap IO FrameworkConfig
resolve = do
            (AppHostname Text
appHostname) <- Typeable AppHostname => StateT TMap IO AppHostname
forall option. Typeable option => StateT TMap IO option
findOption @AppHostname
            Environment
environment <- Typeable Environment => StateT TMap IO Environment
forall option. Typeable option => StateT TMap IO option
findOption @Environment
            (AppPort Int
appPort) <- Typeable AppPort => StateT TMap IO AppPort
forall option. Typeable option => StateT TMap IO option
findOption @AppPort
            (BaseUrl Text
baseUrl) <- Typeable BaseUrl => StateT TMap IO BaseUrl
forall option. Typeable option => StateT TMap IO option
findOption @BaseUrl
            (RequestLoggerMiddleware Middleware
requestLoggerMiddleware) <- Typeable RequestLoggerMiddleware =>
StateT TMap IO RequestLoggerMiddleware
forall option. Typeable option => StateT TMap IO option
findOption @RequestLoggerMiddleware
            (SessionCookie SetCookie
sessionCookie) <- Typeable SessionCookie => StateT TMap IO SessionCookie
forall option. Typeable option => StateT TMap IO option
findOption @SessionCookie
            MailServer
mailServer <- Typeable MailServer => StateT TMap IO MailServer
forall option. Typeable option => StateT TMap IO option
findOption @MailServer
            (DBPoolIdleTime NominalDiffTime
dbPoolIdleTime) <- Typeable DBPoolIdleTime => StateT TMap IO DBPoolIdleTime
forall option. Typeable option => StateT TMap IO option
findOption @DBPoolIdleTime
            (DBPoolMaxConnections Int
dbPoolMaxConnections) <- Typeable DBPoolMaxConnections =>
StateT TMap IO DBPoolMaxConnections
forall option. Typeable option => StateT TMap IO option
findOption @DBPoolMaxConnections
            (DatabaseUrl ByteString
databaseUrl) <- Typeable DatabaseUrl => StateT TMap IO DatabaseUrl
forall option. Typeable option => StateT TMap IO option
findOption @DatabaseUrl
            CSSFramework
cssFramework <- Typeable CSSFramework => StateT TMap IO CSSFramework
forall option. Typeable option => StateT TMap IO option
findOption @CSSFramework
            Logger
logger <- Typeable Logger => StateT TMap IO Logger
forall option. Typeable option => StateT TMap IO option
findOption @Logger
            ExceptionTracker
exceptionTracker <- Typeable ExceptionTracker => StateT TMap IO ExceptionTracker
forall option. Typeable option => StateT TMap IO option
findOption @ExceptionTracker
            Maybe CorsResourcePolicy
corsResourcePolicy <- Typeable CorsResourcePolicy =>
StateT TMap IO (Maybe CorsResourcePolicy)
forall option. Typeable option => StateT TMap IO (Maybe option)
findOptionOrNothing @Cors.CorsResourcePolicy
            ParseRequestBodyOptions
parseRequestBodyOptions <- Typeable ParseRequestBodyOptions =>
StateT TMap IO ParseRequestBodyOptions
forall option. Typeable option => StateT TMap IO option
findOption @WaiParse.ParseRequestBodyOptions
            (IdeBaseUrl Text
ideBaseUrl) <- Typeable IdeBaseUrl => StateT TMap IO IdeBaseUrl
forall option. Typeable option => StateT TMap IO option
findOption @IdeBaseUrl
            (RLSAuthenticatedRole Text
rlsAuthenticatedRole) <- Typeable RLSAuthenticatedRole =>
StateT TMap IO RLSAuthenticatedRole
forall option. Typeable option => StateT TMap IO option
findOption @RLSAuthenticatedRole
            (AssetVersion Text
assetVersion) <- Typeable AssetVersion => StateT TMap IO AssetVersion
forall option. Typeable option => StateT TMap IO option
findOption @AssetVersion
            CustomMiddleware
customMiddleware <- Typeable CustomMiddleware => StateT TMap IO CustomMiddleware
forall option. Typeable option => StateT TMap IO option
findOption @CustomMiddleware

            TMap
appConfig <- StateT TMap IO TMap
forall (m :: * -> *) s. Monad m => StateT s m s
State.get


            FrameworkConfig -> StateT TMap IO FrameworkConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure FrameworkConfig :: Text
-> Environment
-> Int
-> Text
-> Middleware
-> SetCookie
-> MailServer
-> ByteString
-> NominalDiffTime
-> Int
-> CSSFramework
-> Logger
-> ExceptionTracker
-> TMap
-> Maybe CorsResourcePolicy
-> ParseRequestBodyOptions
-> Text
-> Text
-> Text
-> CustomMiddleware
-> FrameworkConfig
FrameworkConfig { Int
Maybe CorsResourcePolicy
ByteString
Text
NominalDiffTime
Logger
TMap
MailServer
ParseRequestBodyOptions
Environment
CSSFramework
SetCookie
CustomMiddleware
ExceptionTracker
Middleware
$sel:customMiddleware:FrameworkConfig :: CustomMiddleware
$sel:assetVersion:FrameworkConfig :: Text
$sel:rlsAuthenticatedRole:FrameworkConfig :: Text
$sel:ideBaseUrl:FrameworkConfig :: Text
$sel:parseRequestBodyOptions:FrameworkConfig :: ParseRequestBodyOptions
$sel:corsResourcePolicy:FrameworkConfig :: Maybe CorsResourcePolicy
$sel:appConfig:FrameworkConfig :: TMap
$sel:exceptionTracker:FrameworkConfig :: ExceptionTracker
$sel:logger:FrameworkConfig :: Logger
$sel:cssFramework:FrameworkConfig :: CSSFramework
$sel:dbPoolMaxConnections:FrameworkConfig :: Int
$sel:dbPoolIdleTime:FrameworkConfig :: NominalDiffTime
$sel:databaseUrl:FrameworkConfig :: ByteString
$sel:mailServer:FrameworkConfig :: MailServer
$sel:sessionCookie:FrameworkConfig :: SetCookie
$sel:requestLoggerMiddleware:FrameworkConfig :: Middleware
$sel:baseUrl:FrameworkConfig :: Text
$sel:appPort:FrameworkConfig :: Int
$sel:environment:FrameworkConfig :: Environment
$sel:appHostname:FrameworkConfig :: Text
appConfig :: TMap
customMiddleware :: CustomMiddleware
assetVersion :: Text
rlsAuthenticatedRole :: Text
ideBaseUrl :: Text
parseRequestBodyOptions :: ParseRequestBodyOptions
corsResourcePolicy :: Maybe CorsResourcePolicy
exceptionTracker :: ExceptionTracker
logger :: Logger
cssFramework :: CSSFramework
databaseUrl :: ByteString
dbPoolMaxConnections :: Int
dbPoolIdleTime :: NominalDiffTime
mailServer :: MailServer
sessionCookie :: SetCookie
requestLoggerMiddleware :: Middleware
baseUrl :: Text
appPort :: Int
environment :: Environment
appHostname :: Text
.. }

    (FrameworkConfig
frameworkConfig, TMap
_) <- StateT TMap IO FrameworkConfig
-> TMap -> IO (FrameworkConfig, TMap)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (StateT TMap IO ()
appConfig StateT TMap IO () -> StateT TMap IO () -> StateT TMap IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT TMap IO ()
ihpDefaultConfig StateT TMap IO ()
-> StateT TMap IO FrameworkConfig -> StateT TMap IO FrameworkConfig
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT TMap IO FrameworkConfig
resolve) TMap
TMap.empty

    FrameworkConfig -> IO FrameworkConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure FrameworkConfig
frameworkConfig
{-# INLINABLE buildFrameworkConfig #-}

data FrameworkConfig = FrameworkConfig
    { FrameworkConfig -> Text
appHostname :: !Text
    , FrameworkConfig -> Environment
environment :: !Environment
    , FrameworkConfig -> Int
appPort :: !Int
    , FrameworkConfig -> Text
baseUrl :: !Text

    -- | Provides IHP with a middleware to log requests and responses.
    --
    -- By default this uses the RequestLogger middleware from wai-extra. Take a look at the wai-extra
    -- documentation when you want to customize the request logging.
    --
    -- See https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html
    --
    --
    -- Set @requestLoggerMiddleware = \application -> application@ to disable request logging.
    , FrameworkConfig -> Middleware
requestLoggerMiddleware :: !Middleware

    -- | Provides the default settings for the session cookie.
    --
    -- - Max Age: 30 days
    -- - Same Site Policy: Lax
    -- - HttpOnly (no access through JS)
    -- - secure, when baseUrl is a https url
    --
    -- Override this to set e.g. a custom max age or change the default same site policy.
    --
    -- __Example: Set max age to 90 days__
    -- > sessionCookie = defaultIHPSessionCookie { Cookie.setCookieMaxAge = Just (fromIntegral (60 * 60 * 24 * 90)) }
    , FrameworkConfig -> SetCookie
sessionCookie :: !Cookie.SetCookie

    , FrameworkConfig -> MailServer
mailServer :: !MailServer

    , FrameworkConfig -> ByteString
databaseUrl :: !ByteString
    -- | How long db connection are kept alive inside the connecton pool when they're idle
    , FrameworkConfig -> NominalDiffTime
dbPoolIdleTime :: !NominalDiffTime

    -- | Max number of db connections the connection pool can open to the database
    , FrameworkConfig -> Int
dbPoolMaxConnections :: !Int

    -- | Bootstrap 4 by default
    --
    -- Override this if you use a CSS framework that is not bootstrap
    , FrameworkConfig -> CSSFramework
cssFramework :: !CSSFramework
    , FrameworkConfig -> Logger
logger :: !Logger
    , FrameworkConfig -> ExceptionTracker
exceptionTracker :: !ExceptionTracker

    -- | Custom 'option's from @Config.hs@ are stored here
    --
    -- To access a custom option here, first set it up inside @Config.hs@. This example
    -- reads a string from a env variable on app startup and makes it available to the app
    -- by saving it into the application context:
    --
    -- > -- Config.hs:
    -- > 
    -- > newtype RedisUrl = RedisUrl String
    -- > 
    -- > config :: ConfigBuilder
    -- > config = do
    -- >     option Development
    -- >     option (AppHostname "localhost")
    -- >     
    -- >     redisUrl <- env "REDIS_URL"
    -- >     option (RedisUrl redisUrl)
    --
    -- This redis url can be access from all IHP entrypoints using the ?applicationContext that is in scope:
    -- 
    -- > import qualified Data.TMap as TMap
    -- > import Config -- For accessing the RedisUrl data type
    -- > 
    -- > action MyAction = do
    -- >     let appConfig = ?context |> getFrameworkConfig |> get #appConfig
    -- >     let (RedisUrl redisUrl) = appConfig
    -- >                |> TMap.lookup @RedisUrl
    -- >                |> fromMaybe (error "Could not find RedisUrl in config")
    -- > 
    , FrameworkConfig -> TMap
appConfig :: !TMap.TMap

    -- | Configures CORS headers for the application. By default this is set to 'Nothing', and the server will not respond with any CORS headers
    --
    -- You can provide a custom CORS policy in @Config.hs@:
    --
    -- > -- Config.hs
    -- > import qualified Network.Wai.Middleware.Cors as Cors
    -- > 
    -- > config :: ConfigBuilder
    -- > config = do
    -- >     option Development
    -- >     option (AppHostname "localhost")
    -- >
    -- >     option Cors.simpleCorsResourcePolicy
    -- >
    -- 
    -- Take a look at the documentation of wai-cors https://hackage.haskell.org/package/wai-cors-0.2.7/docs/Network-Wai-Middleware-Cors.html for understanding what @simpleCorsResourcePolicy@ is doing
    --
    -- You can specify CORS origins like this:
    --
    -- > -- Config.hs
    -- > import qualified Network.Wai.Middleware.Cors as Cors
    -- > 
    -- > config :: ConfigBuilder
    -- > config = do
    -- >     option Development
    -- >     option (AppHostname "localhost")
    -- >
    -- >     -- The boolean True specifies if credentials are allowed for the request. You still need to set withCredentials on your XmlHttpRequest
    -- >     option Cors.simpleCorsResourcePolicy { Cors.corsOrigins = Just (["localhost"], True) }
    -- >
    , FrameworkConfig -> Maybe CorsResourcePolicy
corsResourcePolicy :: Maybe Cors.CorsResourcePolicy

    -- | Configures the limits for request parameters, uploaded files, maximum number of headers etc.
    --
    -- IHP is using 'Network.Wai.Parse.parseRequestBodyEx' for parsing the HTTP request. By default it applies certain limits
    -- to avoid a single request overloading the server.
    --
    -- You can find the default limits here: https://hackage.haskell.org/package/wai-extra-3.1.6/docs/Network-Wai-Parse.html#v:defaultParseRequestBodyOptions
    --
    -- You can override the default limits like this:
    --
    -- > -- Config.hs
    -- > import qualified Network.Wai.Parse as WaiParse
    -- >
    -- > config :: ConfigBuilder
    -- > config = do
    -- >     option Development
    -- >     option (AppHostname "localhost")
    -- >
    -- >     -- We extend the default options here
    -- >     option $ WaiParse.defaultParseRequestBodyOptions
    -- >             |> WaiParse.setMaxRequestNumFiles 20 -- Increase count of allowed files per request
    -- >
    , FrameworkConfig -> ParseRequestBodyOptions
parseRequestBodyOptions :: WaiParse.ParseRequestBodyOptions
    , FrameworkConfig -> Text
ideBaseUrl :: Text

    -- | See IHP.DataSync.Role
    , FrameworkConfig -> Text
rlsAuthenticatedRole :: Text

    -- | The asset version is used for cache busting
    --
    -- On IHP Cloud IHP automatically uses the @IHP_CLOUD_CONTAINER_ID@ env variable
    -- as the asset version. So when running there, you don't need to do anything.
    --
    -- If you deploy IHP on your own, you should provide the IHP_ASSET_VERSION
    -- env variable with e.g. the git commit hash of the production build.
    --
    -- If IHP cannot figure out an asset version, it will fallback to the static
    -- string @"dev"@.
    --
    , FrameworkConfig -> Text
assetVersion :: !Text

    -- | User provided WAI middleware that is run after IHP's middleware stack.
    , FrameworkConfig -> CustomMiddleware
customMiddleware :: !CustomMiddleware
}

class ConfigProvider a where
    getFrameworkConfig :: a -> FrameworkConfig

instance ConfigProvider FrameworkConfig where
    getFrameworkConfig :: FrameworkConfig -> FrameworkConfig
getFrameworkConfig = FrameworkConfig -> FrameworkConfig
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance LoggingProvider FrameworkConfig where
    getLogger :: FrameworkConfig -> Logger
getLogger = Proxy "logger" -> FrameworkConfig -> Logger
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "logger" (Proxy "logger")
Proxy "logger"
#logger


-- | Proxies FrameworkConfig fields contained in some context that can provider a FrameworkConfig
fromConfig :: (?context :: context, ConfigProvider context) => (FrameworkConfig -> a) -> a
fromConfig :: (FrameworkConfig -> a) -> a
fromConfig FrameworkConfig -> a
selector = (FrameworkConfig -> a
selector (FrameworkConfig -> a)
-> (context -> FrameworkConfig) -> context -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. context -> FrameworkConfig
forall a. ConfigProvider a => a -> FrameworkConfig
getFrameworkConfig) context
?context::context
?context
{-# INLINE fromConfig #-}

-- | Get the current frameworkConfig
getConfig :: (?context :: context, ConfigProvider context) => FrameworkConfig
getConfig :: FrameworkConfig
getConfig = (FrameworkConfig -> FrameworkConfig) -> FrameworkConfig
forall context a.
(?context::context, ConfigProvider context) =>
(FrameworkConfig -> a) -> a
fromConfig FrameworkConfig -> FrameworkConfig
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE getConfig #-}

-- | Returns the default IHP session cookie configuration. Useful when you want to override the default settings in 'sessionCookie'
defaultIHPSessionCookie :: Text -> Cookie.SetCookie
defaultIHPSessionCookie :: Text -> SetCookie
defaultIHPSessionCookie Text
baseUrl = SetCookie
forall a. Default a => a
def
    { setCookiePath :: Maybe ByteString
Cookie.setCookiePath = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"/"
    , setCookieMaxAge :: Maybe DiffTime
Cookie.setCookieMaxAge = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (Integer -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
30))
    , setCookieSameSite :: Maybe SameSiteOption
Cookie.setCookieSameSite = SameSiteOption -> Maybe SameSiteOption
forall a. a -> Maybe a
Just SameSiteOption
Cookie.sameSiteLax
    , setCookieHttpOnly :: Bool
Cookie.setCookieHttpOnly = Bool
True
    , setCookieSecure :: Bool
Cookie.setCookieSecure = Text
"https://" Text -> Text -> Bool
`Text.isPrefixOf` Text
baseUrl
    }

data RootApplication = RootApplication deriving (RootApplication -> RootApplication -> Bool
(RootApplication -> RootApplication -> Bool)
-> (RootApplication -> RootApplication -> Bool)
-> Eq RootApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootApplication -> RootApplication -> Bool
$c/= :: RootApplication -> RootApplication -> Bool
== :: RootApplication -> RootApplication -> Bool
$c== :: RootApplication -> RootApplication -> Bool
Eq, Int -> RootApplication -> ShowS
[RootApplication] -> ShowS
RootApplication -> String
(Int -> RootApplication -> ShowS)
-> (RootApplication -> String)
-> ([RootApplication] -> ShowS)
-> Show RootApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootApplication] -> ShowS
$cshowList :: [RootApplication] -> ShowS
show :: RootApplication -> String
$cshow :: RootApplication -> String
showsPrec :: Int -> RootApplication -> ShowS
$cshowsPrec :: Int -> RootApplication -> ShowS
Show)

defaultPort :: Int
defaultPort :: Int
defaultPort = Int
8000

defaultDatabaseUrl :: IO ByteString
defaultDatabaseUrl :: IO ByteString
defaultDatabaseUrl = do
    String
currentDirectory <- IO String
getCurrentDirectory
    let defaultDatabaseUrl :: ByteString
defaultDatabaseUrl = ByteString
"postgresql:///app?host=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
currentDirectory ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/build/db"
    ByteString -> ByteString -> IO ByteString
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
envOrDefault ByteString
"DATABASE_URL" ByteString
defaultDatabaseUrl

defaultLoggerForEnv :: Environment -> IO Logger
defaultLoggerForEnv :: Environment -> IO Logger
defaultLoggerForEnv = \case
    Environment
Development -> IO Logger
defaultLogger
    Environment
Production -> LoggerSettings -> IO Logger
newLogger LoggerSettings
forall a. Default a => a
def { $sel:level:LoggerSettings :: LogLevel
level = LogLevel
Info }


-- Returns 'True' when the application is running in a given environment
isEnvironment :: (?context :: context, ConfigProvider context) => Environment -> Bool
isEnvironment :: Environment -> Bool
isEnvironment Environment
environment = (context -> FrameworkConfig
forall a. ConfigProvider a => a -> FrameworkConfig
getFrameworkConfig context
?context::context
?context FrameworkConfig -> (FrameworkConfig -> Environment) -> Environment
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "environment" -> FrameworkConfig -> Environment
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "environment" (Proxy "environment")
Proxy "environment"
#environment) Environment -> Environment -> Bool
forall a. Eq a => a -> a -> Bool
== Environment
environment
{-# INLINABLE isEnvironment #-}

-- | Returns 'True'  when the application is running in Development mode
--
-- Development mode means that the Development option is configured in Config/Config.hs
isDevelopment :: (?context :: context, ConfigProvider context) => Bool
isDevelopment :: Bool
isDevelopment = Environment -> Bool
forall context.
(?context::context, ConfigProvider context) =>
Environment -> Bool
isEnvironment Environment
Development
{-# INLINABLE isDevelopment #-}

-- | Returns 'True' when the application is running in Production mode
--
-- Production mode means that the Production option is configured in Config/Config.hs
isProduction :: (?context :: context, ConfigProvider context) => Bool
isProduction :: Bool
isProduction = Environment -> Bool
forall context.
(?context::context, ConfigProvider context) =>
Environment -> Bool
isEnvironment Environment
Production
{-# INLINABLE isProduction #-}

defaultCorsResourcePolicy :: Maybe Cors.CorsResourcePolicy
defaultCorsResourcePolicy :: Maybe CorsResourcePolicy
defaultCorsResourcePolicy = Maybe CorsResourcePolicy
forall a. Maybe a
Nothing

-- | Builds a config and calls the provided callback.
--
-- Once the callback has returned the resources allocated by the config are closed. Specifcally
-- this will close open log file handles.
--
-- __Example:__
--
-- > import Config (config)
-- >
-- > withFrameworkConfig config \frameworkConfig -> do
-- >     -- Do something with the FrameworkConfig here
--
withFrameworkConfig :: ConfigBuilder -> (FrameworkConfig -> IO result) -> IO result
withFrameworkConfig :: StateT TMap IO () -> (FrameworkConfig -> IO result) -> IO result
withFrameworkConfig StateT TMap IO ()
configBuilder = IO FrameworkConfig
-> (FrameworkConfig -> IO ())
-> (FrameworkConfig -> IO result)
-> IO result
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (StateT TMap IO () -> IO FrameworkConfig
buildFrameworkConfig StateT TMap IO ()
configBuilder) (\FrameworkConfig
frameworkConfig -> FrameworkConfig
frameworkConfig FrameworkConfig -> (FrameworkConfig -> Logger) -> Logger
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "logger" -> FrameworkConfig -> Logger
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "logger" (Proxy "logger")
Proxy "logger"
#logger Logger -> (Logger -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "cleanup" -> Logger -> IO ()
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "cleanup" (Proxy "cleanup")
Proxy "cleanup"
#cleanup)

initModelContext :: FrameworkConfig -> IO ModelContext
initModelContext :: FrameworkConfig -> IO ModelContext
initModelContext FrameworkConfig { Environment
environment :: Environment
$sel:environment:FrameworkConfig :: FrameworkConfig -> Environment
environment, NominalDiffTime
dbPoolIdleTime :: NominalDiffTime
$sel:dbPoolIdleTime:FrameworkConfig :: FrameworkConfig -> NominalDiffTime
dbPoolIdleTime, Int
dbPoolMaxConnections :: Int
$sel:dbPoolMaxConnections:FrameworkConfig :: FrameworkConfig -> Int
dbPoolMaxConnections, ByteString
databaseUrl :: ByteString
$sel:databaseUrl:FrameworkConfig :: FrameworkConfig -> ByteString
databaseUrl, Logger
logger :: Logger
$sel:logger:FrameworkConfig :: FrameworkConfig -> Logger
logger } = do
    let isDevelopment :: Bool
isDevelopment = Environment
environment Environment -> Environment -> Bool
forall a. Eq a => a -> a -> Bool
== Environment
Development
    ModelContext
modelContext <- NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext NominalDiffTime
dbPoolIdleTime Int
dbPoolMaxConnections ByteString
databaseUrl Logger
logger
    ModelContext -> IO ModelContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModelContext
modelContext