{-|
Module      : Gargantext.Core.Config.Types
Description : Settings of the API (Server and Client)
Copyright   : (c) CNRS, 2024-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

TODO-SECURITY: Critical
-}

{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}

module Gargantext.Core.Config.Types
  ( APIsConfig(..)
  , ac_epo_api_url
  , ac_scrapyd_url
  , CORSOrigin(..)
  , CORSSettings(..)
  , FramesConfig(..)
  , f_write_url
  , f_calc_url
  , f_visio_url
  , f_searx_url
  , f_istex_url
  , PortNumber
  , FrontendConfig(..)
  , fc_external_url
  , fc_internal_url
  , fc_backend_name
  , fc_directory
  , fc_cors
  , fc_microservices
  , fc_cookie_settings
  , getPublicUrl
  , defaultCookieSettings
  , MicroServicesProxyStatus(..)
  , microServicesProxyStatus
  , JobsConfig(..)
  , jc_max_docs_parsers
  , jc_max_docs_scrapers
  , MicroServicesSettings(..)
  , NotificationsConfig(..)
  , JWKFile(..)
  , SecretsConfig(..)
  , jwtSettings
  , SettingsFile(..)
  , TOMLConnectInfo(..)
  
  , corsUseOriginsForHosts
  , corsAllowedOrigins
  , corsAllowedHosts
  , msProxyPort
  , msProxyEnabled )
where

import Control.Monad.Fail (fail)
import Data.Text qualified as T
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Prelude
import Servant.Auth.Server (CookieSettings(..), JWTSettings, XsrfCookieSettings(..), defaultJWTSettings, readKey, writeKey)
import Servant.Auth.Server qualified as SAuth
import Servant.Client.Core (BaseUrl(..), parseBaseUrl, showBaseUrl)
import System.Directory (doesFileExist)
import Toml
import Toml.Schema




newtype SettingsFile = SettingsFile { _SettingsFile :: FilePath }
  deriving (Show, Eq, IsString)



newtype CORSOrigin = CORSOrigin { _CORSOrigin :: BaseUrl }
  deriving (Show, Eq)
