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

module Test.API.Private.Remote (
    tests
  ) where

import Control.Lens
import Gargantext.API.Errors
import Gargantext.API (makeApp)
import Gargantext.API.Routes.Client (remoteExportClient)
import Gargantext.API.Routes.Named.Remote (RemoteExportRequest(..))
import Gargantext.Core.Config
import Gargantext.Core.Types.Individu
import Gargantext.Core.Types (NodeId(UnsafeMkNodeId))
import Gargantext.Prelude
import Gargantext.System.Logging
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai qualified as Wai
import Servant.Client.Streaming
import Test.API.Prelude
import Test.API.Setup
import Test.Database.Setup
import Test.Database.Types
import Test.Hspec (Spec, it, aroundAll, describe, sequential, shouldBe)
import Test.Hspec.Wai.Internal (withApplication)
import Test.Utils

-- | Helper to let us test transferring data between two instances.
withTwoServerInstances :: (SpecContext (TestEnv,Wai.Application,Warp.Port) -> IO ()) -> IO ()
withTwoServerInstances action =
  withTestDB $ \testEnv1 -> do
    withTestDB $ \testEnv2 -> do
      garg1App <- withLoggerIO (log_cfg testEnv1) $ \ioLogger -> do
                   env <- newTestEnv testEnv1 ioLogger server1Port
                   makeApp env
      garg2App <- withLoggerIO (log_cfg testEnv2) $ \ioLogger -> do
                   env <- newTestEnv testEnv2 ioLogger server2Port
                   makeApp env

      testWithApplicationOnPort (pure garg1App) server1Port $
        testWithApplicationOnPort (pure garg2App) server2Port $
          action (SpecContext testEnv1 server1Port garg1App (testEnv2,garg2App,server2Port))
  where
    server1Port = 8008
    server2Port = 9008
    log_cfg te  = test_config te ^. gc_logging

tests :: Spec
tests = sequential $ aroundAll withTwoServerInstances $ do
  describe "Prelude" $ do
    it "setup DB triggers" $ \SpecContext{..} -> do
      forM_ [ _sctx_env, _sctx_data ^. _1 ] $ \e -> do
        setupEnvironment e
        void $ createAliceAndBob e

    describe "Copying nodes across instances" $ do

      it "should forbid moving a node the user doesn't own" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
        withApplication app1 $ do
          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
              liftIO $ do
                bobPublicFolderId <- getRootPublicFolderIdForUser testEnv1 (UserName "bob")
                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                             , _rer_instance_auth = bobToken
                                             }
                res <- runClientM (remoteExportClient aliceToken bobPublicFolderId rq) aliceClientEnv
                res `shouldFailWith` EC_403__policy_check_error

      it "supports trivial transfer between instances" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
        withApplication app1 $ do
          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
            corpusId <- liftIO $ newCorpusForUser testEnv1 "alice"
            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
              liftIO $ do
                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                             , _rer_instance_auth = bobToken
                                             }
                res <- checkEither $ runClientM (remoteExportClient aliceToken corpusId rq) aliceClientEnv
                res `shouldBe` [ UnsafeMkNodeId 16 ]

      -- Certain node types (like private, share, etc) shouldn't be transferred.
      it "forbids transferring certain node types" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
        withApplication app1 $ do
          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
            folderId <- liftIO $ newPrivateFolderForUser testEnv1 alice
            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
              liftIO $ do
                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                             , _rer_instance_auth = bobToken
                                             }
                res <- runClientM (remoteExportClient aliceToken folderId rq) aliceClientEnv
                res `shouldFailWith` EC_403__node_export_error