{-| 
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 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"
    , _sendLoginEmails = LogEmailToConsole
    , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
    , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
    , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
    }
  where
    xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = 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 repoDir = repoDir <> "/repo.cbor"



-- This assumes we own the lock on repoSnapshot.
repoSaverAction :: RepoDirFilePath -> Serialise a => a -> IO ()
repoSaverAction repoDir a = do
  withTempFile repoDir "tmp-repo.cbor" $ \fp h -> do
    -- printDebug "repoSaverAction" fp
    L.hPut h $ serialise a
    hClose h
    renameFile fp (repoSnapshot 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 = "dev.jwk"

newEnv :: PortNumber -> FilePath -> IO Env
newEnv port file = do
  manager_env  <- newTlsManager
  settings'    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
  when (port /= settings' ^. appPort) $
    panic "TODO: conflicting settings of port"

  config_env    <- readConfig file
  self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
  dbParam       <- databaseParameters file
  pool          <- newPool dbParam
  nodeStory_env <- readNodeStoryEnv (_gc_repofilepath config_env)
  scrapers_env  <- newJobEnv defaultSettings manager_env
  logger        <- newStderrLoggerSet defaultBufSize
  config_mail   <- Mail.readConfig file

  pure $ Env
    { _env_settings  = settings'
    , _env_logger    = logger
    , _env_pool      = pool
    , _env_nodeStory = nodeStory_env
    , _env_manager   = manager_env
    , _env_scrapers  = scrapers_env
    , _env_self_url  = self_url_env
    , _env_config    = config_env
    , _env_mail      = config_mail
    }

newPool :: ConnectInfo -> IO (Pool Connection)
newPool param = createPool (connect param) close 1 (60*60) 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)
--}