{-|
Module      : Gargantext.Core.Config.Ini.Ini
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     #-}

module Gargantext.Core.Config.Ini.Ini (
    -- * Types
    GargConfig(..)

    -- * Lenses
  , gc_backend_name
  , gc_datafilepath
  , gc_epo_api_url
  , gc_frame_calc_url
  , gc_frame_istex_url
  , gc_frame_searx_url
  , gc_frame_visio_url
  , gc_frame_write_url
  , gc_js_id_timeout
  , gc_js_job_timeout
  , gc_masteruser
  , gc_max_docs_parsers
  , gc_max_docs_scrapers
  , gc_pubmed_api_key
  , gc_repofilepath
  , gc_secretkey
  , gc_url
  , gc_url_backend_api

  -- * Utility functions
  , readIniFile'
  , readConfig
  , val
  , readDBConfig
  ) where

import Data.Ini (readIniFile, lookupValue, Ini)
import Data.Text as T
import Database.PostgreSQL.Simple qualified as PGS
import Prelude (read)

import Gargantext.Prelude


-- | 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 GargConfig = GargConfig { _gc_backend_name      :: !T.Text
                             , _gc_url               :: !T.Text
                             , _gc_url_backend_api   :: !T.Text

                             , _gc_masteruser        :: !T.Text
                             , _gc_secretkey         :: !T.Text

                             , _gc_datafilepath      :: !FilePath
                             , _gc_repofilepath      :: !FilePath

                             , _gc_frame_write_url   :: !T.Text
                             , _gc_frame_calc_url    :: !T.Text
                             , _gc_frame_visio_url   :: !T.Text

                             , _gc_frame_searx_url   :: !T.Text
                             , _gc_frame_istex_url   :: !T.Text

                             , _gc_max_docs_parsers  :: !Integer
                             , _gc_max_docs_scrapers :: !Integer

                             , _gc_pubmed_api_key    :: !T.Text

                             , _gc_js_job_timeout    :: !Integer
                             , _gc_js_id_timeout     :: !Integer

                             , _gc_epo_api_url       :: !T.Text
                             }
  deriving (Generic, Show)

makeLenses ''GargConfig

readIniFile' :: FilePath -> IO Ini
readIniFile' fp = do
  ini <- readIniFile fp
  case ini of
    Left e     -> panicTrace $ T.pack $ "ini file not found " <> show e
    Right ini' -> pure ini'

val :: Ini -> Text -> Text -> Text
val ini section key = do
  case (lookupValue section key ini) of
    Left e   -> panicTrace $ "ERROR: add " <> key <> " in section \"" <> section <> "\" to your gargantext.ini. " <> show e
    Right p' -> p'

readConfig :: FilePath -> IO GargConfig
readConfig fp = do
  ini <- readIniFile' fp

  let val' = val ini "gargantext"

  pure $ GargConfig
    { _gc_backend_name      = cs $ val' "BACKEND_NAME"
    , _gc_url               = stripRight '/' $ val' "URL"
    , _gc_url_backend_api   = stripRight '/' $ val' "URL_BACKEND_API"
    , _gc_masteruser        = val' "MASTER_USER"
    , _gc_secretkey         = val' "SECRET_KEY"
    , _gc_datafilepath      = cs $ val' "DATA_FILEPATH"
    , _gc_repofilepath      = cs $ val' "REPO_FILEPATH"
    , _gc_frame_write_url   = stripRight '/' $ val' "FRAME_WRITE_URL"
    , _gc_frame_calc_url    = stripRight '/' $ val' "FRAME_CALC_URL"
    , _gc_frame_visio_url   = stripRight '/' $ val' "FRAME_VISIO_URL"
    , _gc_frame_searx_url   = stripRight '/' $ val' "FRAME_SEARX_URL"
    , _gc_frame_istex_url   = stripRight '/' $ val' "FRAME_ISTEX_URL"
    , _gc_max_docs_parsers  = read $ cs $ val' "MAX_DOCS_PARSERS"
    , _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
    , _gc_pubmed_api_key    = val' "PUBMED_API_KEY"
    , _gc_js_job_timeout    = read $ cs $ val' "JS_JOB_TIMEOUT"
    , _gc_js_id_timeout     = read $ cs $ val' "JS_ID_TIMEOUT"
    , _gc_epo_api_url       = cs $ val' "EPO_API_URL"
    }

readDBConfig :: FilePath -> IO PGS.ConnectInfo
readDBConfig fp = do
  ini <- readIniFile' fp

  let val' = val ini "database"

  let dbPortRaw = val' "DB_PORT"
  let dbPort =
        case (readMaybe dbPortRaw :: Maybe Word16) of
          Nothing -> panicTrace $ "DB_PORT incorrect: " <> dbPortRaw
          Just d  -> d

  
  pure $ PGS.ConnectInfo { PGS.connectHost = cs $ val' "DB_HOST"
                         , PGS.connectPort = dbPort
                         , PGS.connectUser = cs $ val' "DB_USER"
                         , PGS.connectPassword = cs $ val' "DB_PASS"
                         , PGS.connectDatabase = cs $ val' "DB_NAME" }