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.JsonState
  42 import Data.Text
  43 import Data.Text.Encoding (encodeUtf8)
  44 import Data.Time.Units
  45 import Data.ByteString.Lazy.Internal
  46
  47 import Servant
  48 import Servant.Client (BaseUrl, parseBaseUrl)
  49 import Servant.Job.Async (newJobEnv, defaultSettings)
  50 import Web.HttpApiData (parseUrlPiece)
  51 import qualified Jose.Jwk as Jose
  52 import qualified Jose.Jwa as Jose
  53
  54 import Control.Concurrent
  55 import Control.Exception (finally)
  56 import Control.Monad.Logger
  57 import Control.Monad.Reader
  58 import Control.Lens
  59 import Gargantext.Prelude
  60 import Gargantext.Database.Utils (databaseParameters, HasConnection(..), Cmd', runCmd)
  61 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), initMockRepo, r_version, saveRepo)
  62 import Gargantext.API.Orchestrator.Types
  63
  64 type PortNumber = Int
  65
  66 data SendEmailType = SendEmailViaAws
  67                    | LogEmailToConsole
  68                    | WriteEmailToFile
  69     deriving (Show, Read, Enum, Bounded, Generic)
  70
  71
  72 data Settings = Settings
  73     { _allowedOrigin   :: ByteString -- ^ allowed origin for CORS
  74     , _allowedHost     :: ByteString   -- ^ allowed host for CORS
  75     , _appPort         :: PortNumber
  76     , _logLevelLimit   :: LogLevel -- ^ log level from the monad-logger package
  77 --    , _dbServer        :: Text
  78 --    ^ this is not used yet
  79     , _jwtSecret       :: Jose.Jwk -- ^ key from the jose-jwt package
  80     , _sendLoginEmails :: SendEmailType
  81     , _scrapydUrl      :: BaseUrl
  82     }
  83
  84 makeLenses ''Settings
  85
  86
  87 parseJwk :: Text -> Jose.Jwk
  88 parseJwk secretStr = jwk
  89     where
  90         secretBs = encodeUtf8 secretStr
  91         jwk      = Jose.SymmetricJwk secretBs
  92                                      Nothing
  93                                      Nothing
  94                                      (Just $ Jose.Signed Jose.HS256)
  95
  96 devSettings :: Settings
  97 devSettings = Settings
  98     { _allowedOrigin = "http://localhost:8008"
  99     , _allowedHost = "localhost:3000"
 100     , _appPort = 3000
 101     , _logLevelLimit = LevelDebug
 102 --    , _dbServer = "localhost"
 103     -- generate with dd if=/dev/urandom bs=1 count=32 | base64
 104     -- make sure jwtSecret differs between development and production, because you do not want
 105     -- your production key inside source control.
 106     , _jwtSecret = parseJwk "MVg0YAPVSPiYQc/qIs/rV/X32EFR0zOJWfHFgMbszMw="
 107     , _sendLoginEmails = LogEmailToConsole
 108     , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
 109     }
 110
 111
 112
 113 reqSetting :: FromHttpApiData a => Text -> IO a
 114 reqSetting name = do
 115     e <- fromMaybe (panic $ "Missing " <> name) <$> lookupEnv (unpack name)
 116     pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 117
 118 optSetting :: FromHttpApiData a => Text -> a -> IO a
 119 optSetting name d = do
 120     me <- lookupEnv (unpack name)
 121     case me of
 122         Nothing -> pure d
 123         Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
 124
 125 --settingsFromEnvironment :: IO Settings
 126 --settingsFromEnvironment =
 127 --    Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
 128 --             <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
 129 --             <*> optSetting "PORT" 3000
 130 --             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
 131 --             <*> reqSetting "DB_SERVER"
 132 --             <*> (parseJwk <$> reqSetting "JWT_SECRET")
 133 --             <*> optSetting "SEND_EMAIL" SendEmailViaAws
 134
 135 data FireWall = FireWall { unFireWall :: Bool }
 136
 137 data Env = Env
 138   { _env_settings   :: !Settings
 139   , _env_logger     :: !LoggerSet
 140   , _env_conn       :: !Connection
 141   , _env_repo_var   :: !(MVar NgramsRepo)
 142   , _env_repo_saver :: !(IO ())
 143   , _env_manager    :: !Manager
 144   , _env_self_url   :: !BaseUrl
 145   , _env_scrapers   :: !ScrapersEnv
 146   }
 147   deriving (Generic)
 148
 149 makeLenses ''Env
 150
 151 instance HasConnection Env where
 152   connection = env_conn
 153
 154 instance HasRepoVar Env where
 155   repoVar = env_repo_var
 156
 157 instance HasRepoSaver Env where
 158   repoSaver = env_repo_saver
 159
 160 data MockEnv = MockEnv
 161   { _menv_firewall :: !FireWall
 162   }
 163   deriving (Generic)
 164
 165 makeLenses ''MockEnv
 166
 167 repoSnapshot :: FilePath
 168 repoSnapshot = "repo.json"
 169
 170 readRepo :: IO (MVar NgramsRepo)
 171 readRepo = do
 172   repoExists <- doesFileExist repoSnapshot
 173   newMVar =<<
 174     if repoExists
 175       then do
 176         e_repo <- eitherDecodeFileStrict repoSnapshot
 177         repo <- either fail pure e_repo
 178         let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
 179         renameFile repoSnapshot archive
 180         pure repo
 181       else
 182         pure initMockRepo
 183
 184 mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
 185 mkRepoSaver repo_var = do
 186   saveAction <- mkSaveState (10 :: Second) repoSnapshot
 187   pure $ readMVar repo_var >>= saveAction
 188
 189 newEnv :: PortNumber -> FilePath -> IO Env
 190 newEnv port file = do
 191   manager <- newTlsManager
 192   settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
 193   when (port /= settings ^. appPort) $
 194     panic "TODO: conflicting settings of port"
 195   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
 196   param <- databaseParameters file
 197   conn <- connect param
 198   repo_var <- readRepo
 199   repo_saver <- mkRepoSaver repo_var
 200   scrapers_env <- newJobEnv defaultSettings manager
 201   logger <- newStderrLoggerSet defaultBufSize
 202   pure $ Env
 203     { _env_settings   = settings
 204     , _env_logger     = logger
 205     , _env_conn       = conn
 206     , _env_repo_var   = repo_var
 207     , _env_repo_saver = repo_saver
 208     , _env_manager    = manager
 209     , _env_scrapers   = scrapers_env
 210     , _env_self_url   = self_url
 211     }
 212
 213 data DevEnv = DevEnv
 214   { _dev_env_conn       :: !Connection
 215   , _dev_env_repo_var   :: !(MVar NgramsRepo)
 216   , _dev_env_repo_saver :: !(IO ())
 217   }
 218
 219 makeLenses ''DevEnv
 220
 221 instance HasConnection DevEnv where
 222   connection = dev_env_conn
 223
 224 instance HasRepoVar DevEnv where
 225   repoVar = dev_env_repo_var
 226
 227 instance HasRepoSaver DevEnv where
 228   repoSaver = dev_env_repo_saver
 229
 230 newDevEnvWith :: FilePath -> IO DevEnv
 231 newDevEnvWith file = do
 232   param <- databaseParameters file
 233   conn <- connect param
 234   repo_var <- newMVar initMockRepo
 235   repo_saver <- mkRepoSaver repo_var
 236   pure $ DevEnv
 237     { _dev_env_conn       = conn
 238     , _dev_env_repo_var   = repo_var
 239     , _dev_env_repo_saver = repo_saver
 240     }
 241
 242 newDevEnv :: IO DevEnv
 243 newDevEnv = newDevEnvWith "gargantext.ini"
 244
 245 -- Use only for dev
 246 -- In particular this writes the repo file after running
 247 -- the command.
 248 -- This function is constrained to the DevEnv rather than
 249 -- using HasConnection and HasRepoVar.
 250 runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
 251 runCmdDev env f =
 252   (either (fail . show) pure =<< runCmd env f)
 253     `finally`
 254   runReaderT saveRepo env
 255
 256 -- Use only for dev
 257 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 258 runCmdDevNoErr = runCmdDev
 259
 260 -- Use only for dev
 261 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
 262 runCmdDevServantErr = runCmdDev