-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module API.TeamUserSearch (tests) where

import API.Search (testWithBothIndices)
import API.Search.Util (executeTeamUserSearch, executeTeamUserSearchWithMaybeState, refreshIndex)
import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles)
import API.User.Util (initiateEmailUpdateAutoActivate)
import Bilge (Manager, MonadHttp)
import Brig.Options qualified as Opt
import Control.Monad.Catch (MonadCatch)
import Control.Retry ()
import Data.ByteString.Conversion (toByteString)
import Data.Handle (fromHandle)
import Data.Id (TeamId, UserId)
import Data.Range (unsafeRange)
import Data.String.Conversions
import Imports
import System.Random.Shuffle (shuffleM)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertEqual, (@?=))
import Util (Brig, Galley, randomEmail)
import Wire.API.User (User (..), userEmail, userId)
import Wire.API.User.Identity hiding (toByteString)
import Wire.API.User.Search

type TestConstraints m = (MonadFail m, MonadCatch m, MonadIO m, MonadHttp m)

tests :: Opt.Opts -> Manager -> Galley -> Brig -> IO TestTree
tests opts mgr _galley brig = do
  pure $
    testGroup "teams user search" $
      [ testWithBothIndices opts mgr "can find user by email" (testSearchByEmailSameTeam brig),
        testWithBothIndices opts mgr "empty query returns the whole team sorted" (testEmptyQuerySorted brig),
        testWithBothIndices opts mgr "sorting by some properties works" (testSort brig),
        testWithBothIndices opts mgr "call to search with remaining properties succeeds" (testSortCallSucceeds brig),
        testWithBothIndices opts mgr "query with paging state" (testEmptyQuerySortedWithPagination brig)
      ]

testSearchByEmail :: (HasCallStack, TestConstraints m) => Brig -> m (TeamId, UserId, User) -> Bool -> m ()
testSearchByEmail brig mkSearcherAndSearchee canFind = do
  (tid, searcher, searchee) <- mkSearcherAndSearchee
  eml <- randomEmail
  _ <- initiateEmailUpdateAutoActivate brig eml (userId searchee)
  refreshIndex brig
  let check = if canFind then assertTeamUserSearchCanFind else assertTeamUserSearchCannotFind
  check brig tid searcher (userId searchee) (fromEmail eml)

