-- 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.Search.Util where

import Bilge
import Bilge.Assert
import Control.Monad.Catch (MonadCatch, MonadMask)
import Control.Retry
import Data.ByteString.Conversion (toByteString')
import Data.ByteString.Conversion.To (toByteString)
import Data.Domain (Domain)
import Data.Id
import Data.Qualified (Qualified (..))
import Data.Range (Range)
import Data.String.Conversions
import Data.Text.Encoding (encodeUtf8)
import Database.Bloodhound qualified as ES
import Imports
import Network.HTTP.Client qualified as HTTP
import Test.Tasty.HUnit
import Util
import Wire.API.User
import Wire.API.User.Search

executeSearch :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Text -> m (SearchResult Contact)
executeSearch brig self term = executeSearch' brig self term Nothing Nothing

executeSearchWithDomain :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Text -> Domain -> m (SearchResult Contact)
executeSearchWithDomain brig self term domain = executeSearch' brig self term (Just domain) Nothing

executeSearch' :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Text -> Maybe Domain -> Maybe Int -> m (SearchResult Contact)
executeSearch' brig self q maybeDomain maybeSize = do
  r <-
    searchRequest brig self q maybeDomain maybeSize
      <!! const 200 === statusCode
  responseJsonError r

searchRequest :: (MonadHttp m) => Brig -> UserId -> Text -> Maybe Domain -> Maybe Int -> m ResponseLBS
searchRequest brig self q maybeDomain maybeSize = do
  get
    ( brig
        . path "/search/contacts"
        . zUser self
        . queryItem "q" (encodeUtf8 q)
        . maybe id (queryItem "domain" . toByteString') maybeDomain
        . maybe id (queryItem "size" . toByteString') maybeSize
    )

-- | ES is only refreshed occasionally; we don't want to wait for that in tests.
refreshIndex :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> m ()
refreshIndex brig =
  post (brig . path "/i/index/refresh") !!! const 200 === statusCode

reindex :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> m ()
reindex brig =
  post (brig . path "/i/index/reindex") !!! const 200 === statusCode

assertCanFindByName :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> m ()
assertCanFindByName brig self expected =
  assertCanFind brig (userId self) (userQualifiedId expected) (fromName $ userDisplayName expected)

assertCan'tFindByName :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> m ()
assertCan'tFindByName brig self expected =
  assertCan'tFind brig (userId self) (userQualifiedId expected) (fromName $ userDisplayName expected)

ourRetryPol :: Int -> RetryPolicy
ourRetryPol to = limitRetriesByCumulativeDelay (to * 1_000_000) (exponentialBackoff 50000)

assertEventuallyCanFindByName :: (MonadMask m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> m ()
assertEventuallyCanFindByName brig self expected = recoverAll (ourRetryPol 5) (\_ -> assertCanFindByName brig self expected)

assertEventuallyCan'tFindByName :: (MonadMask m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> m ()
assertEventuallyCan'tFindByName brig self expected = recoverAll (ourRetryPol 5) (\_ -> assertCan'tFindByName brig self expected)

assertCanFind :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Qualified UserId -> Text -> m ()
assertCanFind brig self expected q = do
  r <- searchResults <$> executeSearch brig self q
  liftIO $ do
    assertBool ("No results for query: " <> show q) $
      not (null r)
    assertBool ("User not in results for query: " <> show q) $
      expected `elem` map contactQualifiedId r

assertCanFindWithDomain :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Qualified UserId -> Text -> Domain -> m ()
assertCanFindWithDomain brig self expected q domain = do
  r <- searchResults <$> executeSearchWithDomain brig self q domain
  liftIO $ do
    assertBool ("No results for query: " <> show q) $
      not (null r)
    assertBool ("User not in results for query: " <> show q) $
      expected `elem` map contactQualifiedId r

assertCan'tFind :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Qualified UserId -> Text -> m ()
assertCan'tFind brig self expected q = do
  r <- searchResults <$> executeSearch brig self q
  liftIO $ do
    assertBool ("User shouldn't be present in results for query: " <> show q) $
      expected `notElem` map contactQualifiedId r

executeTeamUserSearch ::
  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
  Brig ->
  TeamId ->
  UserId ->
  Maybe Text ->
  Maybe RoleFilter ->
  Maybe TeamUserSearchSortBy ->
  Maybe TeamUserSearchSortOrder ->
  m (SearchResult TeamContact)
executeTeamUserSearch brig teamid self mbSearchText mRoleFilter mSortBy mSortOrder =
  executeTeamUserSearchWithMaybeState brig teamid self mbSearchText mRoleFilter mSortBy mSortOrder Nothing Nothing

executeTeamUserSearchWithMaybeState ::
  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
  Brig ->
  TeamId ->
  UserId ->
  Maybe Text ->
  Maybe RoleFilter ->
  Maybe TeamUserSearchSortBy ->
  Maybe TeamUserSearchSortOrder ->
  Maybe (Range 1 500 Int32) ->
  Maybe PagingState ->
  m (SearchResult TeamContact)
executeTeamUserSearchWithMaybeState brig teamid self mbSearchText mRoleFilter mSortBy mSortOrder mSize mPagingState = do
  r <-
    get
      ( brig
          . paths ["/teams", toByteString' teamid, "search"]
          . zUser self
          . maybe id (queryItem "q" . encodeUtf8) mbSearchText
          . maybe id (queryItem "frole" . cs . toByteString) mRoleFilter
          . maybe id (queryItem "sortby" . cs . toByteString) mSortBy
          . maybe id (queryItem "sortorder" . cs . toByteString) mSortOrder
          . maybe id (queryItem "pagingState" . cs . toByteString) mPagingState
          . maybe id (queryItem "size" . cs . toByteString) mSize
      )
      <!! const 200
        === statusCode
  responseJsonError r

mkBHEnv :: Text -> HTTP.Manager -> ES.BHEnv
mkBHEnv url mgr = do
  (ES.mkBHEnv (ES.Server url) mgr) {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername "elastic") (ES.EsPassword "changeme")}
