{-|
Module      : Gargantext.API
Description : REST API declaration
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Main (RESTful) API of the instance Gargantext.

The Garg-API is typed to derive the documentation, the mock and tests.

This API is indeed typed in order to be able to derive both the server
and the client sides.

The Garg-API-Monad enables:
  - Security (WIP)
  - Features (WIP)
  - Database connection (long term)
  - In Memory stack management (short term)
  - Logs (WIP)

Thanks to Yann Esposito for our discussions at the start and to Nicolas
Pouillard (who mainly made it).

-}

{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeApplications #-}

module Gargantext.API
      where

import Control.Concurrent.Async qualified as Async
import Control.Exception.Safe qualified as Safe
import Data.Cache qualified as InMemory
import Data.List (lookup)
import Data.Set qualified as Set
import Data.Text (pack)
import Data.Text.Encoding qualified as TE
import Data.Text.IO (putStrLn)
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.EnvTypes (Env, FireWall(..), Mode(..), env_config, env_jwt_settings)
import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Middleware (logStdoutDevSanitised)
import Gargantext.API.Routes.Named (API)
import Gargantext.API.Routes.Named.EKG (EkgAPI)
import Gargantext.API.Server.Named (server)
import Gargantext.Core.Config
import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_cors, fc_cookie_settings, fc_internal_url, microServicesProxyStatus)
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.Notifications (withNotifications)
import Gargantext.Core.Utils (getGitHash)
import Gargantext.Database.Prelude qualified as DB
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.Prelude hiding (putStrLn, to)
import Gargantext.System.Logging (withLoggerIO, renderLogLevel)
import Network.HTTP.Types hiding (Query)
import Network.Wai (Middleware, Request, requestHeaders)
import Network.Wai.Handler.Warp hiding (defaultSettings)
import Network.Wai.Middleware.Cors
import Network.Wai.Middleware.RequestLogger (logStdout)
import Servant hiding (Header)
import Servant.Client.Core.BaseUrl (showBaseUrl, baseUrlPort)
import System.Clock qualified as Clock
import System.Cron.Schedule qualified as Cron
import Gargantext.API.Errors.Types (BackendInternalError (..))

-- | startGargantext takes as parameters port number and Toml file.
startGargantext :: Mode -> SettingsFile -> IO ()
startGargantext mode sf@(SettingsFile settingsFile) = do
  config <- readConfig sf
  withLoggerIO (config ^. gc_logging) $ \logger -> do
    withNotifications config $ \dispatcher -> do
      env <- newEnv logger config dispatcher
      let fc = env ^. env_config . gc_frontend_config
      let proxyStatus = microServicesProxyStatus fc
      let port = baseUrlPort (fc ^. fc_internal_url)
      runDbCheck env
      startupInfo config port proxyStatus
      app <- makeApp env
      mid <- makeGargMiddleware (fc ^. fc_cors) mode
      periodicActions <- schedulePeriodicActions env

      let runServer = run port (mid app) `finally` stopGargantext periodicActions
      case proxyStatus of
        PXY_disabled
          -> runServer -- the proxy is disabled, do not spawn the application
        PXY_enabled proxyPort
          -> do
            proxyCache <- InMemory.newCache (Just oneHour)
            let runProxy  = run proxyPort (mid (microServicesProxyApp proxyCache env))
            Async.race_ runServer runProxy

  where
    runDbCheck :: Env -> IO ()
    runDbCheck env = do
      r <- (runExceptT @BackendInternalError (runReaderT DB.dbCheck env)) `Safe.catch`
        (\(err :: SomeException) -> pure $ Left $ InternalUnexpectedError err)
      case r of
        Right True  -> pure ()
        Right False -> panicTrace $
          "You must run 'gargantext init -c " <> pack settingsFile <>
          "' before running gargantext-server (only the first time)."
        Left err -> panicTrace $ "Unexpected exception:" <> show err
    oneHour = Clock.fromNanoSecs 3600_000_000_000

