1 files changed, 94 insertions, 37 deletions
diff --git a/lib/Config.hs b/lib/Config.hs
index 363a068..88206f1 100644
--- a/lib/Config.hs
+++ b/lib/Config.hs
@@ -1,15 +1,22 @@
-{-# LANGUAGE DeriveGeneric   #-}
-{-# LANGUAGE RecordWildCards #-}
--- |
-
-module Config where
-import           Conferer                 (DefaultConfig (configDef))
-import           Conferer.FromConfig
-import           Conferer.FromConfig.Warp ()
+{-# 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           Network.Wai.Handler.Warp (Settings)
+import qualified Network.Wai.Handler.Warp as Warp
+import           System.OsPath            (OsPath, encodeUtf, osp)
 import           URI.ByteString
 
 data UffdConfig = UffdConfig
@@ -20,35 +27,85 @@ data UffdConfig = UffdConfig
   } deriving (Generic, Show)
 
 data ServerConfig = ServerConfig
-  { serverConfigWarp         :: Settings
+  { serverConfigWarp         :: Warp.Settings
   , serverConfigDbString     :: ByteString
-  , serverConfigGtfs         :: FilePath
-  , serverConfigAssets       :: FilePath
-  , serverConfigZoneinfoPath :: FilePath
-  , serverConfigLogin        :: UffdConfig
+  , 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 FromConfig ServerConfig
-
-instance DefaultConfig ServerConfig where
-  configDef = ServerConfig
-    { serverConfigWarp = configDef
-    , serverConfigDbString = ""
-    , serverConfigGtfs = "./gtfs.zip"
-    , serverConfigAssets = "./assets"
-    , serverConfigZoneinfoPath = "/etc/zoneinfo/"
-    , serverConfigLogin = 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
+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|]
+