instance FromValue CORSOrigin where
  fromValue (Toml.Text' _ t) =
    case parseBaseUrl (T.unpack t) of
      Nothing -> fail $ "Cannot parse base url for: " <> T.unpack t
      Just b  -> return $ CORSOrigin b
  fromValue _ = fail "Incorrect key type, expected Text"
instance ToValue CORSOrigin where
  toValue (CORSOrigin o) = toValue (showBaseUrl o)

data CORSSettings =
  CORSSettings {
    _corsAllowedOrigins :: [CORSOrigin]
  , _corsAllowedHosts   :: [CORSOrigin]
  -- | If 'True', we will reuse the origin whitelist
  -- as the allowed hosts as well. This allows, for example,
  -- to connect from \"demo.gargantext.org\" to \"dev.sub.gargantext.org\"
  -- and vice-versa.
  , _corsUseOriginsForHosts :: !Bool
  } deriving (Show, Eq)
instance FromValue CORSSettings where
  fromValue = parseTableFromValue $ do
    _corsAllowedOrigins <- reqKey "allowed-origins"
    let _corsAllowedHosts = mempty
    _corsUseOriginsForHosts <- reqKey "use-origins-for-hosts"
    return $ CORSSettings { .. }
instance ToValue CORSSettings where
  toValue = defaultTableToValue
instance ToTable CORSSettings where
  toTable (CORSSettings { .. }) = table [ "allowed-origins" .= _corsAllowedOrigins
                                        , "use-origins-for-hosts" .= _corsUseOriginsForHosts ]

makeLenses ''CORSSettings


data MicroServicesSettings =
  MicroServicesSettings {
    -- | The port where the microservices proxy will be listening on.
    _msProxyPort    :: !Int
  , _msProxyEnabled :: !Bool
  } deriving (Show, Eq)
instance FromValue MicroServicesSettings where
  fromValue = parseTableFromValue $ reqKeyOf "proxy" $ parseTableFromValue $ do
    _msProxyPort <- reqKey "port"
    _msProxyEnabled <- reqKey "enabled"
    return $ MicroServicesSettings { .. }
instance ToValue MicroServicesSettings where
  toValue = defaultTableToValue
instance ToTable MicroServicesSettings where
  toTable (MicroServicesSettings { .. }) =
    table [ "proxy" .= 
            table [ "port" .= _msProxyPort
                  , "enabled" .= _msProxyEnabled ]
          ]


makeLenses ''MicroServicesSettings



newtype TOMLConnectInfo = TOMLConnectInfo { unTOMLConnectInfo :: PGS.ConnectInfo }
instance FromValue TOMLConnectInfo where
  fromValue = parseTableFromValue $ do
    host <- reqKey "host"
    port <- reqKey "port"
    user <- reqKey "user"
    password <- reqKey "pass"
    db <- reqKey "name"
    return $ TOMLConnectInfo $ PGS.ConnectInfo { PGS.connectHost = host
                                               , PGS.connectPort = port
                                               , PGS.connectUser = user
                                               , PGS.connectPassword = password
                                               , PGS.connectDatabase = db }
instance ToValue TOMLConnectInfo where
  toValue = defaultTableToValue
instance ToTable TOMLConnectInfo where
  toTable (TOMLConnectInfo (PGS.ConnectInfo { .. })) =
    table [ "host" .= connectHost
          , "port" .= connectPort
          , "user" .= connectUser
          , "pass" .= connectPassword
          , "name" .= connectDatabase ]


data FramesConfig =
  FramesConfig { _f_write_url :: Text
               , _f_calc_url  :: Text
               , _f_visio_url :: Text
               , _f_searx_url :: Text
               , _f_istex_url :: Text
               }
  deriving (Generic, Show)
instance FromValue FramesConfig where
  fromValue = parseTableFromValue $ do
    _f_write_url <- reqKey "write_url"
    _f_calc_url <- reqKey "calc_url"
    _f_visio_url <- reqKey "visio_url"
    _f_searx_url <- reqKey "searx_url"
    _f_istex_url <- reqKey "istex_url"
    return $ FramesConfig { .. }
instance ToValue FramesConfig where
  toValue = defaultTableToValue
instance ToTable FramesConfig where
  toTable (FramesConfig { .. }) = table [ "write_url" .= _f_write_url
                                        , "calc_url" .= _f_calc_url
                                        , "visio_url" .= _f_visio_url
                                        , "searx_url" .= _f_searx_url
                                        , "istex_url" .= _f_istex_url ]

makeLenses ''FramesConfig


type PortNumber = Int


defaultCookieSettings :: CookieSettings
defaultCookieSettings = SAuth.defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
  where
    xsrfCookieSetting = SAuth.defaultXsrfCookieSettings { xsrfExcludeGet = True }

-- TODO jwtSettings = defaultJWTSettings
data FrontendConfig =
  FrontendConfig { _fc_external_url    :: !BaseUrl
                 , _fc_internal_url    :: !BaseUrl
                 , _fc_directory       :: !FilePath
                 , _fc_backend_name    :: !Text
                 , _fc_cors            :: !CORSSettings
                 , _fc_microservices   :: !MicroServicesSettings
                 , _fc_cookie_settings :: !CookieSettings
               }
  deriving (Generic, Show)
instance FromValue FrontendConfig where
  fromValue = parseTableFromValue $ do
    _fc_external_url_txt <- reqKey "external_url"
    _fc_external_url <-
      case parseBaseUrl (T.unpack _fc_external_url_txt) of
        Nothing -> fail "cannot parse fc_external_url"
        Just b -> pure b
    _fc_internal_url_txt <- reqKey "internal_url"
    _fc_internal_url <-
      case parseBaseUrl (T.unpack _fc_internal_url_txt) of
        Nothing -> fail "cannot parse fc_internal_url"
        Just b -> pure b
    _fc_directory <- reqKey "directory"
    _fc_backend_name <- reqKey "backend_name"
    _fc_cors <- reqKey "cors"
    _fc_microservices <- reqKey "microservices"
    
    return $ FrontendConfig { _fc_cookie_settings = defaultCookieSettings, .. }
instance ToValue FrontendConfig where
  toValue = defaultTableToValue
instance ToTable FrontendConfig where
  toTable (FrontendConfig { .. }) = table
      [ "external_url" .= (T.pack $ showBaseUrl _fc_external_url)
      , "internal_url" .= (T.pack $ showBaseUrl _fc_internal_url)
      , "directory"    .= _fc_directory
      , "backend_name" .= _fc_backend_name
      , "cors" .= _fc_cors
      , "microservices" .= _fc_microservices ]

makeLenses ''FrontendConfig

getPublicUrl :: FrontendConfig -> Text
getPublicUrl (FrontendConfig { .. }) = T.pack $ showBaseUrl _fc_external_url

data MicroServicesProxyStatus
  = PXY_enabled PortNumber
  | PXY_disabled
  deriving (Show, Eq)


microServicesProxyStatus :: FrontendConfig -> MicroServicesProxyStatus
microServicesProxyStatus fc =
  if fc ^. fc_microservices.msProxyEnabled
     then PXY_enabled (fc ^. fc_microservices.msProxyPort)
     else PXY_disabled



newtype JWKFile = JWKFile { unJWKFile :: FilePath }
  deriving (Show, Eq, Generic)

data SecretsConfig =
  SecretsConfig { _s_master_user :: !Text
                , _s_secret_key  :: !Text
                , _s_jwk_file    :: !JWKFile
               }
  deriving (Generic, Show)
instance FromValue SecretsConfig where
  fromValue = parseTableFromValue $ do
    _s_master_user <- reqKey "master_user"
    _s_secret_key  <- reqKey "secret_key"
    jwkFile <- reqKey "jwk_file"
    let _s_jwk_file = JWKFile jwkFile
    return $ SecretsConfig { .. }
instance ToValue SecretsConfig where
  toValue = defaultTableToValue
instance ToTable SecretsConfig where
  toTable (SecretsConfig { .. }) = table [ "master_user" .= _s_master_user
                                         , "secret_key" .= _s_secret_key
                                         , "jwk_file" .= unJWKFile _s_jwk_file ]

jwtSettings :: SecretsConfig -> IO JWTSettings
jwtSettings (SecretsConfig { _s_jwk_file = JWKFile jwkFile }) = do
  jwkExists <- doesFileExist jwkFile
  when (not jwkExists) $ writeKey jwkFile
  jwk <- readKey jwkFile
  pure $ defaultJWTSettings jwk


data JobsConfig =
  JobsConfig { _jc_max_docs_parsers  :: !Integer
             , _jc_max_docs_scrapers :: !Integer }
  deriving (Generic, Show)
instance FromValue JobsConfig where
  fromValue = parseTableFromValue $ do
    _jc_max_docs_parsers <- reqKey "max_docs_parsers"
    _jc_max_docs_scrapers <- reqKey "max_docs_scrapers"
    return $ JobsConfig { .. }
instance ToValue JobsConfig where
  toValue = defaultTableToValue
instance ToTable JobsConfig where
  toTable (JobsConfig { .. }) =
    table [ "max_docs_parsers" .= _jc_max_docs_parsers
          , "max_docs_scrapers" .= _jc_max_docs_scrapers ]

makeLenses ''JobsConfig


data APIsConfig =
  APIsConfig { _ac_epo_api_url    :: !Text
             , _ac_scrapyd_url    :: !BaseUrl }
  deriving (Generic, Show)
instance FromValue APIsConfig where
  fromValue = parseTableFromValue $ do
    _ac_epo_api_url <- reqKeyOf "epo" $ parseTableFromValue $ reqKey "api_url"
    scrapyd_url <- reqKeyOf "scrapyd" $ parseTableFromValue $ reqKey "url"
    _ac_scrapyd_url <-
      case parseBaseUrl (T.unpack scrapyd_url) of
        Nothing -> fail $ "Cannot parse scrapyd base url for: " <> T.unpack scrapyd_url
        Just b  -> return b
    return $ APIsConfig { .. }
instance ToValue APIsConfig where
  toValue = defaultTableToValue
instance ToTable APIsConfig where
  toTable (APIsConfig { .. }) = table [ "epo" .= table [ "api_url" .= _ac_epo_api_url ]
                                      , "scrapyd" .= table [ "url" .= showBaseUrl _ac_scrapyd_url ]
                                      ]

makeLenses ''APIsConfig


data NotificationsConfig =
  NotificationsConfig { _nc_central_exchange_bind      :: ~T.Text
                      , _nc_central_exchange_connect   :: ~T.Text
                      , _nc_ce_send_timeout_ms         :: ~Int
                      , _nc_dispatcher_bind            :: ~T.Text
                      , _nc_dispatcher_connect         :: ~T.Text
                      , _nc_dispatcher_send_timeout_ms :: ~Int
                      , _nc_dispatcher_throttle_ms     :: ~Int }
  deriving (Show, Eq)
instance FromValue NotificationsConfig where
  fromValue = parseTableFromValue $ do
    (_nc_central_exchange_bind, _nc_central_exchange_connect, _nc_ce_send_timeout_ms) <-
      reqKeyOf "central-exchange" $ parseTableFromValue $ do
        b <- reqKey "bind"
        c <- reqKey "connect"
        t <- reqKey "send_timeout_ms"
        pure (b, c, t)
    (_nc_dispatcher_bind, _nc_dispatcher_connect, _nc_dispatcher_send_timeout_ms, _nc_dispatcher_throttle_ms) <-
      reqKeyOf "dispatcher" $ parseTableFromValue $ do
        b <- reqKey "bind"
        c <- reqKey "connect"
        t <- reqKey "send_timeout_ms"
        tt <- reqKey "throttle_ms"
        pure (b, c, t, tt)
    return $ NotificationsConfig { .. }
instance ToValue NotificationsConfig where
  toValue = defaultTableToValue
instance ToTable NotificationsConfig where
  toTable (NotificationsConfig { .. }) =
    table [ "central-exchange" .=
            table [ "bind" .= _nc_central_exchange_bind
                  , "connect" .= _nc_central_exchange_connect
                  , "send_timeout_ms" .= _nc_ce_send_timeout_ms ]
          , "dispatcher" .=
            table [ "bind" .= _nc_dispatcher_bind
                  , "connect" .= _nc_dispatcher_connect
                  , "send_timeout_ms" .= _nc_dispatcher_send_timeout_ms
                  , "throttle" .= _nc_dispatcher_throttle_ms ]
          ]
