src/Gargantext/API/Admin/EnvTypes.hs

   1 -- |
   2
   3 {-# LANGUAGE TemplateHaskell     #-}
   4 {-# LANGUAGE TypeFamilies        #-}
   5
   6 module Gargantext.API.Admin.EnvTypes where
   7
   8 import Control.Lens
   9 import Control.Monad.Except
  10 import Control.Monad.Reader
  11 import Data.Pool (Pool)
  12 import Data.Sequence (Seq)
  13 import Database.PostgreSQL.Simple (Connection)
  14 import GHC.Generics (Generic)
  15 import Network.HTTP.Client (Manager)
  16 import Servant.Client (BaseUrl)
  17 import Servant.Job.Async (HasJobEnv(..), Job)
  18 import System.Log.FastLogger
  19 import qualified Servant.Job.Core
  20
  21 import Gargantext.API.Admin.Types
  22 import Gargantext.API.Admin.Orchestrator.Types
  23 import Gargantext.API.Prelude (GargError)
  24 import Gargantext.Core.NodeStory
  25 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
  26 import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
  27 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
  28 import Gargantext.Prelude
  29 import Gargantext.Prelude.Config (GargConfig(..))
  30 import Gargantext.Prelude.Mail.Types (MailConfig)
  31
  32 import qualified Gargantext.Utils.Jobs.Monad as Jobs
  33
  34 data GargJob
  35   = TableNgramsJob
  36   | ForgotPasswordJob
  37   | UpdateNgramsListJobJSON
  38   | UpdateNgramsListJobCSV
  39   | AddContactJob
  40   | AddFileJob
  41   | DocumentFromWriteNodeJob
  42   | UpdateNodeJob
  43   | UploadFrameCalcJob
  44   | UploadDocumentJob
  45   | NewNodeJob
  46   | AddCorpusQueryJob
  47   | AddCorpusFormJob
  48   | AddCorpusFileJob
  49   | AddAnnuaireFormJob
  50   | RecomputeGraphJob
  51   deriving (Show, Eq, Ord, Enum, Bounded)
  52
  53 data Env = Env
  54   { _env_settings  :: !Settings
  55   , _env_logger    :: !LoggerSet
  56   , _env_pool      :: !(Pool Connection)
  57   , _env_nodeStory :: !NodeStoryEnv
  58   , _env_manager   :: !Manager
  59   , _env_self_url  :: !BaseUrl
  60   , _env_scrapers  :: !ScrapersEnv
  61   , _env_jobs      :: !(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
  62   , _env_config    :: !GargConfig
  63   , _env_mail      :: !MailConfig
  64   , _env_nlp       :: !NLPServerMap
  65   }
  66   deriving (Generic)
  67
  68 makeLenses ''Env
  69
  70 instance HasConfig Env where
  71   hasConfig = env_config
  72
  73 instance HasConnectionPool Env where
  74   connPool = env_pool
  75
  76 instance HasNodeStoryEnv Env where
  77   hasNodeStory = env_nodeStory
  78
  79 instance HasNodeStoryVar Env where
  80   hasNodeStoryVar = hasNodeStory . nse_getter
  81
  82 instance HasNodeStorySaver Env where
  83   hasNodeStorySaver = hasNodeStory . nse_saver
  84
  85 instance HasNodeStoryImmediateSaver Env where
  86   hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
  87
  88 instance HasNodeArchiveStoryImmediateSaver Env where
  89   hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
  90
  91 instance HasSettings Env where
  92   settings = env_settings
  93
  94 instance HasMail Env where
  95   mailSettings = env_mail
  96
  97 instance HasNLPServer Env where
  98   nlpServer = env_nlp
  99
 100 instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
 101   _env = env_scrapers . Servant.Job.Core._env
 102
 103 instance HasJobEnv Env JobLog JobLog where
 104   job_env = env_scrapers
 105
 106 instance Jobs.MonadJob (ReaderT Env (ExceptT GargError IO)) GargJob (Seq JobLog) JobLog where
 107   getJobEnv = asks (view env_jobs)
 108
 109 instance Jobs.MonadJobStatus (ReaderT Env (ExceptT GargError IO)) where
 110   type JobType        (ReaderT Env (ExceptT GargError IO)) = GargJob
 111   type JobOutputType  (ReaderT Env (ExceptT GargError IO)) = JobLog
 112   type JobEventType   (ReaderT Env (ExceptT GargError IO)) = JobLog
 113
 114 data MockEnv = MockEnv
 115   { _menv_firewall :: !FireWall
 116   }
 117   deriving (Generic)
 118
 119 makeLenses ''MockEnv
 120
 121
 122
 123 data DevEnv = DevEnv
 124   { _dev_env_settings  :: !Settings
 125   , _dev_env_config    :: !GargConfig
 126   , _dev_env_pool      :: !(Pool Connection)
 127   , _dev_env_nodeStory :: !NodeStoryEnv
 128   , _dev_env_mail      :: !MailConfig
 129   , _dev_env_nlp       :: !NLPServerMap
 130   }
 131
 132 makeLenses ''DevEnv
 133
 134 instance HasConfig DevEnv where
 135   hasConfig = dev_env_config
 136
 137 instance HasConnectionPool DevEnv where
 138   connPool = dev_env_pool
 139
 140 instance HasSettings DevEnv where
 141   settings = dev_env_settings
 142
 143
 144 instance HasNodeStoryEnv DevEnv where
 145   hasNodeStory = dev_env_nodeStory
 146
 147 instance HasNodeStoryVar DevEnv where
 148   hasNodeStoryVar = hasNodeStory . nse_getter
 149
 150 instance HasNodeStorySaver DevEnv where
 151   hasNodeStorySaver = hasNodeStory . nse_saver
 152
 153 instance HasNodeStoryImmediateSaver DevEnv where
 154   hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
 155
 156 instance HasNodeArchiveStoryImmediateSaver DevEnv where
 157   hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
 158
 159 instance HasMail DevEnv where
 160   mailSettings = dev_env_mail
 161
 162 instance HasNLPServer DevEnv where
 163   nlpServer = dev_env_nlp