-- yammat - Yet Another MateMAT -- Copyright (C) 2015 Amedeo Molnár -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published -- by the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -- | 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 Control.Exception (throw) import Data.Aeson (Result (..), fromJSON, withObject, (.!=), (.:?)) import Data.FileEmbed (embedFile) import Data.Yaml (decodeEither') import Database.Persist.Postgresql (PostgresConf) 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 { appStaticDir :: String -- ^ Directory from which to serve static files. , appDatabaseConf :: PostgresConf -- ^ Configuration settings for accessing the database. , appRoot :: Text -- ^ Base for all generated URLs. , appHost :: HostPreference -- ^ Host/interface the server should bind to. , appPort :: Int -- ^ Port to listen on , appIpFromHeader :: Bool -- ^ Get the IP address from the header when logging. Useful when sitting -- behind a reverse proxy. , appDetailedRequestLogging :: Bool -- ^ Use detailed request logging system , appShouldLogAll :: Bool -- ^ Should all log messages be displayed? , appReloadTemplates :: Bool -- ^ Use the reload version of templates , appMutableStatic :: Bool -- ^ Assume that files in the static dir may change after compilation , appSkipCombining :: Bool -- ^ Perform no stylesheet/script combining -- Example app-specific configuration values. -- , appCopyright :: Text -- ^ Copyright text to appear in the footer of the page , appEmail :: [Text] -- ^ notification address , appCurrency :: Text -- ^ Currency character , appCashCharge :: Int -- ^ Extra charge for paying in cash in cents , appCopyright :: Text , appCopyrightLink :: Text -- ^ Text and link to source , appUserCreationBlocked :: Bool -- ^ Block user creation , appAdminCreds :: Maybe Login -- ^ optional admin credentials } data Login = Login { loginName :: Text , loginPass :: Text } instance FromJSON Login where parseJSON = withObject "Login" $ \o -> do loginName <- o .: "login" loginPass <- o .: "password" return Login{..} instance FromJSON AppSettings where parseJSON = withObject "AppSettings" $ \o -> do let defaultDev = #if DEVELOPMENT True #else False #endif appStaticDir <- o .: "static-dir" appDatabaseConf <- o .: "database" appRoot <- o .: "approot" appHost <- fromString <$> o .: "host" appPort <- o .: "port" appIpFromHeader <- o .: "ip-from-header" appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev appShouldLogAll <- o .:? "should-log-all" .!= defaultDev appReloadTemplates <- o .:? "reload-templates" .!= defaultDev appMutableStatic <- o .:? "mutable-static" .!= defaultDev appSkipCombining <- o .:? "skip-combining" .!= defaultDev appEmail <- o .: "email" appCurrency <- o .: "currency" appCashCharge <- o .: "cash_charge" appCopyright <- o .: "copyright" appCopyrightLink <- o .: "copyright_link" appUserCreationBlocked <- o .: "block_users" appAdminCreds <- o .:? "credentials" return AppSettings {..} -- | 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 = def -- | How static files should be combined. combineSettings :: CombineSettings combineSettings = def -- The rest of this file contains settings which rarely need changing by a -- user. widgetFile :: String -> Q Exp widgetFile = (if appReloadTemplates compileTimeAppSettings then widgetFileReload else widgetFileNoReload) widgetFileSettings -- | Raw bytes at compile time of @config/settings.yml@ configSettingsYmlBS :: ByteString configSettingsYmlBS = $(embedFile configSettingsYml) -- | @config/settings.yml@, parsed to a @Value@. configSettingsYmlValue :: Value configSettingsYmlValue = either throw id $ decodeEither' configSettingsYmlBS -- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@. compileTimeAppSettings :: AppSettings compileTimeAppSettings = case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of Error e -> error e Success settings -> 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 = combineStylesheets' (appSkipCombining compileTimeAppSettings) combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' (appSkipCombining compileTimeAppSettings) combineSettings