startupInfo :: GargConfig -> PortNumber -> MicroServicesProxyStatus -> IO ()
startupInfo config mainPort proxyStatus = do
  putStrLn   "=========================================================================================================="
  putStrLn   " GarganText Server"
  putStrLn   "=========================================================================================================="
  putStrLn $ " - Log Level ...............................: " <> renderLogLevel ll
  putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html"
  putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui"
  putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql"
  -- putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece proxyStatus
  putStrLn renderProxyStatus
  putStrLn $ " - Central exchange.........................: " <> "nanomsg: " <> _nc_central_exchange_bind nc
  putStrLn $ " - Dispatcher internal......................: " <> "nanomsg: " <> _nc_dispatcher_bind nc
  putStrLn $ " - WebSocket address........................: " <> "ws://localhost:" <> toUrlPiece mainPort <> "/ws"
  putStrLn   "=========================================================================================================="
  where
    nc = config ^. gc_notifications_config
    ll = config ^. gc_logging . lc_log_level
    renderProxyStatus = case proxyStatus of
      PXY_disabled ->
        " - Microservices proxy .....................: DISABLED (enable in gargantext-settings.toml)"
      PXY_enabled proxyPort ->
        " - Microservices proxy .....................: http://localhost:" <> toUrlPiece proxyPort

-- | Stops the gargantext server and cancels all the periodic actions
-- scheduled to run up to that point.
-- TODO clean this Monad condition (more generic) ?
stopGargantext :: [ThreadId] -> IO ()
stopGargantext scheduledPeriodicActions = do
  forM_ scheduledPeriodicActions killThread
  putStrLn "----- Stopping gargantext -----"

-- | Schedules all sorts of useful periodic actions to be run while
-- the server is alive accepting requests.
schedulePeriodicActions :: env -> IO [ThreadId]
schedulePeriodicActions _env =
  -- Add your scheduled actions here.
  let actions = [
          -- refreshDBViews
        ]
  in foldlM (\ !acc action -> (`mappend` acc) <$> Cron.execSchedule action) [] actions

{-
  where

    refreshDBViews :: Cron.Schedule ()
    refreshDBViews = do
      let doRefresh = do
            res <- DB.runCmd env (refreshNgramsMaterialized :: Cmd IOException ())
            case res of
              Left e   -> liftIO $ putStrLn $ pack ("Refreshing Ngrams materialized view failed: " <> displayException e)
              Right () ->  do
                _ <- liftIO $ putStrLn $ pack "Refresh Index Database done"
                pure ()
      Cron.addJob doRefresh "* 2 * * *"
-}

----------------------------------------------------------------------

fireWall :: Applicative f => Request -> FireWall -> f Bool
fireWall req fw = do
    let origin = lookup "Origin" (requestHeaders req)
    let host   = lookup "Host"   (requestHeaders req)

    if  origin == Just (encodeUtf8 "http://localhost:8008")
       && host == Just (encodeUtf8 "localhost:3000")
       || (not $ unFireWall fw)

       then pure True
       else pure False

makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware
makeGargMiddleware crsSettings mode = do
    let corsMiddleware = cors $ \_incomingRq -> Just
          simpleCorsResourcePolicy
            { corsOrigins = Just $ (Set.toList $ Set.fromList $ map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
            , corsMethods = [ methodGet   , methodPost   , methodPut
                            , methodDelete, methodOptions, methodHead]
            , corsIgnoreFailures = False
            , corsRequestHeaders = ["authorization", "content-type", "x-garg-error-scheme"]
            , corsMaxAge         = Just ( 60*60*24 ) -- one day
            }
    case mode of
      Prod -> pure $ logStdout . corsMiddleware
      _    -> do
        loggerMiddleware <- logStdoutDevSanitised
        pure $ loggerMiddleware . corsMiddleware
  where
    mkCorsOrigin :: CORSOrigin -> Origin
    mkCorsOrigin (CORSOrigin u) = TE.encodeUtf8 . pack . showBaseUrl $ u

---------------------------------------------------------------------
-- | API Global
---------------------------------------------------------------------

makeApp :: Env -> IO Application
makeApp env = do
  gitHash <- getGitHash
  pure $ serveWithContext api cfg (server gitHash env)
  -- (ekgStore, ekgMid) <- newEkgStore api
  -- ekgDir <- (</> "ekg-assets") <$> getDataDir
  -- pure $ ekgMid $ serveWithContext apiWithEkg cfg
    -- (WithEkg { ekgAPI     = ekgServer ekgDir ekgStore
    --          , wrappedAPI = server env
    --          })
  where
    cfg :: Servant.Context AuthContext
    cfg = env ^. env_jwt_settings
       :. env ^. env_config . gc_frontend_config . fc_cookie_settings
       :. EmptyContext

---------------------------------------------------------------------
api :: Proxy (NamedRoutes API)
api  = Proxy


data WithEkg api mode = WithEkg
  { ekgAPI     :: mode :- NamedRoutes EkgAPI
  , wrappedAPI :: mode :- NamedRoutes api
  } deriving Generic


apiWithEkg :: Proxy (NamedRoutes (WithEkg API))
apiWithEkg = Proxy
