{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.API.Private (
    tests
  ) where

import Gargantext.API.Errors
import Gargantext.API.Routes.Named.Node
import Gargantext.API.Routes.Named.Private
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
import Gargantext.Prelude hiding (get)
import Network.HTTP.Client hiding (Proxy)
import Servant.Auth.Client ()
import Servant.Client.Streaming
import Servant.Client.Generic (genericClient)
import Test.API.Prelude
import Test.API.Private.Move  qualified as Move
import Test.API.Private.Remote  qualified as Remote
import Test.API.Private.Share qualified as Share
import Test.API.Private.Table qualified as Table
import Test.API.Private.List qualified as List
import Test.API.Routes (mkUrl, get_node, get_tree)
import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON (json)
import Test.Utils (protected, shouldRespondWithFragment, withValidLogin)


nodeTests :: Spec
nodeTests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
  describe "Prelude" $ do
    baseUrl <- runIO $ parseBaseUrl "http://localhost"
    manager <- runIO $ newManager defaultManagerSettings
    let unauthenticatedClientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })

    describe "GET /api/v1.0/user" $ do

      -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
      it "doesn't allow someone with an invalid token to show the results" $ \ctx -> do

        let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
            admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])

        result <- runClientM admin_user_api_get (unauthenticatedClientEnv $ _sctx_port ctx)
        length result `shouldBe` 0

      -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
      it "allows 'alice' to see the results" $ \ctx -> do

        withValidLogin (_sctx_port ctx) "alice" (GargPassword "alice") $ \clientEnv _token -> do
          let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
              admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])

          _nodes <- runClientM admin_user_api_get clientEnv
          pendingWith "currently useless"

    describe "GET /api/v1.0/node" $ do

      it "unauthorised users shouldn't see anything" $ \ctx -> do
        withApplication (_sctx_app ctx) $ do
          get (mkUrl (_sctx_port ctx) "/node/1") `shouldRespondWith` 401

      it "allows 'alice' to see her own node info" $ \ctx -> do
        let port = _sctx_port ctx
        withApplication (_sctx_app ctx) $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
            protected token "GET" (mkUrl port "/node/8") ""
              `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]

      it "forbids 'alice' to see others node private info" $ \ctx -> do
        let port = _sctx_port ctx
        withApplication (_sctx_app ctx) $ do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              res <- runClientM (get_node token (UnsafeMkNodeId 1)) clientEnv
              res `shouldFailWith` EC_403__policy_check_error

    describe "GET /api/v1.0/tree" $ do
      it "unauthorised users shouldn't see anything" $ \ctx -> do
        withApplication (_sctx_app ctx) $ do
          get (mkUrl (_sctx_port ctx) "/tree/1") `shouldRespondWith` 401

      it "allows 'alice' to see her own node info" $ \ctx -> do
        let port = _sctx_port ctx
        withApplication (_sctx_app ctx) $ do
          withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
            protected token "GET" (mkUrl port "/tree/8") ""
              `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]

      it "forbids 'alice' to see others node private info" $ \ctx -> do
        let port = _sctx_port ctx
        withApplication (_sctx_app ctx) $ do
          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              res <- runClientM (get_tree token (UnsafeMkNodeId 1)) clientEnv
              res `shouldFailWith` EC_403__policy_check_error


tests :: Spec
tests = sequential $ do
  describe "Private API" $ do
    nodeTests
  describe "Share API" $ do
    Share.tests
  describe "Table API" $ do
    Table.tests
  describe "Move API" $ do
    Move.tests
  describe "Remote API" $ do
    Remote.tests
  describe "List API" $ do
    List.tests