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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
module Config (UffdConfig(..), ServerConfig(..), LoggingConfig(..)) where
import Conftrack
import Conftrack.Value (ConfigValue (..))
import Data.ByteString (ByteString)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics (Generic)
import qualified Network.Wai.Handler.Warp as Warp
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 :: Warp.Settings
, serverConfigDbString :: ByteString
, serverConfigGtfs :: OsPath
, serverConfigAssets :: OsPath
, serverConfigZoneinfoPath :: OsPath
, serverConfigDebugMode :: Bool
, serverConfigLogin :: Maybe UffdConfig
, serverConfigLogging :: LoggingConfig
} deriving (Generic)
data LoggingConfig = LoggingConfig
{ loggingConfigNtfyToken :: Maybe Text
, loggingConfigNtfyTopic :: Text
, loggingConfigHostname :: Text
} deriving (Generic)
instance ConfigValue (URIRef Absolute) where
fromConfig val@(ConfigString text) =
case parseURI strictURIParserOptions text of
Right uri -> Right uri
Left err -> Left $ ParseError (T.pack $ show err)
fromConfig val = Left (TypeMismatch "URI" val)
prettyValue uri = decodeUtf8 (serializeURIRef' uri)
instance Config UffdConfig where
readConfig = do
uffdConfigUrl <- readRequiredValue [key|url|]
uffdConfigClientName <- readRequiredValue [key|clientName|]
uffdConfigClientSecret <- readRequiredValue [key|clientSecret|]
uffdConfigEnable <- readRequiredValue [key|enable|]
pure UffdConfig {..}
instance Config LoggingConfig where
readConfig = LoggingConfig
<$> readOptionalValue [key|ntfyToken|]
<*> readValue "tracktrain" [key|ntfyTopic|]
<*> readValue "tracktrain" [key|name|]
instance Config Warp.Settings where
readConfig = do
port <- readOptionalValue [key|port|]
host <- readOptionalValue [key|host|]
timeout <- readOptionalValue [key|timeout|]
fdCacheDuration <- readOptionalValue [key|fdCacheDuration|]
fileInfoCacheDuration <- readOptionalValue [key|fileInfoCacheDuration|]
noParsePath <- readOptionalValue [key|noParsePath|]
serverName <- readOptionalValue [key|serverName|]
maximumBodyFlush <- readOptionalValue [key|maximumBodyFlush|]
gracefulShutdownTimeout <- readOptionalValue [key|gracefulShutdownTimeout|]
altSvc <- readOptionalValue [key|altSvc|]
pure $ Warp.defaultSettings
& doIf port Warp.setPort
& doIf host Warp.setHost
& doIf timeout Warp.setTimeout
& doIf fdCacheDuration Warp.setFdCacheDuration
& doIf fileInfoCacheDuration Warp.setFileInfoCacheDuration
& doIf noParsePath Warp.setNoParsePath
& doIf serverName Warp.setServerName
& doIf maximumBodyFlush Warp.setMaximumBodyFlush
& doIf gracefulShutdownTimeout Warp.setGracefulShutdownTimeout
& doIf altSvc Warp.setAltSvc
where doIf Nothing _ = id
doIf (Just a) f = f a
instance ConfigValue Warp.HostPreference where
fromConfig (ConfigString buf) = Right $ fromString (T.unpack (decodeUtf8 buf))
fromConfig val = Left (TypeMismatch "HostPreference" val)
instance Config ServerConfig where
readConfig = ServerConfig
<$> readNested [key|warp|]
<*> readValue "" [key|dbstring|]
<*> readValue [osp|./gtfs.zip|] [key|gtfs|]
<*> readValue [osp|./assets|] [key|assets|]
<*> readValue [osp|/etc/zoneinfo/|] [key|zoneinfopath|]
<*> readValue False [key|debugmode|]
<*> readNestedOptional [key|login|]
<*> readNested [key|logging|]
|
