-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module Settings where

import ClassyPrelude.Yesod
import qualified Control.Exception as Exception
import Data.Aeson                  (Result (..), fromJSON, withObject, (.!=),
                                    (.:?))
import Data.FileEmbed              (embedFile)
import Data.Yaml                   (decodeEither')
import Database.Persist.Sqlite     (SqliteConf)
import Language.Haskell.TH.Syntax  (Exp, Name, Q)
import Network.Wai.Handler.Warp    (HostPreference)
import Yesod.Default.Config2       (applyEnvValue, configSettingsYml)
import Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload,
                                    widgetFileReload)

-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
data AppSettings = AppSettings
    { AppSettings -> String
appStaticDir              :: String
    -- ^ Directory from which to serve static files.
    , AppSettings -> SqliteConf
appDatabaseConf           :: SqliteConf
    -- ^ Configuration settings for accessing the database.
    , AppSettings -> Maybe Text
appRoot                   :: Maybe Text
    -- ^ Base for all generated URLs. If @Nothing@, determined
    -- from the request headers.
    , AppSettings -> HostPreference
appHost                   :: HostPreference
    -- ^ Host/interface the server should bind to.
    , AppSettings -> Int
appPort                   :: Int
    -- ^ Port to listen on
    , AppSettings -> Bool
appIpFromHeader           :: Bool
    -- ^ Get the IP address from the header when logging. Useful when sitting
    -- behind a reverse proxy.
    , AppSettings -> Bool
appDetailedRequestLogging :: Bool
    -- ^ Use detailed request logging system
    , AppSettings -> Bool
appShouldLogAll           :: Bool
    -- ^ Should all log messages be displayed?
    , AppSettings -> Bool
appReloadTemplates        :: Bool
    -- ^ Use the reload version of templates
    , AppSettings -> Bool
appMutableStatic          :: Bool
    -- ^ Assume that files in the static dir may change after compilation
    , AppSettings -> Bool
appSkipCombining          :: Bool
    -- ^ Perform no stylesheet/script combining

    -- Example app-specific configuration values.
    , AppSettings -> Text
appCopyright              :: Text
    -- ^ Copyright text to appear in the footer of the page
    , AppSettings -> Maybe Text
appAnalytics              :: Maybe Text
    -- ^ Google Analytics code

    , AppSettings -> Bool
appAuthDummyLogin         :: Bool
    -- ^ Indicate if auth dummy login should be enabled.

    , AppSettings -> Maybe Text
appArchiveSocksProxyHost   :: Maybe Text
    -- ^ Socks proxy host to use when making archive requests

    , AppSettings -> Maybe Int
appArchiveSocksProxyPort   :: Maybe Int
    -- ^ Socks proxy port to use when making archive requests

    , AppSettings -> Maybe Text
appSourceCodeUri                :: Maybe Text
    -- ^ Uri to app source code

    , AppSettings -> Bool
appSSLOnly :: Bool

    , AppSettings -> Bool
appAllowNonHttpUrlSchemes :: Bool
    }

instance FromJSON AppSettings where
    parseJSON :: Value -> Parser AppSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AppSettings" \Object
o -> do
        let defaultDev :: Bool
defaultDev =
#ifdef DEVELOPMENT
                True
#else
                Bool
False
#endif
        String
appStaticDir              <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"static-dir"
        SqliteConf
appDatabaseConf           <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database"
        Maybe Text
appRoot                   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approot"
        HostPreference
appHost                   <- forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
        Int
appPort                   <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
        Bool
appIpFromHeader           <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip-from-header"

        Bool
dev                       <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"development"      forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
defaultDev

        Bool
appDetailedRequestLogging <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"detailed-logging" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
        Bool
appShouldLogAll           <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"should-log-all"   forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
        Bool
appReloadTemplates        <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reload-templates" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
        Bool
appMutableStatic          <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mutable-static"   forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev
        Bool
appSkipCombining          <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skip-combining"   forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev

        Text
appCopyright              <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"copyright"
        Maybe Text
appAnalytics              <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"analytics"

        Bool
appAuthDummyLogin         <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth-dummy-login"      forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
dev

        Maybe Text
appArchiveSocksProxyHost   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archive-socks-proxy-host"
        Maybe Int
appArchiveSocksProxyPort   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archive-socks-proxy-port"
        Maybe Text
