{-# 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|]