{-# LANGUAGE BangPatterns #-}

module Test.API.Setup where

import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar
import Control.Exception
import Control.Lens
import Control.Monad.Reader
import Data.ByteString.Lazy.Char8 qualified as C8L
import Data.Cache qualified as InMemory
import Data.Streaming.Network (bindPortTCP)
import Gargantext.API (makeApp)
import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
import Gargantext.Core.Config
import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.Core.NLP
import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow
import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs
import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager)
import Network.HTTP.Types
import Network.Wai (Application, responseLBS)
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp (runSettingsSocket)
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.Warp.Internal
import Prelude
import Servant.Auth.Client ()
import Servant.Client
import Servant.Job.Async qualified as ServantAsync
import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo, fakeSettingsPath)
import Test.Database.Types
import UnliftIO qualified


newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
newTestEnv testEnv logger port = do
  file          <- fakeIniPath
  settingsP     <- SettingsFile <$> fakeSettingsPath
  !manager_env  <- newTlsManager
  !settings'    <- devSettings devJwkFile settingsP <&> appPort .~ port

  !config_env    <- readConfig file
  prios          <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs")
  let prios' = Jobs.applyPrios prios Jobs.defaultPrios
  !self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
  dbParam        <- pure $ testEnvToPgConnectionInfo testEnv
  !pool          <- newPool dbParam

  !nodeStory_env <- fromDBNodeStoryEnv pool
  !scrapers_env  <- ServantAsync.newJobEnv ServantAsync.defaultSettings manager_env

  secret        <- Jobs.genSecret
  let jobs_settings = (Jobs.defaultJobSettings 1 secret)
                        & Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_job_timeout)
                        & Jobs.l_jsIDTimeout  .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_id_timeout)
  !jobs_env     <- Jobs.newJobEnv jobs_settings prios' manager_env
  !config_mail  <- Mail.readConfig file
  !nlp_env      <- nlpServerMap <$> NLP.readConfig file

  -- !central_exchange <- forkIO CE.gServer
  -- !dispatcher <- D.dispatcher

  pure $ Env
    { _env_settings  = settings'
    , _env_logger    = logger
    , _env_pool      = pool
    , _env_nodeStory = nodeStory_env
    , _env_manager   = manager_env
    , _env_scrapers  = scrapers_env
    , _env_jobs      = jobs_env
    , _env_self_url  = self_url_env
    , _env_config    = config_env
    , _env_mail      = config_mail
    , _env_nlp       = nlp_env
    , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
    , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
    -- , _env_central_exchange = central_exchange
    -- , _env_dispatcher = dispatcher
    }

-- | Run the gargantext server on a random port, picked by Warp, which allows
-- for concurrent tests to be executed in parallel, if we need to.
withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
withTestDBAndPort action =
  withTestDB $ \testEnv -> do
    -- TODO Despite being cautious here only to start/kill dispatcher
    -- & exchange, I still get nanomsg bind errors, which means these
    -- are spawned before previous ones are killed. I guess one could
    -- randomize ports for nanomsg...
    
    -- let setup = do
    --       withLoggerHoisted Mock $ \ioLogger -> do
    --         env <- newTestEnv testEnv ioLogger 8080
    --         !central_exchange <- forkIO CE.gServer
    --         !dispatcher <- D.dispatcher
    --         let env' = env { _env_central_exchange = central_exchange
    --                        , _env_dispatcher = dispatcher }
    --         app <- makeApp env'
    --         pure (app, env')
    -- let teardown (_app, env) = do
    --       killThread (DT.d_ce_listener $ _env_dispatcher env)
    --       killThread (_env_central_exchange env)

    -- bracket setup teardown $ \(app, _env) -> do
    --   withGargApp app $ \port ->
    --     action ((testEnv, port), app)
    
    app <- withLoggerHoisted Mock $ \ioLogger -> do
             env <- newTestEnv testEnv ioLogger 8080
             makeApp env
    let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
    Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app)

-- | Starts the backend server /and/ the microservices proxy, the former at
-- a random port, the latter at a predictable port.
withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()
withBackendServerAndProxy action =
  withTestDB $ \testEnv -> do
    gargApp <- withLoggerHoisted Mock $ \ioLogger -> do
                 env <- newTestEnv testEnv ioLogger 8080
                 makeApp env
    proxyCache <- InMemory.newCache Nothing
    proxyApp <- withLoggerHoisted Mock $ \ioLogger -> do
                  env <- newTestEnv testEnv ioLogger 8080
                  pure $ microServicesProxyApp proxyCache env

    Warp.testWithApplication (pure gargApp) $ \serverPort ->
      testWithApplicationOnPort (pure proxyApp) proxyPort $
        action (testEnv, serverPort, proxyPort)
  where
    proxyPort = 8090

setupEnvironment :: TestEnv -> IO ()
setupEnvironment env = flip runReaderT env $ runTestMonad $ do
  void $ initFirstTriggers "secret_key"
  void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key")
  (masterUserId, _masterRootId, masterCorpusId)
              <- getOrMkRootWithCorpus MkCorpusUserMaster (Nothing :: Maybe HyperdataCorpus)
  masterListId <- getOrMkList masterCorpusId masterUserId
  -- printDebug "[setupEnvironment] masterListId: " masterListId
  void $ initLastTriggers masterListId

-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
-- Bob's private data and vice-versa.
createAliceAndBob :: TestEnv -> IO ()
createAliceAndBob testEnv = do
  void $ flip runReaderT testEnv $ runTestMonad $ do
    let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice")
    let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob")

    void $ new_user nur1
    void $ new_user nur2

-- show the full exceptions during testing, rather than shallowing them under a generic
-- "Something went wrong".
showDebugExceptions :: SomeException -> Wai.Response
showDebugExceptions e =
   responseLBS status500 [(hContentType, "text/plain; charset=utf-8")] (C8L.pack $ show e)

-- | A version of 'withApplication' that allows supplying a user-specified port
-- so that we are sure that our garg apps will run on the same port as specified
-- in the 'Env' settings.
testWithApplicationOnPort :: IO Application -> Warp.Port -> IO a -> IO a
testWithApplicationOnPort mkApp userPort action = do
    app <- mkApp
    started <- mkWaiter
    let appSettings =
            Warp.defaultSettings
                { settingsBeforeMainLoop =
                    notify started () >> settingsBeforeMainLoop Warp.defaultSettings
                , settingsPort = userPort
                , settingsOnExceptionResponse = showDebugExceptions
                }
    sock <- bindPortTCP userPort "127.0.0.1"
    result <-
        Async.race
            (runSettingsSocket appSettings sock app)
            (waitFor started >> action)
    case result of
        Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited"
        Right x -> return x

data Waiter a = Waiter
    { notify :: a -> IO ()
    , waitFor :: IO a
    }

mkWaiter :: IO (Waiter a)
mkWaiter = do
    mvar <- newEmptyMVar
    return
        Waiter
            { notify = putMVar mvar
            , waitFor = readMVar mvar
            }