appSourceCodeUri           <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source-code-uri"

        Bool
appSSLOnly                 <- forall a. a -> Maybe a -> a
fromMaybe Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ssl-only"

        Bool
appAllowNonHttpUrlSchemes  <- forall a. a -> Maybe a -> a
fromMaybe Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow-non-http-url-schemes"

        forall (m :: * -> *) a. Monad m => a -> m a
return AppSettings {Bool
Int
String
Maybe Int
Maybe Text
Text
HostPreference
SqliteConf
appAllowNonHttpUrlSchemes :: Bool
appSSLOnly :: Bool
appSourceCodeUri :: Maybe Text
appArchiveSocksProxyPort :: Maybe Int
appArchiveSocksProxyHost :: Maybe Text
appAuthDummyLogin :: Bool
appAnalytics :: Maybe Text
appCopyright :: Text
appSkipCombining :: Bool
appMutableStatic :: Bool
appReloadTemplates :: Bool
appShouldLogAll :: Bool
appDetailedRequestLogging :: Bool
appIpFromHeader :: Bool
appPort :: Int
appHost :: HostPreference
appRoot :: Maybe Text
appDatabaseConf :: SqliteConf
appStaticDir :: String
appAllowNonHttpUrlSchemes :: Bool
appSSLOnly :: Bool
appSourceCodeUri :: Maybe Text
appArchiveSocksProxyPort :: Maybe Int
appArchiveSocksProxyHost :: Maybe Text
appAuthDummyLogin :: Bool
appAnalytics :: Maybe Text
appCopyright :: Text
appSkipCombining :: Bool
appMutableStatic :: Bool
appReloadTemplates :: Bool
appShouldLogAll :: Bool
appDetailedRequestLogging :: Bool
appIpFromHeader :: Bool
appPort :: Int
appHost :: HostPreference
appRoot :: Maybe Text
appDatabaseConf :: SqliteConf
appStaticDir :: String
..}

-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
--
-- For more information on modifying behavior, see:
--
-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile
widgetFileSettings :: WidgetFileSettings
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = forall a. Default a => a
def

-- | How static files should be combined.
combineSettings :: CombineSettings
combineSettings :: CombineSettings
combineSettings = forall a. Default a => a
def

-- The rest of this file contains settings which rarely need changing by a
-- user.

widgetFile :: String -> Q Exp
widgetFile :: String -> Q Exp
widgetFile = (if AppSettings -> Bool
appReloadTemplates AppSettings
compileTimeAppSettings
                then WidgetFileSettings -> String -> Q Exp
widgetFileReload
                else WidgetFileSettings -> String -> Q Exp
widgetFileNoReload)
              WidgetFileSettings
widgetFileSettings

-- | Raw bytes at compile time of @config/settings.yml@
configSettingsYmlBS :: ByteString
configSettingsYmlBS :: ByteString
configSettingsYmlBS = $(embedFile configSettingsYml)

-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue :: Value
configSettingsYmlValue :: Value
configSettingsYmlValue = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
Exception.throw forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                       forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' ByteString
configSettingsYmlBS

-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings :: AppSettings
compileTimeAppSettings :: AppSettings
compileTimeAppSettings =
    case forall a. FromJSON a => Value -> Result a
fromJSON forall a b. (a -> b) -> a -> b
$ Bool -> KeyMap Text -> Value -> Value
applyEnvValue Bool
False forall a. Monoid a => a
mempty Value
configSettingsYmlValue of
        Error String
e -> forall a. HasCallStack => String -> a
error String
e
        Success AppSettings
settings -> AppSettings
settings

-- The following two functions can be used to combine multiple CSS or JS files
-- at compile time to decrease the number of http requests.
-- Sample usage (inside a Widget):
--
-- > $(combineStylesheets 'StaticR [style1_css, style2_css])

combineStylesheets :: Name -> [Route Static] -> Q Exp
combineStylesheets :: Name -> [Route Static] -> Q Exp
combineStylesheets = Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineStylesheets'
    (AppSettings -> Bool
appSkipCombining AppSettings
compileTimeAppSettings)
    CombineSettings
combineSettings

combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts = Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineScripts'
    (AppSettings -> Bool
appSkipCombining AppSettings
compileTimeAppSettings)
    CombineSettings
combineSettings