testSearchByEmailSameTeam :: (HasCallStack, TestConstraints m) => Brig -> m ()
testSearchByEmailSameTeam brig = do
  let mkSearcherAndSearchee = do
        (tid, userId -> ownerId, [u1]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1
        pure (tid, ownerId, u1)
  testSearchByEmail brig mkSearcherAndSearchee True

assertTeamUserSearchCanFind :: (TestConstraints m) => Brig -> TeamId -> UserId -> UserId -> Text -> m ()
assertTeamUserSearchCanFind brig teamid self expected q = do
  r <- searchResults <$> executeTeamUserSearch brig teamid self (Just q) Nothing Nothing Nothing
  liftIO $ do
    assertBool ("No results for query: " <> show q) $
      not (null r)
    assertBool ("User not in results for query: " <> show q) $
      expected `elem` map teamContactUserId r

assertTeamUserSearchCannotFind :: (TestConstraints m) => Brig -> TeamId -> UserId -> UserId -> Text -> m ()
assertTeamUserSearchCannotFind brig teamid self expected q = do
  r <- searchResults <$> executeTeamUserSearch brig teamid self (Just q) Nothing Nothing Nothing
  liftIO $ do
    assertBool ("User shouldn't be present in results for query: " <> show q) $
      expected `notElem` map teamContactUserId r

testEmptyQuerySorted :: (TestConstraints m) => Brig -> m ()
testEmptyQuerySorted brig = do
  (tid, userId -> ownerId, users) <- createPopulatedBindingTeamWithNamesAndHandles brig 4
  refreshIndex brig
  r <- searchResults <$> executeTeamUserSearch brig tid ownerId (Just "") Nothing Nothing Nothing
  let creationDates = fmap teamContactCreatedAt r
  liftIO $
    assertEqual
      "user ids"
      (sort (fmap userId users <> [ownerId]))
      (sort (fmap teamContactUserId r))
  liftIO $ assertEqual "sorted team contacts" (sortOn Down creationDates) creationDates

testSort :: (TestConstraints m) => Brig -> m ()
testSort brig = do
  (tid, userId -> ownerId, usersImplicitOrder) <- createPopulatedBindingTeamWithNamesAndHandles brig 4
  -- Shuffle here to guard against false positives in this test.
  -- This might happen due to buggy data generation, where all users share the same value in the sort property,
  -- resulting in an implicit order, which might coincide in the DB and ES, resulting in false positive test
  -- result.
  users <- liftIO $ shuffleM usersImplicitOrder
  refreshIndex brig
  let sortByProperty' :: (TestConstraints m, Ord a) => TeamUserSearchSortBy -> (User -> a) -> TeamUserSearchSortOrder -> m ()
      sortByProperty' = sortByProperty tid users ownerId
  for_ [SortOrderAsc, SortOrderDesc] $ \sortOrder -> do
    -- FUTUREWORK: Test SortByRole when role is available in index
    sortByProperty' SortByEmail userEmail sortOrder
    sortByProperty' SortByName userDisplayName sortOrder
    sortByProperty' SortByHandle (fmap fromHandle . userHandle) sortOrder
  where
    sortByProperty :: (TestConstraints m, Ord a) => TeamId -> [User] -> UserId -> TeamUserSearchSortBy -> (User -> a) -> TeamUserSearchSortOrder -> m ()
    sortByProperty tid users ownerId tuSortBy orderProp sortOrder = do
      let uids =
            fmap
              userId
              ( case sortOrder of
                  SortOrderAsc -> sortOn orderProp users
                  SortOrderDesc -> sortOn (Down . orderProp) users
              )
      r <- searchResults <$> executeTeamUserSearch brig tid ownerId Nothing Nothing (Just tuSortBy) (Just sortOrder)
      let rUids = filter (/= ownerId) $ fmap teamContactUserId r
      liftIO $ assertEqual ("users sorted by " <> cs (toByteString tuSortBy)) uids rUids

-- Creating test users for these cases is hard, so we skip it.
-- This test checks that the search query at least succeeds and returns the users of the team (without testing correct order).
testSortCallSucceeds :: (TestConstraints m) => Brig -> m ()
testSortCallSucceeds brig = do
  (tid, userId -> ownerId, users) <- createPopulatedBindingTeamWithNamesAndHandles brig 4
  refreshIndex brig
  let n = length users + 1
  for_ [SortByManagedBy, SortBySAMLIdp] $ \tuSortBy -> do
    r <- searchResults <$> executeTeamUserSearch brig tid ownerId Nothing Nothing (Just tuSortBy) (Just SortOrderAsc)
    liftIO $ assertEqual ("length of users sorted by " <> cs (toByteString tuSortBy)) n (length r)

testEmptyQuerySortedWithPagination :: (TestConstraints m) => Brig -> m ()
testEmptyQuerySortedWithPagination brig = do
  (tid, userId -> ownerId, _) <- createPopulatedBindingTeamWithNamesAndHandles brig 20
  refreshIndex brig
  let teamUserSearch mPs = executeTeamUserSearchWithMaybeState brig tid ownerId (Just "") Nothing Nothing Nothing (Just $ unsafeRange 10) mPs
  searchResultFirst10 <- teamUserSearch Nothing
  searchResultNext10 <- teamUserSearch (searchPagingState searchResultFirst10)
  searchResultLast1 <- teamUserSearch (searchPagingState searchResultNext10)
  liftIO $ do
    searchReturned searchResultFirst10 @?= 10
    searchFound searchResultFirst10 @?= 21
    searchHasMore searchResultFirst10 @?= Just True
    searchReturned searchResultNext10 @?= 10
    searchFound searchResultNext10 @?= 21
    searchHasMore searchResultNext10 @?= Just True
    searchReturned searchResultLast1 @?= 1
    searchFound searchResultLast1 @?= 21
    searchHasMore searchResultLast1 @?= Just False
