{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Config (UffdConfig(..), ServerConfig(..), LoggingConfig(..)) where import Conferer (DefaultConfig (configDef), fetch, unsafeFetchKey) import Conferer.FromConfig import Conferer.FromConfig.Warp () import Data.ByteString (ByteString) import Data.Functor ((<&>)) import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) import Network.Wai.Handler.Warp (Settings) import System.OsPath (OsPath, encodeUtf, osp) import URI.ByteString data UffdConfig = UffdConfig { uffdConfigUrl :: URIRef Absolute , uffdConfigClientSecret :: Text , uffdConfigClientName :: Text , uffdConfigEnable :: Bool } deriving (Generic, Show) data ServerConfig = ServerConfig { serverConfigWarp :: Settings , serverConfigDbString :: ByteString , serverConfigGtfs :: OsPath , serverConfigAssets :: OsPath , serverConfigZoneinfoPath :: OsPath , serverConfigDebugMode :: Bool , serverConfigLogin :: UffdConfig , serverConfigLogging :: LoggingConfig } deriving (Generic) data LoggingConfig = LoggingConfig { loggingConfigNtfyToken :: Maybe Text , loggingConfigNtfyTopic :: Text , loggingConfigHostname :: Text } deriving (Generic) instance FromConfig ServerConfig instance FromConfig OsPath where fromConfig = fetchFromConfigWith (encodeUtf . T.unpack) instance DefaultConfig ServerConfig where configDef = ServerConfig { serverConfigWarp = configDef , serverConfigDbString = "" , serverConfigGtfs = [osp|./gtfs.zip|] , serverConfigAssets = [osp|./assets|] , serverConfigZoneinfoPath = [osp|/etc/zoneinfo/|] , serverConfigDebugMode = False , serverConfigLogin = configDef , serverConfigLogging = configDef } instance DefaultConfig UffdConfig where configDef = UffdConfig uri "secret" "uffdclient" False where Right uri = parseURI strictURIParserOptions "http://www.example.org" instance FromConfig UffdConfig where fromConfig key config = do url <- fetchFromConfig (key /. "url") config let Right uffdConfigUrl = parseURI strictURIParserOptions url uffdConfigClientName <- fetchFromConfig (key /. "clientName") config uffdConfigClientSecret <- fetchFromConfig (key /. "clientSecret") config uffdConfigEnable <- fetchFromConfig (key /. "enable") config pure UffdConfig {..} instance FromConfig LoggingConfig where fromConfig key config = LoggingConfig <$> fetchFromConfig (key /. "ntfyToken") config <*> fetchFromConfig (key /. "ntfyTopic") config <*> fetchFromConfig (key /. "name") config instance DefaultConfig LoggingConfig where configDef = LoggingConfig Nothing "tracktrain" ""