]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Settings.hs
Less type errors and undefined cases
[gargantext.git] / 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.Log.FastLogger
26 import GHC.Enum
27 import GHC.Generics (Generic)
28 import Prelude (Bounded())
29 import System.Environment (lookupEnv)
30 import System.IO (FilePath)
31 import Database.PostgreSQL.Simple (Connection, connect)
32 import Network.HTTP.Client (Manager)
33 import Network.HTTP.Client.TLS (newTlsManager)
34
35 import Data.Maybe (fromMaybe)
36 import Data.Either (either)
37 import Data.Text
38 import Data.Text.Encoding (encodeUtf8)
39 import Data.ByteString.Lazy.Internal
40
41 import Servant
42 import Servant.Client (BaseUrl, parseBaseUrl)
43 import Servant.Job.Async (newJobEnv, defaultSettings)
44 import Web.HttpApiData (parseUrlPiece)
45 import qualified Jose.Jwk as Jose
46 import qualified Jose.Jwa as Jose
47
48 import Control.Concurrent
49 import Control.Monad.Logger
50 import Control.Lens
51 import Gargantext.Prelude
52 import Gargantext.Database.Utils (databaseParameters, HasConnection(..))
53 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initRepo)
54 import Gargantext.API.Orchestrator.Types
55
56 type PortNumber = Int
57
58 data SendEmailType = SendEmailViaAws
59 | LogEmailToConsole
60 | WriteEmailToFile
61 deriving (Show, Read, Enum, Bounded, Generic)
62
63
64 data Settings = Settings
65 { _allowedOrigin :: ByteString -- ^ allowed origin for CORS
66 , _allowedHost :: ByteString -- ^ allowed host for CORS
67 , _appPort :: PortNumber
68 , _logLevelLimit :: LogLevel -- ^ log level from the monad-logger package
69 -- , _dbServer :: Text
70 -- ^ this is not used yet
71 , _jwtSecret :: Jose.Jwk -- ^ key from the jose-jwt package
72 , _sendLoginEmails :: SendEmailType
73 , _scrapydUrl :: BaseUrl
74 }
75
76 makeLenses ''Settings
77
78
79 parseJwk :: Text -> Jose.Jwk
80 parseJwk secretStr = jwk
81 where
82 secretBs = encodeUtf8 secretStr
83 jwk = Jose.SymmetricJwk secretBs
84 Nothing
85 Nothing
86 (Just $ Jose.Signed Jose.HS256)
87
88 devSettings :: Settings
89 devSettings = Settings
90 { _allowedOrigin = "http://localhost:8008"
91 , _allowedHost = "localhost:3000"
92 , _appPort = 3000
93 , _logLevelLimit = LevelDebug
94 -- , _dbServer = "localhost"
95 -- generate with dd if=/dev/urandom bs=1 count=32 | base64
96 -- make sure jwtSecret differs between development and production, because you do not want
97 -- your production key inside source control.
98 , _jwtSecret = parseJwk "MVg0YAPVSPiYQc/qIs/rV/X32EFR0zOJWfHFgMbszMw="
99 , _sendLoginEmails = LogEmailToConsole
100 , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
101 }
102
103
104
105 reqSetting :: FromHttpApiData a => Text -> IO a
106 reqSetting name = do
107 e <- fromMaybe (panic $ "Missing " <> name) <$> lookupEnv (unpack name)
108 pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
109
110 optSetting :: FromHttpApiData a => Text -> a -> IO a
111 optSetting name d = do
112 me <- lookupEnv (unpack name)
113 case me of
114 Nothing -> pure d
115 Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e
116
117 --settingsFromEnvironment :: IO Settings
118 --settingsFromEnvironment =
119 -- Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
120 -- <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
121 -- <*> optSetting "PORT" 3000
122 -- <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
123 -- <*> reqSetting "DB_SERVER"
124 -- <*> (parseJwk <$> reqSetting "JWT_SECRET")
125 -- <*> optSetting "SEND_EMAIL" SendEmailViaAws
126
127 data FireWall = FireWall { unFireWall :: Bool }
128
129 data Env = Env
130 { _env_settings :: !Settings
131 , _env_logger :: !LoggerSet
132 , _env_conn :: !Connection
133 , _env_repo_var :: !(MVar NgramsRepo)
134 , _env_manager :: !Manager
135 , _env_self_url :: !BaseUrl
136 , _env_scrapers :: !ScrapersEnv
137 }
138 deriving (Generic)
139
140 makeLenses ''Env
141
142 instance HasConnection Env where
143 connection = env_conn
144
145 instance HasRepoVar Env where
146 repoVar = env_repo_var
147
148 data MockEnv = MockEnv
149 { _menv_firewall :: !FireWall
150 }
151 deriving (Generic)
152
153 makeLenses ''MockEnv
154
155 newEnv :: PortNumber -> FilePath -> IO Env
156 newEnv port file = do
157 manager <- newTlsManager
158 settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
159 when (port /= settings ^. appPort) $
160 panic "TODO: conflicting settings of port"
161 self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
162 param <- databaseParameters file
163 conn <- connect param
164 repo_var <- newMVar initRepo
165 scrapers_env <- newJobEnv defaultSettings manager
166 logger <- newStderrLoggerSet defaultBufSize
167 pure $ Env
168 { _env_settings = settings
169 , _env_logger = logger
170 , _env_conn = conn
171 , _env_repo_var = repo_var
172 , _env_manager = manager
173 , _env_scrapers = scrapers_env
174 , _env_self_url = self_url
175 }