{-|
Module      : Gargantext.API.Admin.EnvTypes
Description : Env definitions in which the Gargantext app is run
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}


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

module Gargantext.API.Admin.EnvTypes (
    Env(..)
  , Mode(..)
  , modeToLoggingLevels
  , env_config
  , env_logger
  , env_manager
  , env_dispatcher
  , env_jwt_settings
  , env_pool
  , env_nodeStory

  , menv_firewall
  , dev_env_logger

  , FireWall(..)
  , MockEnv(..)
  , DevEnv(..)
  , DevJobHandle(..)
  ) where

import Control.Lens (to, view)
import Data.List ((\\))
import Data.Pool (Pool)
import Database.PostgreSQL.Simple (Connection)
import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Prelude (GargM, IsGargServer)
import Gargantext.Core.Config
import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
import Gargantext.Core.NodeStory
import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Notifications.Dispatcher (Dispatcher)
import Gargantext.Core.Notifications.Dispatcher.Types (HasDispatcher(..))
import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Prelude hiding (to)
import Gargantext.System.Logging
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
import Network.HTTP.Client (Manager)
import Servant.Auth.Server (JWTSettings)
import System.Log.FastLogger qualified as FL
import Gargantext.System.Logging.Loggers


data Mode = Dev | Mock | Prod
  deriving (Show, Read, Generic, Eq)

-- | Given the 'Mode' the server is running in, it returns the list of
-- allowed levels. For example for production we ignore everything which
-- has priority lower than "warning".
modeToLoggingLevels :: Mode -> [LogLevel]
modeToLoggingLevels = \case
   Dev  -> [minBound .. maxBound]
   Mock -> [minBound .. maxBound]
   -- For production, accepts everything but DEBUG.
   Prod -> [minBound .. maxBound] \\ [DEBUG]

-- Do /not/ treat the data types of this type as strict, because it's convenient
-- to be able to partially initialise things like an 'Env' during tests, without
-- having to specify /everything/. This means that when we /construct/ an 'Env',
-- we need to remember to force the fields to WHNF at that point.
data Env = Env
  { _env_logger           :: ~(Logger (GargM Env BackendInternalError))
  , _env_pool             :: ~(Pool Connection)
  , _env_nodeStory        :: ~(NodeStoryEnv BackendInternalError)
  , _env_manager          :: ~Manager
  , _env_config           :: ~GargConfig
  , _env_dispatcher       :: ~Dispatcher
  , _env_jwt_settings     :: ~JWTSettings
  }
  deriving (Generic)

makeLenses ''Env

instance HasConfig Env where
  hasConfig = env_config

instance HasConnectionPool Env where
  connPool = env_pool

instance HasNodeStoryEnv Env BackendInternalError where
  hasNodeStory = env_nodeStory

instance HasJWTSettings Env where
  jwtSettings = env_jwt_settings

instance HasMail Env where
  mailSettings = env_config . gc_mail_config

instance HasNLPServer Env where
  nlpServer = env_config . gc_nlp_config . (to nlpServerMap)

instance HasDispatcher Env Dispatcher where
  hasDispatcher = env_dispatcher

instance CET.HasCentralExchangeNotification Env where
  ce_notify m = do
    c <- asks (view env_config)
    liftBase $ CE.notify c m

instance HasManager Env where
  gargHttpManager = env_manager

data FireWall = FireWall { unFireWall :: Bool }

data MockEnv = MockEnv
  { _menv_firewall :: !FireWall
  }
  deriving (Generic)

makeLenses ''MockEnv

instance MonadLogger (GargM DevEnv BackendInternalError) where
  getLogger = asks _dev_env_logger

instance HasLogger (GargM DevEnv BackendInternalError) where
  data instance Logger (GargM DevEnv BackendInternalError)  =
    GargDevLogger { _GargDevLogger :: MonadicStdLogger FL.LogStr IO }
  type instance LogInitParams (GargM DevEnv BackendInternalError) = LogConfig
  type instance LogPayload (GargM DevEnv BackendInternalError)    = FL.LogStr
  initLogger cfg = fmap GargDevLogger $ (liftIO $ monadicStdLogger cfg)
  destroyLogger = liftIO . _msl_destroy . _GargDevLogger
  logMsg (GargDevLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
  logTxt (GargDevLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg

data DevEnv = DevEnv
  { _dev_env_config    :: !GargConfig
  , _dev_env_manager   :: ~Manager
  , _dev_env_logger    :: !(Logger (GargM DevEnv BackendInternalError))
  , _dev_env_pool      :: !(Pool Connection)
  , _dev_env_nodeStory :: !(NodeStoryEnv BackendInternalError)
  }

makeLenses ''DevEnv

instance CET.HasCentralExchangeNotification DevEnv where
  ce_notify m = do
    nc <- asks (view dev_env_config)
    liftBase $ CE.notify nc m

-- | Our /mock/ job handle.
data DevJobHandle = DevJobHandle

instance MonadJobStatus (GargM DevEnv err) where

  type JobHandle (GargM DevEnv err) = DevJobHandle
  type JobOutputType  (GargM DevEnv err) = JobLog
  type JobEventType   (GargM DevEnv err) = JobLog

  noJobHandle Proxy = DevJobHandle

  getLatestJobStatus DevJobHandle = pure noJobLog

  withTracer _ DevJobHandle n = n DevJobHandle

  markStarted _ _ = pure ()

  markProgress _ _ = pure ()

  markFailure _ _ _ = pure ()

  markComplete _ = pure ()

  markFailed _ _ = pure ()

  emitWarning _ _ = pure ()

  addMoreSteps _ _ = pure ()

instance HasConfig DevEnv where
  hasConfig = dev_env_config

instance HasConnectionPool DevEnv where
  connPool = dev_env_pool


instance HasNodeStoryEnv DevEnv BackendInternalError where
  hasNodeStory = dev_env_nodeStory

instance HasMail DevEnv where
  mailSettings = dev_env_config . gc_mail_config

instance HasManager DevEnv where
  gargHttpManager = dev_env_manager

instance HasNLPServer DevEnv where
  nlpServer = dev_env_config . gc_nlp_config . (to nlpServerMap)

instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)

instance HasLogger (GargM Env BackendInternalError) where
  newtype instance Logger (GargM Env BackendInternalError)  =
    GargLogger { _GargLogger :: MonadicStdLogger FL.LogStr IO }
  type instance LogInitParams (GargM Env BackendInternalError) = LogConfig
  type instance LogPayload (GargM Env BackendInternalError)    = FL.LogStr
  initLogger cfg = fmap GargLogger $ (liftIO $ monadicStdLogger cfg)
  destroyLogger = liftIO . _msl_destroy . _GargLogger
  logMsg (GargLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
  logTxt (GargLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg

instance MonadLogger (GargM Env BackendInternalError) where
  getLogger = asks _env_logger
