Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
+
+TODO-SECURITY: Critical
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
import Data.Maybe (fromMaybe)
import Data.Either (either)
import Data.Text
-import Data.Text.Encoding (encodeUtf8)
+--import Data.Text.Encoding (encodeUtf8)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Servant
+import Servant.Auth.Server (defaultJWTSettings, JWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey)
import Servant.Client (BaseUrl, parseBaseUrl)
-import Servant.Job.Async (newJobEnv, defaultSettings)
+import qualified Servant.Job.Core
+import Servant.Job.Async (newJobEnv, defaultSettings, HasJobEnv(..), Job)
import Web.HttpApiData (parseUrlPiece)
-import qualified Jose.Jwk as Jose
-import qualified Jose.Jwa as Jose
import Control.Concurrent
import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
, _logLevelLimit :: LogLevel -- log level from the monad-logger package
-- , _dbServer :: Text
-- ^ this is not used yet
- , _jwtSecret :: Jose.Jwk -- key from the jose-jwt package
+ , _jwtSettings :: JWTSettings
+ , _cookieSettings :: CookieSettings
, _sendLoginEmails :: SendEmailType
, _scrapydUrl :: BaseUrl
, _fileFolder :: FilePath
class HasSettings env where
settings :: Getter env Settings
-
-parseJwk :: Text -> Jose.Jwk
-parseJwk secretStr = jwk
- where
- secretBs = encodeUtf8 secretStr
- jwk = Jose.SymmetricJwk secretBs
- Nothing
- Nothing
- (Just $ Jose.Signed Jose.HS256)
-
-devSettings :: Settings
-devSettings = Settings
+devSettings :: FilePath -> IO Settings
+devSettings jwkFile = do
+ jwkExists <- doesFileExist jwkFile
+ when (not jwkExists) $ writeKey jwkFile
+ jwk <- readKey jwkFile
+ pure $ Settings
{ _allowedOrigin = "http://localhost:8008"
, _allowedHost = "localhost:3000"
, _appPort = 3000
, _logLevelLimit = LevelDebug
-- , _dbServer = "localhost"
- -- generate with dd if=/dev/urandom bs=1 count=32 | base64
- -- make sure jwtSecret differs between development and production, because you do not want
- -- your production key inside source control.
- , _jwtSecret = parseJwk "MVg0YAPVSPiYQc/qIs/rV/X32EFR0zOJWfHFgMbszMw="
, _sendLoginEmails = LogEmailToConsole
, _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
, _fileFolder = "data"
+ , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
+ , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
}
+ where
+ xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
instance HasSettings Env where
settings = env_settings
+instance Servant.Job.Core.HasEnv Env (Job ScraperStatus ScraperStatus) where
+ _env = env_scrapers . Servant.Job.Core._env
+
+instance HasJobEnv Env ScraperStatus ScraperStatus where
+ job_env = env_scrapers
+
data MockEnv = MockEnv
{ _menv_firewall :: !FireWall
}
makeLenses ''MockEnv
-- | TODO add this path in Settings
+
+repoDir :: FilePath
+repoDir = "repos"
+
repoSnapshot :: FilePath
-repoSnapshot = "repo.json"
+repoSnapshot = repoDir <> "/repo.json"
-- | TODO add hard coded file in Settings
-- This assumes we own the lock on repoSnapshot.
repoSaverAction :: ToJSON a => a -> IO ()
repoSaverAction a = do
- withTempFile "." "tmp-repo.json" $ \fp h -> do
+ withTempFile "repos" "tmp-repo.json" $ \fp h -> do
-- printDebug "repoSaverAction" fp
L.hPut h $ encode a
hClose h
readRepoEnv :: IO RepoEnv
readRepoEnv = do
-- Does file exist ? :: Bool
+ _repoDir <- createDirectoryIfMissing True repoDir
+
repoFile <- doesFileExist repoSnapshot
-- Is file not empty ? :: Bool
pure repo
else
pure initRepo
-
+ -- TODO save in DB here
saver <- mkRepoSaver mvar
pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
+devJwkFile :: FilePath
+devJwkFile = "dev.jwk"
+
newEnv :: PortNumber -> FilePath -> IO Env
newEnv port file = do
manager <- newTlsManager
- settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
+ settings <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
when (port /= settings ^. appPort) $
panic "TODO: conflicting settings of port"
param <- databaseParameters iniPath
conn <- connect param
repo <- readRepoEnv
+ setts <- devSettings devJwkFile
pure $ DevEnv
{ _dev_env_conn = conn
, _dev_env_repo = repo
- , _dev_env_settings = devSettings
+ , _dev_env_settings = setts
}
-- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: Show err => Cmd' DevEnv err a -> IO a
runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
-runCmdReplServantErr :: Cmd' DevEnv ServantErr a -> IO a
+runCmdReplServantErr :: Cmd' DevEnv ServerError a -> IO a
runCmdReplServantErr = runCmdRepl
-- Use only for dev
runCmdDevNoErr = runCmdDev
-- Use only for dev
-runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
+runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
runCmdDevServantErr = runCmdDev