src/Gargantext/API/Admin/EnvTypes.hs

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