{-| 
Module      : Gargantext.API.Admin.Settings
Description : Settings of the API (Server and Client)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

TODO-SECURITY: Critical
-}



{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Gargantext.API.Admin.Settings
    where

-- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
import Codec.Serialise (Serialise(), serialise)
import Control.Lens
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Maybe (fromMaybe)
import Data.Pool (Pool, createPool)
import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
import Gargantext.Core.NodeStory
import Gargantext.Prelude.Config (GargConfig(..), {-gc_repofilepath,-} readConfig)
import Network.HTTP.Client.TLS (newTlsManager)
import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey)
import Servant.Client (parseBaseUrl)
import Servant.Job.Async (newJobEnv, defaultSettings)
import System.Directory
-- import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive))
import System.IO (FilePath, hClose)
import System.IO.Temp (withTempFile)
import System.Log.FastLogger
import qualified Data.ByteString.Lazy as L


import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Types
-- import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
import Gargantext.Database.Prelude (databaseParameters)
import Gargantext.Prelude
-- import Gargantext.Prelude.Config (gc_repofilepath)
import qualified Gargantext.Prelude.Mail as Mail

devSettings :: FilePath -> IO Settings
devSettings :: FilePath -> IO Settings
devSettings FilePath
jwkFile = do
  Bool
jwkExists <- FilePath -> IO Bool
doesFileExist FilePath
jwkFile
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
jwkExists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
writeKey FilePath
jwkFile
  JWK
jwk       <- FilePath -> IO JWK
readKey FilePath
jwkFile
  Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Settings -> IO Settings) -> Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$ Settings :: ByteString
-> ByteString
-> PortNumber
-> LogLevel
-> JWTSettings
-> CookieSettings
-> SendEmailType
-> BaseUrl
-> Settings
Settings
    { _allowedOrigin :: ByteString
_allowedOrigin = ByteString
"http://localhost:8008"
    , _allowedHost :: ByteString
_allowedHost = ByteString
"localhost:3000"
    , _appPort :: PortNumber
_appPort = PortNumber
3000
    , _logLevelLimit :: LogLevel
_logLevelLimit = LogLevel
LevelDebug
--    , _dbServer = "localhost"
    , _sendLoginEmails :: SendEmailType
_sendLoginEmails = SendEmailType
LogEmailToConsole
    , _scrapydUrl :: BaseUrl
_scrapydUrl = BaseUrl -> Maybe BaseUrl -> BaseUrl
forall a. a -> Maybe a -> a
fromMaybe (Text -> BaseUrl
forall a. HasCallStack => Text -> a
panic Text
"Invalid scrapy URL") (Maybe BaseUrl -> BaseUrl) -> Maybe BaseUrl -> BaseUrl
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe BaseUrl
forall (m :: * -> *). MonadThrow m => FilePath -> m BaseUrl
parseBaseUrl FilePath
"http://localhost:6800"
    , _cookieSettings :: CookieSettings
_cookieSettings = CookieSettings
defaultCookieSettings { cookieXsrfSetting :: Maybe XsrfCookieSettings
cookieXsrfSetting = XsrfCookieSettings -> Maybe XsrfCookieSettings
forall a. a -> Maybe a
Just XsrfCookieSettings
xsrfCookieSetting } -- TODO-SECURITY tune
    , _jwtSettings :: JWTSettings
_jwtSettings = JWK -> JWTSettings
defaultJWTSettings JWK
jwk -- TODO-SECURITY tune
    }
  where
    xsrfCookieSetting :: XsrfCookieSettings
xsrfCookieSetting = XsrfCookieSettings
defaultXsrfCookieSettings { xsrfExcludeGet :: Bool
xsrfExcludeGet = Bool
True }

{- NOT USED YET
import System.Environment (lookupEnv)

reqSetting :: FromHttpApiData a => Text -> IO a
reqSetting name = do
    e <- fromMaybe (panic $ "Missing " <> name) <$> lookupEnv (unpack name)
    pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e

optSetting :: FromHttpApiData a => Text -> a -> IO a
optSetting name d = do
    me <- lookupEnv (unpack name)
    case me of
        Nothing -> pure d
        Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e

settingsFromEnvironment :: IO Settings
settingsFromEnvironment =
    Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
             <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
             <*> optSetting "PORT" 3000
             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
             <*> reqSetting "DB_SERVER"
             <*> (parseJwk <$> reqSetting "JWT_SECRET")
             <*> optSetting "SEND_EMAIL" SendEmailViaAws
-}

