[OPTIM + FIX] TFICF
[gargantext.git] / src / Gargantext / API / Admin / Settings.hs
index 7d914d13f398f1ef98a84fb767d9fc352df23adb..7a1f364a864b9391e833fe878b703b35b9858371 100644 (file)
@@ -12,28 +12,19 @@ TODO-SECURITY: Critical
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Admin.Settings
     where
 
-import Codec.Serialise (Serialise(), serialise)
+import Codec.Serialise (Serialise(), serialise, deserialise)
 import Control.Concurrent
 import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
 import Control.Exception (finally)
 import Control.Lens
 import Control.Monad.Logger
 import Control.Monad.Reader
-import Data.Aeson hiding (encode)
 import Data.ByteString (ByteString)
 import Data.Either (either)
 import Data.Maybe (fromMaybe)
@@ -44,8 +35,9 @@ import GHC.Enum
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo, renv_var, renv_lock)
-import Gargantext.Database.Prelude (databaseParameters, HasConnectionPool(..), Cmd', runCmd)
+import Gargantext.Database.Prelude (databaseParameters, HasConnectionPool(..), Cmd', runCmd, HasConfig(..))
 import Gargantext.Prelude
+
 import Network.HTTP.Client (Manager)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Prelude (Bounded(), fail)
@@ -62,7 +54,7 @@ import System.Log.FastLogger
 import Web.HttpApiData (parseUrlPiece)
 import qualified Data.ByteString.Lazy as L
 import qualified Servant.Job.Core
-
+import Gargantext.Prelude.Config (GargConfig(), readConfig, defaultConfig)
 
 type PortNumber = Int
 
@@ -83,7 +75,7 @@ data Settings = Settings
     , _cookieSettings  :: CookieSettings
     , _sendLoginEmails :: SendEmailType
     , _scrapydUrl      :: BaseUrl
-    , _fileFolder      :: FilePath
+    , _config          :: GargConfig
     }
 
 makeLenses ''Settings
@@ -95,7 +87,7 @@ devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
-  jwk <- readKey jwkFile
+  jwk       <- readKey jwkFile
   pure $ Settings
     { _allowedOrigin = "http://localhost:8008"
     , _allowedHost = "localhost:3000"
@@ -104,9 +96,9 @@ devSettings jwkFile = do
 --    , _dbServer = "localhost"
     , _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
+    , _config      = defaultConfig
     }
   where
     xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
@@ -145,11 +137,15 @@ data Env = Env
   , _env_manager  :: !Manager
   , _env_self_url :: !BaseUrl
   , _env_scrapers :: !ScrapersEnv
+  , _env_gargConfig :: !GargConfig
   }
   deriving (Generic)
 
 makeLenses ''Env
 
+instance HasConfig Env where
+  hasConfig = env_gargConfig
+
 instance HasConnectionPool Env where
   connPool = env_pool
 
@@ -165,10 +161,10 @@ instance HasRepo Env where
 instance HasSettings Env where
   settings = env_settings
 
-instance Servant.Job.Core.HasEnv Env (Job ScraperStatus ScraperStatus) where
+instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
   _env = env_scrapers . Servant.Job.Core._env
 
-instance HasJobEnv Env ScraperStatus ScraperStatus where
+instance HasJobEnv Env JobLog JobLog where
   job_env = env_scrapers
 
 data MockEnv = MockEnv
@@ -184,14 +180,14 @@ repoDir :: FilePath
 repoDir = "repos"
 
 repoSnapshot :: FilePath
-repoSnapshot = repoDir <> "/repo.json"
+repoSnapshot = repoDir <> "/repo.cbor"
 
 -- | TODO add hard coded file in Settings
 -- This assumes we own the lock on repoSnapshot.
 repoSaverAction :: Serialise a => a -> IO ()
 repoSaverAction a = do
-  withTempFile "repos" "tmp-repo.json" $ \fp h -> do
-    -- printDebug "repoSaverAction" fp
+  withTempFile "repos" "tmp-repo.cbor" $ \fp h -> do
+    printDebug "repoSaverAction" fp
     L.hPut h $ serialise a
     hClose h
     renameFile fp repoSnapshot
@@ -200,7 +196,7 @@ mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
 mkRepoSaver repo_var = mkDebounce settings
   where
     settings = defaultDebounceSettings
-                 { debounceFreq   = 1000000 -- 1 second
+                 { debounceFreq   = let n = 6 :: Int in 10^n  -- 1 second
                  , debounceAction = withMVar repo_var repoSaverAction
                    -- Here this not only `readMVar` but `takeMVar`.
                    -- Namely while repoSaverAction is saving no other change
@@ -230,8 +226,9 @@ readRepoEnv = do
   mvar <- newMVar =<<
     if repoExists
       then do
-        e_repo <- eitherDecodeFileStrict repoSnapshot
-        repo   <- either fail pure e_repo
+        -- e_repo <- eitherDecodeStrict <$> deserialise <$> L.readFile repoSnapshot
+        repo <- deserialise <$> L.readFile repoSnapshot
+        -- repo   <- either fail pure e_repo
         let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
         copyFile repoSnapshot archive
         pure repo
@@ -246,17 +243,18 @@ devJwkFile = "dev.jwk"
 
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
-  manager <- newTlsManager
-  settings <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
+  manager     <- newTlsManager
+  settings    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
   when (port /= settings ^. appPort) $
     panic "TODO: conflicting settings of port"
 
-  self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
-  param    <- databaseParameters file
-  pool     <- newPool param
-  repo     <- readRepoEnv
+  self_url     <- parseBaseUrl $ "http://0.0.0.0:" <> show port
+  param        <- databaseParameters file
+  pool         <- newPool param
+  repo         <- readRepoEnv
   scrapers_env <- newJobEnv defaultSettings manager
-  logger <- newStderrLoggerSet defaultBufSize
+  logger       <- newStderrLoggerSet defaultBufSize
+  config       <- readConfig file
 
   pure $ Env
     { _env_settings   = settings
@@ -266,19 +264,24 @@ newEnv port file = do
     , _env_manager    = manager
     , _env_scrapers   = scrapers_env
     , _env_self_url   = self_url
+    , _env_gargConfig = config
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)
 newPool param = createPool (connect param) close 1 (60*60) 8
 
 data DevEnv = DevEnv
-  { _dev_env_pool :: !(Pool Connection)
-  , _dev_env_repo :: !RepoEnv
+  { _dev_env_pool     :: !(Pool Connection)
+  , _dev_env_repo     :: !RepoEnv
   , _dev_env_settings :: !Settings
+  , _dev_env_config   :: !GargConfig
   }
 
 makeLenses ''DevEnv
 
+instance HasConfig DevEnv where
+  hasConfig = dev_env_config
+
 instance HasConnectionPool DevEnv where
   connPool = dev_env_pool
 
@@ -311,13 +314,16 @@ withDevEnv iniPath k = do
       pool  <- newPool param
       repo  <- readRepoEnv
       setts <- devSettings devJwkFile
+      config <- readConfig iniPath
       pure $ DevEnv
         { _dev_env_pool = pool
         , _dev_env_repo = repo
         , _dev_env_settings = setts
+        , _dev_env_config   = config
         }
 
 -- | 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