{-|
Module      : Gargantext.Core.Config
Description : Textmining Collaborative Platform
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Configuration for the gargantext server

-}

{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE LambdaCase          #-}

module Gargantext.Core.Config (
    -- * Types
    GargConfig(..)
  , LogConfig(..)

    -- * Lenses
  , gc_datafilepath
  , gc_frontend_config
  , gc_mail_config
  , gc_database_config
  , gc_nlp_config
  , gc_notifications_config
  , gc_frames
  , gc_jobs
  , gc_secrets
  , gc_apis
  , gc_worker
  , gc_logging
  , lc_log_level
  , lc_log_file

  , mkProxyUrl

  , HasJWTSettings(..)
  , HasConfig(..)
  , HasManager(..)
  ) where

import Control.Lens (Getter)
import Gargantext.System.Logging.Types (LogLevel, parseLogLevel)
import Database.PostgreSQL.Simple qualified as PSQL
import Data.Text as T
import Gargantext.Core.Config.Mail (MailConfig)
import Gargantext.Core.Config.NLP (NLPConfig)
import Gargantext.Core.Config.Types
import Gargantext.Core.Config.Worker (WorkerSettings)
import Gargantext.Prelude
import Network.HTTP.Client qualified as HTTP
import Servant.Auth.Server (JWTSettings)
import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
import Toml.Schema
import Toml.Schema.FromValue (typeError)


-- | strip a given character from end of string
-- stripRight :: Char -> T.Text -> T.Text
-- stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s

data LogConfig = LogConfig
  { _lc_log_file  :: Maybe FilePath
  , _lc_log_level :: !LogLevel
  } deriving Show

instance FromValue LogConfig where
  fromValue = parseTableFromValue $ do
    _lc_log_file  <- optKey "log_file"
    _lc_log_level <- reqKeyOf "log_level" parse_log_level
    pure LogConfig{..}

parse_log_level :: Value' l -> Matcher l LogLevel
parse_log_level = \case
  Text' a txt -> case parseLogLevel txt of
    Left err  -> typeError (T.unpack err) (Text' a txt)
    Right ll  -> pure ll
  xs          -> typeError "parse_log_level" xs

-- Non-strict data so that we can use it in tests
data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                             -- , _gc_repofilepath      :: ~FilePath
                             , _gc_frontend_config      :: ~FrontendConfig
                             , _gc_mail_config          :: ~MailConfig
                             , _gc_database_config      :: ~PSQL.ConnectInfo
                             , _gc_nlp_config           :: ~NLPConfig
                             , _gc_notifications_config :: ~NotificationsConfig
                             , _gc_frames               :: ~FramesConfig
                             , _gc_jobs                 :: ~JobsConfig
                             , _gc_secrets              :: ~SecretsConfig
                             , _gc_apis                 :: ~APIsConfig
                             , _gc_worker               :: ~WorkerSettings
                             , _gc_logging              :: ~LogConfig
                             }
  deriving (Generic, Show)

instance FromValue GargConfig where
  fromValue = parseTableFromValue $ do
    _gc_frontend_config <- reqKey "frontend"
    _gc_mail_config <- reqKey "mail"
    db_config <- reqKey "database"
    _gc_nlp_config <- reqKey "nlp"
    _gc_secrets <- reqKey "secrets"
    _gc_datafilepath <- reqKeyOf "paths" $ parseTableFromValue $ reqKey "data_filepath"
    _gc_frames <- reqKeyOf "external" $ parseTableFromValue $ reqKey "frames"
    _gc_jobs <- reqKey "jobs"
    _gc_apis <- reqKey "apis"
    _gc_notifications_config <- reqKey "notifications"
    _gc_worker <- reqKey "worker"
    _gc_logging <- reqKey "logs"
    return $ GargConfig { _gc_datafilepath
                        , _gc_jobs
                        , _gc_apis
                        , _gc_frontend_config
                        , _gc_mail_config
                        , _gc_database_config = unTOMLConnectInfo db_config
                        , _gc_nlp_config
                        , _gc_notifications_config
                        , _gc_frames
                        , _gc_secrets
                        , _gc_worker
                        , _gc_logging }
instance ToValue GargConfig where
  toValue = defaultTableToValue
instance ToTable GargConfig where
  toTable (GargConfig { .. }) =
    table [ "frontend" .= _gc_frontend_config
          , "secrets" .= _gc_secrets
          , "paths" .= table [ "data_filepath" .= _gc_datafilepath ]
          , "apis" .= _gc_apis
          , "external" .= table [ "frames" .= _gc_frames ]
          , "jobs" .= _gc_jobs
          , "database" .= TOMLConnectInfo _gc_database_config
          , "mail" .= _gc_mail_config
          , "notifications" .= _gc_notifications_config
          , "nlp" .= _gc_nlp_config
          , "worker" .= _gc_worker
          ]


mkProxyUrl :: GargConfig -> BaseUrl
mkProxyUrl GargConfig{..} =
  case parseBaseUrl (T.unpack $ _fc_url _gc_frontend_config) of
    Nothing -> BaseUrl Http "localhost" 80 ""
    Just bh -> bh { baseUrlPort = _msProxyPort $ _fc_microservices _gc_frontend_config }


class HasConfig env where
  hasConfig :: Getter env GargConfig

instance HasConfig GargConfig where
  hasConfig = identity


class HasJWTSettings env where
  jwtSettings :: Getter env JWTSettings

class HasManager env where
  gargHttpManager :: Getter env HTTP.Manager

--
-- Lenses
--

makeLenses ''LogConfig
makeLenses ''GargConfig

