1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
{-# LANGUAGE RecordWildCards #-}
module Config (UffdConfig(..), ServerConfig(..), LoggingConfig(..)) where
import Conferer (DefaultConfig (configDef))
import Conferer.FromConfig
import Conferer.FromConfig.Warp ()
import Data.ByteString (ByteString)
import Data.Functor ((<&>))
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (Settings)
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 :: FilePath
, serverConfigAssets :: FilePath
, serverConfigZoneinfoPath :: FilePath
, serverConfigLogin :: UffdConfig
, serverConfigLogging :: LoggingConfig
} deriving (Generic)
data LoggingConfig = LoggingConfig
{ loggingConfigNtfyToken :: Maybe Text
, loggingConfigNtfyTopic :: Text
, loggingConfigHostname :: Text
} deriving (Generic)
instance FromConfig ServerConfig
instance DefaultConfig ServerConfig where
configDef = ServerConfig
{ serverConfigWarp = configDef
, serverConfigDbString = ""
, serverConfigGtfs = "./gtfs.zip"
, serverConfigAssets = "./assets"
, serverConfigZoneinfoPath = "/etc/zoneinfo/"
, 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" ""
|