-----------------------------------------------------------------------
-- | RepoDir FilePath configuration
type RepoDirFilePath = FilePath

repoSnapshot :: RepoDirFilePath -> FilePath
repoSnapshot :: FilePath -> FilePath
repoSnapshot FilePath
repoDir = FilePath
repoDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/repo.cbor"



-- This assumes we own the lock on repoSnapshot.
repoSaverAction :: RepoDirFilePath -> Serialise a => a -> IO ()
repoSaverAction :: FilePath -> Serialise a => a -> IO ()
repoSaverAction FilePath
repoDir a
a = do
  FilePath -> FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
repoDir FilePath
"tmp-repo.cbor" ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
fp Handle
h -> do
    FilePath -> FilePath -> IO ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
FilePath -> a -> m ()
printDebug FilePath
"repoSaverAction" FilePath
fp
    Handle -> ByteString -> IO ()
L.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Serialise a => a -> ByteString
serialise a
a
    Handle -> IO ()
hClose Handle
h
    FilePath -> FilePath -> IO ()
renameFile FilePath
fp (FilePath -> FilePath
repoSnapshot FilePath
repoDir)



{-
-- The use of mkDebounce makes sure that repoSaverAction is not called too often.
-- If repoSaverAction start taking more time than the debounceFreq then it should
-- be increased.
mkRepoSaver :: RepoDirFilePath -> MVar NgramsRepo -> IO (IO ())
mkRepoSaver repoDir repo_var = mkDebounce settings'
  where
    settings' = defaultDebounceSettings
                 { debounceFreq   = let n = 6 :: Int in 10^n  -- 1 second
                 , debounceAction = withMVar repo_var (repoSaverAction repoDir)
                   -- Here this not only `readMVar` but `takeMVar`.
                   -- Namely while repoSaverAction is saving no other change
                   -- can be made to the MVar.
                   -- This might be not efficent and thus reconsidered later.
                   -- However this enables to safely perform a *final* save.
                   -- See `cleanEnv`.
                   -- Future work:
                   -- Add a new MVar just for saving.
                 }

-}
{-
readRepoEnv :: FilePath -> IO RepoEnv
readRepoEnv repoDir = do
  -- Does file exist ? :: Bool
  _repoDir <- createDirectoryIfMissing True repoDir

  repoFile <- doesFileExist (repoSnapshot repoDir)

  -- Is file not empty ? :: Bool
  repoExists <- if repoFile
             then (>0) <$> getFileSize (repoSnapshot repoDir)
             else pure False

  mlock <- tryLockFile (repoSnapshot repoDir) Exclusive
  lock <- maybe (panic "Repo file already locked") pure mlock

  mvar <- newMVar =<<
    if repoExists
      then do
        -- e_repo <- eitherDecodeStrict <$> deserialise <$> L.readFile repoSnapshot
        repo <- deserialise <$> L.readFile (repoSnapshot repoDir)
        -- repo   <- either fail pure e_repo
        let archive = (repoSnapshot repoDir) <> ".v" <> show (repo ^. r_version)
        copyFile (repoSnapshot repoDir) archive
        pure repo
      else
        pure initRepo
  -- TODO save in DB here
  saver <- mkRepoSaver repoDir mvar
  pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
--}

devJwkFile :: FilePath
devJwkFile :: FilePath
devJwkFile = FilePath
"dev.jwk"

newEnv :: PortNumber -> FilePath -> IO Env
newEnv :: PortNumber -> FilePath -> IO Env
newEnv PortNumber
port FilePath
file = do
  Manager
manager_env  <- IO Manager
forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
  Settings
settings'    <- FilePath -> IO Settings
devSettings FilePath
devJwkFile IO Settings -> (Settings -> Settings) -> IO Settings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (PortNumber -> Identity PortNumber)
-> Settings -> Identity Settings
Lens' Settings PortNumber
appPort ((PortNumber -> Identity PortNumber)
 -> Settings -> Identity Settings)
