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.Monoid
  12 import Data.Pool (Pool)
  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 (Dual [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 (Dual [JobLog]) JobLog where
 107   getJobEnv = asks (view env_jobs)
 108
 109 instance Jobs.MonadJobStatus (ReaderT Env (ExceptT GargError IO)) Dual 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   type JobErrorType   (ReaderT Env (ExceptT GargError IO)) = GargError
 114
 115 data MockEnv = MockEnv
 116   { _menv_firewall :: !FireWall
 117   }
 118   deriving (Generic)
 119
 120 makeLenses ''MockEnv
 121
 122
 123
 124 data DevEnv = DevEnv
 125   { _dev_env_settings  :: !Settings
 126   , _dev_env_config    :: !GargConfig
 127   , _dev_env_pool      :: !(Pool Connection)
 128   , _dev_env_nodeStory :: !NodeStoryEnv
 129   , _dev_env_mail      :: !MailConfig
 130   , _dev_env_nlp       :: !NLPServerMap
 131   }
 132
 133 makeLenses ''DevEnv
 134
 135 instance HasConfig DevEnv where
 136   hasConfig = dev_env_config
 137
 138 instance HasConnectionPool DevEnv where
 139   connPool = dev_env_pool
 140
 141 instance HasSettings DevEnv where
 142   settings = dev_env_settings
 143
 144
 145 instance HasNodeStoryEnv DevEnv where
 146   hasNodeStory = dev_env_nodeStory
 147
 148 instance HasNodeStoryVar DevEnv where
 149   hasNodeStoryVar = hasNodeStory . nse_getter
 150
 151 instance HasNodeStorySaver DevEnv where
 152   hasNodeStorySaver = hasNodeStory . nse_saver
 153
 154 instance HasNodeStoryImmediateSaver DevEnv where
 155   hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
 156
 157 instance HasNodeArchiveStoryImmediateSaver DevEnv where
 158   hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
 159
 160 instance HasMail DevEnv where
 161   mailSettings = dev_env_mail
 162
 163 instance HasNLPServer DevEnv where
 164   nlpServer = dev_env_nlp