-- 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.User.RichInfo
  ( tests,
  )
where

import API.RichInfo.Util
import API.Team.Util (createTeamMember, createUserWithTeam)
import API.User.Util
import Bilge hiding (accept, timeout)
import Bilge.Assert
import Brig.Options
import Brig.Options qualified as Opt
import Data.CaseInsensitive qualified as CI
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text qualified as Text
import Imports
import Test.Tasty hiding (Timeout)
import Test.Tasty.HUnit
import Util
import Util.Timeout
import Wire.API.Team.Permission
import Wire.API.User
import Wire.API.User.RichInfo

tests :: ConnectionLimit -> Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> TestTree
tests _cl _at conf p b _c g =
  testGroup
    "rich info"
    [ test p "there is default empty rich info" $ testDefaultRichInfo b g,
      test p "missing fields in an update are deleted" $ testDeleteMissingFieldsInUpdates b g,
      test p "fields with empty strings are deleted" $ testDeleteEmptyFields b g,
      test p "duplicate field names are silently nubbed (first entry wins)" $ testDedupeDuplicateFieldNames b,
      test p "exceeding rich info size limit is forbidden" $ testRichInfoSizeLimit b conf,
      test p "non-team members don't have rich info" $ testNonTeamMembersDoNotHaveRichInfo b,
      test p "non-members / other membes / guests cannot see rich info" $ testGuestsCannotSeeRichInfo b
    ]

-- | Test that for team members there is rich info set by default, and that it's empty.
testDefaultRichInfo :: Brig -> Galley -> Http ()
testDefaultRichInfo brig galley = do
  -- Create a team with two users
  (owner, tid) <- createUserWithTeam brig
  member1 <- userId <$> createTeamMember brig galley owner tid noPermissions
  member2 <- userId <$> createTeamMember brig galley owner tid noPermissions
  -- The first user should see the second user's rich info and it should be empty
  richInfo <- getRichInfo brig member1 member2
  liftIO $
    assertEqual
      "rich info is not empty, or not present"
      (Right (mkRichInfoAssocList mempty))
      richInfo

testDeleteMissingFieldsInUpdates :: Brig -> Galley -> Http ()
testDeleteMissingFieldsInUpdates brig galley = do
  (owner, tid) <- createUserWithTeam brig
  member1 <- userId <$> createTeamMember brig galley owner tid noPermissions
  member2 <- userId <$> createTeamMember brig galley owner tid noPermissions
  let superset =
        mkRichInfoAssocList
          [ RichField "department" "blue",
            RichField "relevance" "meh"
          ]
      subset =
        mkRichInfoAssocList
          [ RichField "relevance" "meh"
          ]
  putRichInfo brig member2 superset !!! const 200 === statusCode
  putRichInfo brig member2 subset !!! const 200 === statusCode
  subset' <- getRichInfo brig member1 member2
  liftIO $ assertEqual "dangling rich info fields" (Right subset) subset'

testDeleteEmptyFields :: Brig -> Galley -> Http ()
testDeleteEmptyFields brig galley = do
  (owner, tid) <- createUserWithTeam brig
  member1 <- userId <$> createTeamMember brig galley owner tid noPermissions
  member2 <- userId <$> createTeamMember brig galley owner tid noPermissions
  let withEmpty =
        mkRichInfoAssocList
          [ RichField "department" ""
          ]
  putRichInfo brig member2 withEmpty !!! const 200 === statusCode
  withoutEmpty <- getRichInfo brig member1 member2
  liftIO $ assertEqual "dangling rich info fields" (Right mempty) withoutEmpty

testDedupeDuplicateFieldNames :: Brig -> Http ()
testDedupeDuplicateFieldNames brig = do
  (owner, _) <- createUserWithTeam brig
  let dupes =
        mkRichInfoAssocList
          [ RichField "dePartment" "blue",
            RichField "Department" "green"
          ]
      deduped =
        mkRichInfoAssocList
          [ RichField "departMent" "blue"
          ]
  putRichInfo brig owner dupes !!! const 200 === statusCode
  ri <- getRichInfo brig owner owner
  liftIO $ assertEqual "duplicate rich info fields" (Right deduped) ri

testRichInfoSizeLimit :: (HasCallStack) => Brig -> Opt.Opts -> Http ()
testRichInfoSizeLimit brig conf = do
  let maxSize :: Int = conf.settings.richInfoLimit
  (owner, _) <- createUserWithTeam brig
  let bad1 =
        mkRichInfoAssocList
          [ RichField "department" (Text.replicate (fromIntegral maxSize) "#")
          ]
      bad2 =
        mkRichInfoAssocList $
          [0 .. (maxSize `div` 2)]
            <&> \i -> RichField (CI.mk $ Text.pack $ show i) "#"
  putRichInfo brig owner bad1 !!! const 413 === statusCode
  putRichInfo brig owner bad2 !!! const 413 === statusCode

-- | Test that rich info of non-team members can not be queried.
--
-- Note: it would be nice to also test that non-team members can not set rich info, but for
-- now there's no public endpoint for setting it in Brig, so we can't do anything.
testNonTeamMembersDoNotHaveRichInfo :: Brig -> Http ()
testNonTeamMembersDoNotHaveRichInfo brig = do
  -- Create a user
  targetUser <- userId <$> randomUser brig
  -- Another user should get a 'Nothing' when querying their info
  do
    nonTeamUser <- userId <$> randomUser brig
    richInfo <- getRichInfo brig nonTeamUser targetUser
    liftIO $ assertEqual "rich info is present" (Left 403) richInfo
  -- A team member should also get a 'Nothing' when querying their info
  do
    (teamUser, _) <- createUserWithTeam brig
    richInfo <- getRichInfo brig teamUser targetUser
    liftIO $ assertEqual "rich info is present" (Left 403) richInfo

testGuestsCannotSeeRichInfo :: Brig -> Http ()
testGuestsCannotSeeRichInfo brig = do
  -- Create a team
  (owner, _) <- createUserWithTeam brig
  -- A non-team user should get "forbidden" when querying rich info for team user.
  do
    nonTeamUser <- userId <$> randomUser brig
    richInfo <- getRichInfo brig nonTeamUser owner
    liftIO $ assertEqual "rich info status /= 403" (Left 403) richInfo
  -- ...  even if she's a guest in the team...
  do
    guest <- userId <$> randomUser brig
    connectUsers brig owner (NonEmpty.singleton guest)
    richInfo <- getRichInfo brig guest owner
    liftIO $ assertEqual "rich info status /= 403" (Left 403) richInfo
  -- ...  or if she's in another team.
  do
    (otherOwner, _) <- createUserWithTeam brig
    richInfo <- getRichInfo brig otherOwner owner
    liftIO $ assertEqual "rich info status /= 403" (Left 403) richInfo
