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 FlexibleContexts            #-}
  21 {-# LANGUAGE FlexibleInstances           #-}
  22 {-# LANGUAGE RankNTypes                  #-}
  23
  24 module Gargantext.API.Settings
  25     where
  26
  27 import System.Directory
  28 import System.Log.FastLogger
  29 import GHC.Enum
  30 import GHC.Generics (Generic)
  31 import Prelude (Bounded(), fail)
  32 import System.Environment (lookupEnv)
  33 import System.IO (FilePath)
  34 import Database.PostgreSQL.Simple (Connection, connect)
  35 import Network.HTTP.Client (Manager)
  36 import Network.HTTP.Client.TLS (newTlsManager)
  37
  38 import Data.Aeson
  39 import Data.Maybe (fromMaybe)
  40 import Data.Either (either)
  41 import Data.Text
  42 import Data.Text.Encoding (encodeUtf8)
  43 import Data.ByteString.Lazy.Internal
  44
  45 import Servant
  46 import Servant.Client (BaseUrl, parseBaseUrl)
  47 import Servant.Job.Async (newJobEnv, defaultSettings)
  48 import Web.HttpApiData (parseUrlPiece)
  49 import qualified Jose.Jwk as Jose
  50 import qualified Jose.Jwa as Jose
  51
  52 import Control.Concurrent
  53 import Control.Exception (finally)
  54 import Control.Monad.Logger
  55 import Control.Lens
  56 import Gargantext.Prelude
  57 import Gargantext.Database.Utils (databaseParameters, HasConnection(..), Cmd', runCmd)
  58 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initMockRepo, r_version)
  59 import Gargantext.API.Orchestrator.Types
  60
  61 type PortNumber = Int
  62
  63 data SendEmailType = SendEmailViaAws
  64                    | LogEmailToConsole
  65                    | WriteEmailToFile
  66     deriving (Show, Read, Enum, Bounded, Generic)
  67
  68
  69 data Settings = Settings
  70     { _allowedOrigin   :: ByteString -- ^ allowed origin for CORS
  71     , _allowedHost     :: ByteString   -- ^ allowed host for CORS
  72     , _appPort         :: PortNumber
  73     , _logLevelLimit   :: LogLevel -- ^ log level from the monad-logger package
  74 --    , _dbServer        :: Text
  75 --    ^ this is not used yet
  76     , _jwtSecret       :: Jose.Jwk -- ^ key from the jose-jwt package
  77     , _sendLoginEmails :: SendEmailType
  78     , _scrapydUrl      :: BaseUrl
  79     }
  80
  81 makeLenses ''Settings
  82
  83
  84 parseJwk :: Text -> Jose.Jwk
  85 parseJwk secretStr = jwk
  86     where
  87         secretBs = encodeUtf8 secretStr
  88         jwk      = Jose.SymmetricJwk secretBs
  89                                      Nothing
  90                                      Nothing
  91                                      (Just $ Jose.Signed Jose.HS256)
  92
  93 devSettings :: Settings
  94 devSettings = Settings
  95     { _allowedOrigin = "http://localhost:8008"
  96     , _allowedHost = "localhost:3000"
  97     , _appPort = 3000
  98     , _logLevelLimit = LevelDebug
  99 --    , _dbServer = "localhost"
 100     -- generate with dd if=/dev/urandom bs=1 count=32 | base64
 101     -- make sure jwtSecret differs between development and production, because you do not want
 102     -- your production key inside source control.
 103     , _jwtSecret = parseJwk "MVg0YAPVSPiYQc/qIs/rV/X32EFR0zOJWfHFgMbszMw="
 104     , _sendLoginEmails = LogEmailToConsole
 105     , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
 106     }
 107
 108
 109
 110 reqSetting :: FromHttpApiData a => Text -> IO a
 111 reqSetting name = do
 112     e <- fromMaybe (panic $ "Missing " <> name) <$> lookupEnv (unpack name)
 113     pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 114
 115 optSetting :: FromHttpApiData a => Text -> a -> IO a
 116 optSetting name d = do
 117     me <- lookupEnv (unpack name)
 118     case me of
 119         Nothing -> pure d
 120         Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 121
 122 --settingsFromEnvironment :: IO Settings
 123 --settingsFromEnvironment =
 124 --    Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
 125 --             <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
 126 --             <*> optSetting "PORT" 3000
 127 --             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
 128 --             <*> reqSetting "DB_SERVER"
 129 --             <*> (parseJwk <$> reqSetting "JWT_SECRET")
 130 --             <*> optSetting "SEND_EMAIL" SendEmailViaAws
 131
 132 data FireWall = FireWall { unFireWall :: Bool }
 133
 134 data Env = Env
 135   { _env_settings :: !Settings
 136   , _env_logger   :: !LoggerSet
 137   , _env_conn     :: !Connection
 138   , _env_repo_var :: !(MVar NgramsRepo)
 139   , _env_manager  :: !Manager
 140   , _env_self_url :: !BaseUrl
 141   , _env_scrapers :: !ScrapersEnv
 142   }
 143   deriving (Generic)
 144
 145 makeLenses ''Env
 146
 147 instance HasConnection Env where
 148   connection = env_conn
 149
 150 instance HasRepoVar Env where
 151   repoVar = env_repo_var
 152
 153 data MockEnv = MockEnv
 154   { _menv_firewall :: !FireWall
 155   }
 156   deriving (Generic)
 157
 158 makeLenses ''MockEnv
 159
 160 repoSnapshot :: FilePath
 161 repoSnapshot = "repo.json"
 162
 163 readRepo :: IO (MVar NgramsRepo)
 164 readRepo = do
 165   repoExists <- doesFileExist repoSnapshot
 166   newMVar =<<
 167     if repoExists
 168       then do
 169         e_repo <- eitherDecodeFileStrict repoSnapshot
 170         repo <- either fail pure e_repo
 171         let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
 172         renameFile repoSnapshot archive
 173         pure repo
 174       else
 175         pure initMockRepo
 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"
 224
 225 -- So far `cleanEnv` is just writing the repo file.
 226 -- Therefor it is called in `runCmdDev*` for convenience.
 227 cleanEnv :: HasRepoVar env => env -> IO ()
 228 cleanEnv env = encodeFile repoSnapshot =<< readMVar (env ^. repoVar)
 229
 230 -- Use only for dev
 231 -- In particular this writes the repo file after running
 232 -- the command.
 233 -- This function is constrained to the DevEnv rather than
 234 -- using HasConnection and HasRepoVar.
 235 -- This is to avoid calling cleanEnv unintentionally on a prod env.
 236 runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
 237 runCmdDev env f = do
 238   (either (fail . show) pure =<< runCmd env f)
 239     `finally` cleanEnv env
 240
 241 -- Use only for dev
 242 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 243 runCmdDevNoErr = runCmdDev
 244
 245 -- Use only for dev
 246 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
 247 runCmdDevServantErr = runCmdDev