yammat/Settings.hs

182 lines
7 KiB
Haskell
Raw Normal View History

2015-08-09 19:16:33 +00:00
-- 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 <http://www.gnu.org/licenses/>.
2015-04-04 04:46:33 +00:00
-- | 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
2020-06-05 16:28:46 +00:00
import ClassyPrelude.Yesod
2015-04-04 04:46:33 +00:00
import Control.Exception (throw)
import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
(.:?))
import Data.FileEmbed (embedFile)
import Data.Yaml (decodeEither')
2015-04-06 21:12:58 +00:00
import Database.Persist.Postgresql (PostgresConf)
2015-04-04 04:46:33 +00:00
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.
2015-04-06 21:12:58 +00:00
, appDatabaseConf :: PostgresConf
2015-04-04 04:46:33 +00:00
-- ^ 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
, appAnalytics :: Maybe Text
-- ^ Google Analytics code
, appEmail :: [Text]
2015-04-04 04:46:33 +00:00
-- ^ notification address
2015-04-04 06:18:15 +00:00
, appCurrency :: Text
-- ^ Currency character
, appCashCharge :: Int
-- ^ Extra charge for paying in cash in cents
2015-09-17 19:54:04 +00:00
, appCopyright :: Text
, appCopyrightLink :: Text
-- ^ Text and link to source
, appUserCreationBlocked :: Bool
-- ^ Block user creation
2017-06-03 00:37:22 +00:00
, appAdminCreds :: Maybe Login
2017-06-03 00:39:38 +00:00
-- ^ optional admin credentials
2015-04-04 04:46:33 +00:00
}
2017-06-03 00:37:22 +00:00
data Login = Login
{ loginName :: Text
, loginPass :: Text
}
instance FromJSON Login where
parseJSON = withObject "Login" $ \o -> do
loginName <- o .: "login"
loginPass <- o .: "password"
return Login{..}
2015-04-04 04:46:33 +00:00
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
appAnalytics <- o .:? "analytics"
appEmail <- o .: "email"
2015-04-04 06:18:15 +00:00
appCurrency <- o .: "currency"
appCashCharge <- o .: "cash_charge"
2015-09-17 19:54:04 +00:00
appCopyright <- o .: "copyright"
appCopyrightLink <- o .: "copyright_link"
2015-04-04 04:46:33 +00:00
appUserCreationBlocked <- o .: "block_users"
2017-06-03 00:37:22 +00:00
appAdminCreds <- o .:? "credentials"
2015-04-04 04:46:33 +00:00
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