{-|
Module      : Ini.hs
Description : Gargantext Ini file
Copyright   : (c) CNRS, 2024-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Import a corpus binary.

 -}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}

module CLI.Ini where

import CLI.Types
import Database.PostgreSQL.Simple qualified as PGS
import Data.Text.IO qualified as T (writeFile)
import Data.Text qualified as T
import Gargantext.Core.Config.Ini.Ini qualified as Ini
import Gargantext.Core.Config.Ini.Mail qualified as IniMail
import Gargantext.Core.Config.Ini.NLP qualified as IniNLP
import Gargantext.Core.Config qualified as Config
import Gargantext.Core.Config.Types qualified as CTypes
import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
import Gargantext.Prelude
import Gargantext.System.Logging (LogLevel(..))
import Options.Applicative
import Servant.Client.Core (parseBaseUrl)
import Toml qualified


iniCLI :: IniArgs -> IO ()
iniCLI iniArgs@(IniArgs { dry_run }) = do
  let iniPath  = fromMaybe "gargantext.ini"           $ ini_path  iniArgs
  let tomlPath = fromMaybe "gargantext-settings.toml" $ toml_path iniArgs
  putStrLn $ "Reading configuration from file " <> iniPath <> "..."
  ini <- Ini.readConfig iniPath
  iniMail <- IniMail.readConfig iniPath
  iniNLP <- IniNLP.readConfig iniPath
  connInfo <- Ini.readDBConfig iniPath
  let c = convertConfigs ini iniMail iniNLP connInfo
  if dry_run then
    putStrLn (show (Toml.encode c) :: Text)
  else do
    T.writeFile tomlPath (show (Toml.encode c) :: Text)
    putStrLn $ "Converted configuration into TOML and wrote it to file " <> tomlPath

iniCmd :: HasCallStack => Mod CommandFields CLI
iniCmd = command "ini" (info (helper <*> fmap CLISub iniParser)
                       (progDesc "Parse .ini file and output a corresponding .toml file."))

iniParser :: Parser CLICmd
iniParser = fmap CCMD_ini $ IniArgs <$>
  (optional . strOption $ long "ini-path"  <> help "Path to the input ini file"   ) <*>
  (optional . strOption $ long "toml-path" <> help "Path to the output .toml file") <*>
  (flag False True (long "dry-run" <> help "If set, will only output generated .toml file to stdout"))

convertConfigs :: Ini.GargConfig -> IniMail.MailConfig -> IniNLP.NLPConfig -> PGS.ConnectInfo -> Config.GargConfig
convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
  Config.GargConfig { _gc_secrets = CTypes.SecretsConfig { _s_master_user = _gc_masteruser
                                                         , _s_secret_key = _gc_secretkey
                                                         , _s_jwk_file = CTypes.JWKFile "dev.jwk" }
                    , _gc_datafilepath
                    , _gc_mail_config = iniMail
                    , _gc_nlp_config = nlpConfig
                    , _gc_frontend_config = mkFrontendConfig ini
                    , _gc_database_config = connInfo
                    , _gc_notifications_config = defaultNotificationsConfig
                    , _gc_frames = CTypes.FramesConfig { _f_write_url = _gc_frame_write_url
                                                       , _f_calc_url = _gc_frame_calc_url
                                                       , _f_visio_url = _gc_frame_visio_url
                                                       , _f_searx_url = _gc_frame_searx_url
                                                       , _f_istex_url = _gc_frame_istex_url }
                    , _gc_jobs = CTypes.JobsConfig { _jc_max_docs_parsers = _gc_max_docs_parsers
                                                   , _jc_max_docs_scrapers = _gc_max_docs_scrapers
                                                   , _jc_js_job_timeout = _gc_js_job_timeout
                                                   , _jc_js_id_timeout = _gc_js_id_timeout }
                    , _gc_apis = CTypes.APIsConfig { _ac_epo_api_url = _gc_epo_api_url
                                                   , _ac_scrapyd_url }
                    , _gc_worker = WorkerSettings { _wsDefinitions = [ wd ]
                                                  , _wsDefaultVisibilityTimeout = 1
                                                  , _wsDefaultDelay = 0
                                                  , _wsDatabase = connInfo { PGS.connectDatabase = "pgmq"} }
                    , _gc_logging = Config.LogConfig {
                        _lc_log_level = INFO
                      , _lc_log_file = Nothing
                      }
                    }
  where
    _ac_scrapyd_url =
      case parseBaseUrl "http://localhost:6800" of
        Nothing -> panicTrace "Cannot parse base url for scrapyd"
        Just b -> b
    wd = WorkerDefinition { _wdName = "default"
                          , _wdQueue = "default" }

mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig
mkFrontendConfig (Ini.GargConfig { .. }) =
  CTypes.FrontendConfig { _fc_url = _gc_url
                        , _fc_backend_name = _gc_backend_name
                        , _fc_url_backend_api = _gc_url_backend_api
                        , _fc_cors
                        , _fc_microservices
                        , _fc_appPort = 3000
                        , _fc_cookie_settings = CTypes.defaultCookieSettings }
  where
    _fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [
                                         toCORSOrigin "https://demo.gargantext.org"
                                       , toCORSOrigin "https://formation.gargantext.org"
                                       , toCORSOrigin "https://academia.sub.gargantext.org"
                                       , toCORSOrigin "https://cnrs.gargantext.org"
                                       , toCORSOrigin "https://imt.sub.gargantext.org"
                                       , toCORSOrigin "https://helloword.gargantext.org"
                                       , toCORSOrigin "https://complexsystems.gargantext.org"
                                       , toCORSOrigin "https://europa.gargantext.org"
                                       , toCORSOrigin "https://earth.sub.gargantext.org"
                                       , toCORSOrigin "https://health.sub.gargantext.org"
                                       , toCORSOrigin "https://msh.sub.gargantext.org"
                                       , toCORSOrigin "https://dev.sub.gargantext.org"
                                       , toCORSOrigin "http://localhost:8008"
                                       , toCORSOrigin "http://localhost:8108"
                                       , toCORSOrigin "http://localhost:3000"
                                       ]
                                   , _corsAllowedHosts = []
                                   , _corsUseOriginsForHosts = True }
    _fc_microservices = CTypes.MicroServicesSettings { _msProxyPort = 8009
                                                     , _msProxyEnabled = False }
    toCORSOrigin :: Text -> CTypes.CORSOrigin
    toCORSOrigin url =
      case parseBaseUrl (T.unpack url) of
        Nothing -> panicTrace $ "Cannot parse base url for: " <> url
        Just b -> CTypes.CORSOrigin b

defaultNotificationsConfig :: CTypes.NotificationsConfig
defaultNotificationsConfig =
  CTypes.NotificationsConfig { _nc_central_exchange_bind = "tcp://*:5560"
                             , _nc_central_exchange_connect = "tcp://localhost:5560"
                             , _nc_dispatcher_bind = "tcp://*:5561"
                             , _nc_dispatcher_connect = "tcp://localhost:5561" }