-> PortNumber -> Settings -> Settings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PortNumber
port -- TODO read from 'file'
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PortNumber
port PortNumber -> PortNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= Settings
settings' Settings -> Getting PortNumber Settings PortNumber -> PortNumber
forall s a. s -> Getting a s a -> a
^. Getting PortNumber Settings PortNumber
Lens' Settings PortNumber
appPort) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text -> IO ()
forall a. HasCallStack => Text -> a
panic Text
"TODO: conflicting settings of port"

  GargConfig
config_env    <- FilePath -> IO GargConfig
readConfig FilePath
file
  BaseUrl
self_url_env  <- FilePath -> IO BaseUrl
forall (m :: * -> *). MonadThrow m => FilePath -> m BaseUrl
parseBaseUrl (FilePath -> IO BaseUrl) -> FilePath -> IO BaseUrl
forall a b. (a -> b) -> a -> b
$ FilePath
"http://0.0.0.0:" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PortNumber -> FilePath
forall a. Show a => a -> FilePath
show PortNumber
port
  ConnectInfo
dbParam       <- FilePath -> IO ConnectInfo
databaseParameters FilePath
file
  Pool Connection
pool          <- ConnectInfo -> IO (Pool Connection)
newPool ConnectInfo
dbParam
  NodeStoryEnv
nodeStory_env <- FilePath -> IO NodeStoryEnv
readNodeStoryEnv (GargConfig -> FilePath
_gc_repofilepath GargConfig
config_env)
  JobEnv JobLog JobLog
scrapers_env  <- EnvSettings -> Manager -> IO (JobEnv JobLog JobLog)
forall event output.
EnvSettings -> Manager -> IO (JobEnv event output)
newJobEnv EnvSettings
defaultSettings Manager
manager_env
  LoggerSet
logger        <- PortNumber -> IO LoggerSet
newStderrLoggerSet PortNumber
defaultBufSize
  MailConfig
config_mail   <- FilePath -> IO MailConfig
Mail.readConfig FilePath
file

  Env -> IO Env
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ Env :: Settings
-> LoggerSet
-> Pool Connection
-> NodeStoryEnv
-> Manager
-> BaseUrl
-> JobEnv JobLog JobLog
-> GargConfig
-> MailConfig
-> Env
Env
    { _env_settings :: Settings
_env_settings  = Settings
settings'
    , _env_logger :: LoggerSet
_env_logger    = LoggerSet
logger
    , _env_pool :: Pool Connection
_env_pool      = Pool Connection
pool
    , _env_nodeStory :: NodeStoryEnv
_env_nodeStory = NodeStoryEnv
nodeStory_env
    , _env_manager :: Manager
_env_manager   = Manager
manager_env
    , _env_scrapers :: JobEnv JobLog JobLog
_env_scrapers  = JobEnv JobLog JobLog
scrapers_env
    , _env_self_url :: BaseUrl
_env_self_url  = BaseUrl
self_url_env
    , _env_config :: GargConfig
_env_config    = GargConfig
config_env
    , _env_mail :: MailConfig
_env_mail      = MailConfig
config_mail
    }

newPool :: ConnectInfo -> IO (Pool Connection)
newPool :: ConnectInfo -> IO (Pool Connection)
newPool ConnectInfo
param = IO Connection
-> (Connection -> IO ())
-> PortNumber
-> NominalDiffTime
-> PortNumber
-> IO (Pool Connection)
forall a.
IO a
-> (a -> IO ())
-> PortNumber
-> NominalDiffTime
-> PortNumber
-> IO (Pool a)
createPool (ConnectInfo -> IO Connection
connect ConnectInfo
param) Connection -> IO ()
close PortNumber
1 (NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
60) PortNumber
8

{-
cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
cleanEnv env = do
  r <- takeMVar (env ^. repoEnv . renv_var)
  repoSaverAction (env ^. hasConfig . gc_repofilepath) r
  unlockFile (env ^. repoEnv . renv_lock)
--}