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

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

import Gargantext.API.Errors
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
import Gargantext.Prelude
import Servant.Client
import Test.API.Prelude
import Test.API.Routes
import Test.API.Setup
import Test.Hspec (Spec, it, aroundAll, describe, sequential)
import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Expectations.Lifted
import Test.Tasty.HUnit (assertBool)
import Test.Utils

tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do
  describe "Prelude" $ do
    it "setup DB triggers" $ \SpecContext{..} -> do
      setupEnvironment _sctx_env
      -- Let's create the Alice user.
      void $ createAliceAndBob _sctx_env

    describe "Publishing a Corpus" $ do

      it "should forbid moving a corpus node into another user Public folder" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              bobPublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "bob")
              res <- runClientM (move_node token (SourceId cId) (TargetId bobPublicFolderId)) clientEnv
              res `shouldFailWith` EC_403__policy_check_error

      it "should allow moving a corpus node into Alice Public folder" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            nodes <- liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
              checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
            liftIO $ length nodes `shouldBe` 1

      it "should allow Alice to unpublish a corpus" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            nodes <- liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")
              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice")
              _     <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv
              checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePrivateFolderId)) clientEnv
            length nodes `shouldBe` 1

      it "should allow Bob to see Alice's published corpuses" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
              _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv

              -- Check that we can see the folder
              aliceNodeId <- myUserNodeId testEnv "alice"
              tree <- checkEither $ runClientM (get_tree token aliceNodeId) clientEnv
              assertBool "alice can't see her own corpus" (containsNode cId tree)
              pure cId

          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
            tree <- liftIO $ do
              bobNodeId <- myUserNodeId testEnv "bob"
              checkEither $ runClientM (get_tree token bobNodeId) clientEnv
            containsNode aliceCorpusId tree `shouldBe` True

      it "should unpublish Alice's published corpus when moved back to private" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId <- getRootPublicFolderIdForUser testEnv (UserName "alice")
              _ <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv

              -- Check that we can see the folder
              aliceNodeId <- myUserNodeId testEnv "alice"
              tree <- checkEither $ runClientM (get_tree token aliceNodeId) clientEnv
              assertBool "alice can't see her own corpus" (containsNode cId tree)
              pure cId

          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
            tree <- liftIO $ do
              bobNodeId <- myUserNodeId testEnv "bob"
              checkEither $ runClientM (get_tree token bobNodeId) clientEnv
            containsNode aliceCorpusId tree `shouldBe` True

          -- Now alice moves the node back to her private folder, effectively unpublishing it.
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              alicePrivateFolderId <- getRootPrivateFolderIdForUser testEnv (UserName "alice")
              void $ checkEither $ runClientM (move_node token (SourceId aliceCorpusId) (TargetId alicePrivateFolderId)) clientEnv

          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
            tree <- liftIO $ do
              bobNodeId <- myUserNodeId testEnv "bob"
              checkEither $ runClientM (get_tree token bobNodeId) clientEnv
            containsNode aliceCorpusId tree `shouldBe` False


      it "shouldn't allow Alice to modify a (strictly) published node even if owner" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              cId <- newCorpusForUser testEnv "alice"
              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")
              _     <- checkEither $ runClientM (move_node token (SourceId cId) (TargetId alicePublicFolderId)) clientEnv

              -- Trying to delete a strictly published node should fail
              res <- runClientM (delete_node token cId) clientEnv
              res `shouldFailWith` EC_403__policy_check_error

      it "shouldn't allow publishing things which are not a node corpus" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do
              fId   <- newFolderForUser testEnv "alice" "my-test-folder"
              fId'' <- newPrivateFolderForUser testEnv "alice"
              alicePublicFolderId  <- getRootPublicFolderIdForUser testEnv (UserName "alice")

              res <- runClientM (move_node token (SourceId fId) (TargetId alicePublicFolderId)) clientEnv
              res `shouldFailWith` EC_403__node_move_error

              res' <- runClientM (move_node token (SourceId fId'') (TargetId alicePublicFolderId)) clientEnv
              res' `shouldFailWith` EC_403__node_move_error

      it "allows publishing via the /publish endpoint" $ \(SpecContext testEnv serverPort app _) -> do
        withApplication app $ do
          aliceCorpusId <- withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
            liftIO $ do

              cId <- newCorpusForUser testEnv "alice"
              void $ runClientM (publish_node token cId NPP_publish_no_edits_allowed) clientEnv
              pure cId
          -- bob should be able to see it
          withValidLogin serverPort "bob" (GargPassword "bob") $ \clientEnv token -> do
            tree <- liftIO $ do
              bobNodeId <- myUserNodeId testEnv "bob"
              checkEither $ runClientM (get_tree token bobNodeId) clientEnv
            containsNode aliceCorpusId tree `shouldBe` True

containsNode :: NodeId -> Tree NodeTree -> Bool
containsNode target (TreeN r c) = _nt_id r == target || any (containsNode target) c