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 (mkSaveState)
  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   -- | Does file exist ? :: Bool
 173   repoFile <- doesFileExist repoSnapshot
 174
 175   -- | Is file not empty ? :: Bool
 176   repoExists <- if repoFile
 177              then (>0) <$> getFileSize repoSnapshot
 178              else pure repoFile
 179
 180   newMVar =<<
 181     if repoExists
 182       then do
 183         e_repo <- eitherDecodeFileStrict repoSnapshot
 184         repo   <- either fail pure e_repo
 185         let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
 186         copyFile repoSnapshot archive
 187         pure repo
 188       else
 189         pure initMockRepo
 190
 191 mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
 192 mkRepoSaver repo_var = do
 193   saveAction <- mkSaveState (10 :: Second) repoSnapshot
 194   pure $ readMVar repo_var >>= saveAction
 195
 196 newEnv :: PortNumber -> FilePath -> IO Env
 197 newEnv port file = do
 198   manager <- newTlsManager
 199   settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
 200   when (port /= settings ^. appPort) $
 201     panic "TODO: conflicting settings of port"
 202
 203   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
 204   param    <- databaseParameters file
 205   conn     <- connect param
 206
 207   repo_var     <- readRepo
 208   repo_saver   <- mkRepoSaver repo_var
 209   scrapers_env <- newJobEnv defaultSettings manager
 210   logger <- newStderrLoggerSet defaultBufSize
 211
 212   pure $ Env
 213     { _env_settings   = settings
 214     , _env_logger     = logger
 215     , _env_conn       = conn
 216     , _env_repo_var   = repo_var
 217     , _env_repo_saver = repo_saver
 218     , _env_manager    = manager
 219     , _env_scrapers   = scrapers_env
 220     , _env_self_url   = self_url
 221     }
 222
 223 data DevEnv = DevEnv
 224   { _dev_env_conn       :: !Connection
 225   , _dev_env_repo_var   :: !(MVar NgramsRepo)
 226   , _dev_env_repo_saver :: !(IO ())
 227   }
 228
 229 makeLenses ''DevEnv
 230
 231 instance HasConnection DevEnv where
 232   connection = dev_env_conn
 233
 234 instance HasRepoVar DevEnv where
 235   repoVar = dev_env_repo_var
 236
 237 instance HasRepoSaver DevEnv where
 238   repoSaver = dev_env_repo_saver
 239
 240 newDevEnvWith :: FilePath -> IO DevEnv
 241 newDevEnvWith file = do
 242   param      <- databaseParameters file
 243   conn       <- connect param
 244   repo_var   <- newMVar initMockRepo
 245   repo_saver <- mkRepoSaver repo_var
 246   pure $ DevEnv
 247     { _dev_env_conn       = conn
 248     , _dev_env_repo_var   = repo_var
 249     , _dev_env_repo_saver = repo_saver
 250     }
 251
 252 newDevEnv :: IO DevEnv
 253 newDevEnv = newDevEnvWith "gargantext.ini"
 254
 255 -- Use only for dev
 256 -- In particular this writes the repo file after running
 257 -- the command.
 258 -- This function is constrained to the DevEnv rather than
 259 -- using HasConnection and HasRepoVar.
 260 runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
 261 runCmdDev env f =
 262   (either (fail . show) pure =<< runCmd env f)
 263     `finally`
 264   runReaderT saveRepo env
 265
 266 -- Use only for dev
 267 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 268 runCmdDevNoErr = runCmdDev
 269
 270 -- Use only for dev
 271 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
 272 runCmdDevServantErr = runCmdDev