src/Gargantext/API/Settings.hs

   1 {-|
   2 Module      : Gargantext.API.Settings
   3 Description : Settings of the API (Server and Client)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11
  12 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  13
  14 {-# LANGUAGE NoImplicitPrelude           #-}
  15 {-# LANGUAGE DataKinds                   #-}
  16 {-# LANGUAGE DeriveGeneric               #-}
  17 {-# LANGUAGE ScopedTypeVariables         #-}
  18 {-# LANGUAGE TemplateHaskell             #-}
  19 {-# LANGUAGE OverloadedStrings           #-}
  20 {-# LANGUAGE FlexibleInstances           #-}
  21
  22 module Gargantext.API.Settings
  23     where
  24
  25 import System.Directory
  26 import System.Log.FastLogger
  27 import GHC.Enum
  28 import GHC.Generics (Generic)
  29 import Prelude (Bounded(), fail)
  30 import System.Environment (lookupEnv)
  31 import System.IO (FilePath)
  32 import Database.PostgreSQL.Simple (Connection, connect)
  33 import Network.HTTP.Client (Manager)
  34 import Network.HTTP.Client.TLS (newTlsManager)
  35
  36 import Data.Aeson
  37 import Data.Maybe (fromMaybe)
  38 import Data.Either (either)
  39 import Data.Text
  40 import Data.Text.Encoding (encodeUtf8)
  41 import Data.ByteString.Lazy.Internal
  42
  43 import Servant
  44 import Servant.Client (BaseUrl, parseBaseUrl)
  45 import Servant.Job.Async (newJobEnv, defaultSettings)
  46 import Web.HttpApiData (parseUrlPiece)
  47 import qualified Jose.Jwk as Jose
  48 import qualified Jose.Jwa as Jose
  49
  50 import Control.Concurrent
  51 import Control.Monad.Logger
  52 import Control.Lens
  53 import Gargantext.Prelude
  54 import Gargantext.Database.Utils (databaseParameters, HasConnection(..))
  55 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initMockRepo, r_version)
  56 import Gargantext.API.Orchestrator.Types
  57
  58 type PortNumber = Int
  59
  60 data SendEmailType = SendEmailViaAws
  61                    | LogEmailToConsole
  62                    | WriteEmailToFile
  63     deriving (Show, Read, Enum, Bounded, Generic)
  64
  65
  66 data Settings = Settings
  67     { _allowedOrigin   :: ByteString -- ^ allowed origin for CORS
  68     , _allowedHost     :: ByteString   -- ^ allowed host for CORS
  69     , _appPort         :: PortNumber
  70     , _logLevelLimit   :: LogLevel -- ^ log level from the monad-logger package
  71 --    , _dbServer        :: Text
  72 --    ^ this is not used yet
  73     , _jwtSecret       :: Jose.Jwk -- ^ key from the jose-jwt package
  74     , _sendLoginEmails :: SendEmailType
  75     , _scrapydUrl      :: BaseUrl
  76     }
  77
  78 makeLenses ''Settings
  79
  80
  81 parseJwk :: Text -> Jose.Jwk
  82 parseJwk secretStr = jwk
  83     where
  84         secretBs = encodeUtf8 secretStr
  85         jwk      = Jose.SymmetricJwk secretBs
  86                                      Nothing
  87                                      Nothing
  88                                      (Just $ Jose.Signed Jose.HS256)
  89
  90 devSettings :: Settings
  91 devSettings = Settings
  92     { _allowedOrigin = "http://localhost:8008"
  93     , _allowedHost = "localhost:3000"
  94     , _appPort = 3000
  95     , _logLevelLimit = LevelDebug
  96 --    , _dbServer = "localhost"
  97     -- generate with dd if=/dev/urandom bs=1 count=32 | base64
  98     -- make sure jwtSecret differs between development and production, because you do not want
  99     -- your production key inside source control.
 100     , _jwtSecret = parseJwk "MVg0YAPVSPiYQc/qIs/rV/X32EFR0zOJWfHFgMbszMw="
 101     , _sendLoginEmails = LogEmailToConsole
 102     , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
 103     }
 104
 105
 106
 107 reqSetting :: FromHttpApiData a => Text -> IO a
 108 reqSetting name = do
 109     e <- fromMaybe (panic $ "Missing " <> name) <$> lookupEnv (unpack name)
 110     pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 111
 112 optSetting :: FromHttpApiData a => Text -> a -> IO a
 113 optSetting name d = do
 114     me <- lookupEnv (unpack name)
 115     case me of
 116         Nothing -> pure d
 117         Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 118
 119 --settingsFromEnvironment :: IO Settings
 120 --settingsFromEnvironment =
 121 --    Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
 122 --             <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
 123 --             <*> optSetting "PORT" 3000
 124 --             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
 125 --             <*> reqSetting "DB_SERVER"
 126 --             <*> (parseJwk <$> reqSetting "JWT_SECRET")
 127 --             <*> optSetting "SEND_EMAIL" SendEmailViaAws
 128
 129 data FireWall = FireWall { unFireWall :: Bool }
 130
 131 data Env = Env
 132   { _env_settings :: !Settings
 133   , _env_logger   :: !LoggerSet
 134   , _env_conn     :: !Connection
 135   , _env_repo_var :: !(MVar NgramsRepo)
 136   , _env_manager  :: !Manager
 137   , _env_self_url :: !BaseUrl
 138   , _env_scrapers :: !ScrapersEnv
 139   }
 140   deriving (Generic)
 141
 142 makeLenses ''Env
 143
 144 instance HasConnection Env where
 145   connection = env_conn
 146
 147 instance HasRepoVar Env where
 148   repoVar = env_repo_var
 149
 150 data MockEnv = MockEnv
 151   { _menv_firewall :: !FireWall
 152   }
 153   deriving (Generic)
 154
 155 makeLenses ''MockEnv
 156
 157 repoSnapshot :: FilePath
 158 repoSnapshot = "repo.json"
 159
 160 readRepo :: IO (MVar NgramsRepo)
 161 readRepo = do
 162   repoExists <- doesFileExist repoSnapshot
 163   newMVar =<<
 164     if repoExists
 165       then do
 166         e_repo <- eitherDecodeFileStrict repoSnapshot
 167         repo <- either fail pure e_repo
 168         let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
 169         renameFile repoSnapshot archive
 170         pure repo
 171       else
 172         pure initMockRepo
 173
 174 cleanEnv :: HasRepoVar env => env -> IO ()
 175 cleanEnv env = encodeFile repoSnapshot =<< readMVar (env ^. repoVar)
 176
 177 newEnv :: PortNumber -> FilePath -> IO Env
 178 newEnv port file = do
 179   manager <- newTlsManager
 180   settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
 181   when (port /= settings ^. appPort) $
 182     panic "TODO: conflicting settings of port"
 183   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
 184   param <- databaseParameters file
 185   conn <- connect param
 186   repo_var <- readRepo
 187   scrapers_env <- newJobEnv defaultSettings manager
 188   logger <- newStderrLoggerSet defaultBufSize
 189   pure $ Env
 190     { _env_settings = settings
 191     , _env_logger   = logger
 192     , _env_conn     = conn
 193     , _env_repo_var = repo_var
 194     , _env_manager  = manager
 195     , _env_scrapers = scrapers_env
 196     , _env_self_url = self_url
 197     }
 198
 199 data DevEnv = DevEnv
 200   { _dev_env_conn     :: !Connection
 201   , _dev_env_repo_var :: !(MVar NgramsRepo)
 202   }
 203
 204 makeLenses ''DevEnv
 205
 206 instance HasConnection DevEnv where
 207   connection = dev_env_conn
 208
 209 instance HasRepoVar DevEnv where
 210   repoVar = dev_env_repo_var
 211
 212 newDevEnvWith :: FilePath -> IO DevEnv
 213 newDevEnvWith file = do
 214   param <- databaseParameters file
 215   conn <- connect param
 216   repo_var <- newMVar initMockRepo
 217   pure $ DevEnv
 218     { _dev_env_conn     = conn
 219     , _dev_env_repo_var = repo_var
 220     }
 221
 222 newDevEnv :: IO DevEnv
 223 newDevEnv = newDevEnvWith "gargantext.ini"