-- 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.Settings (tests) where

import API.Team.Util
import Bilge hiding (accept, timeout)
import Bilge.Assert
import Brig.Options (Opts)
import Brig.Options qualified as Opt
import Control.Arrow ((&&&))
import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Conversion
import Data.Id
import Data.Set qualified as Set
import Imports
import Test.Tasty hiding (Timeout)
import Test.Tasty.HUnit
import Util
import Wire.API.Team.Member (rolePermissions)
import Wire.API.Team.Role
import Wire.API.User

allEmailVisibilities :: [EmailVisibilityConfig]
allEmailVisibilities = [EmailVisibleIfOnTeam, EmailVisibleIfOnSameTeam (), EmailVisibleToSelf]

tests :: Opts -> Manager -> Brig -> Galley -> IO TestTree
tests defOpts manager brig galley = pure $ do
  testGroup
    "settings"
    [ testGroup
        "setEmailVisibility"
        [ testGroup
            "/users/"
            $ ((,) <$> [minBound ..] <*> allEmailVisibilities)
              <&> \(viewingUserIs, visibility) -> do
                testCase (show (viewingUserIs, visibility))
                  . runHttpT manager
                  $ testUsersEmailVisibleIffExpected defOpts brig galley viewingUserIs visibility,
          testGroup
            "/users/:uid"
            $ ((,) <$> [minBound ..] <*> allEmailVisibilities)
              <&> \(viewingUserIs, visibility) -> do
                testCase (show (viewingUserIs, visibility))
                  . runHttpT manager
                  $ testGetUserEmailShowsEmailsIffExpected defOpts brig galley viewingUserIs visibility
        ]
    ]

-- | The user looking at users is always a team creator; the user looked falls into the
-- different categories enumerated here.
data ViewedUserIs = SameTeam | DifferentTeam | NoTeam

-- | Analog of 'ViewedUserIs' for the viewing user.
data ViewingUserIs = Creator | Member | Guest
  deriving (Eq, Show, Enum, Bounded)

expectEmailVisible :: EmailVisibilityConfig -> ViewingUserIs -> ViewedUserIs -> Bool
expectEmailVisible EmailVisibleIfOnTeam = \case
  _ -> \case
    SameTeam -> True
    DifferentTeam -> True
    NoTeam -> False
expectEmailVisible (EmailVisibleIfOnSameTeam _) = \case
  Creator -> \case
    SameTeam -> True
    DifferentTeam -> False
    NoTeam -> False
  Member -> \case
    SameTeam -> True
    DifferentTeam -> False
    NoTeam -> False
  Guest -> \case
    SameTeam -> False
    DifferentTeam -> False
    NoTeam -> False
expectEmailVisible EmailVisibleToSelf = \case
  Creator -> \case
    SameTeam -> True
    DifferentTeam -> False
    NoTeam -> False
  _ -> \case
    SameTeam -> False
    DifferentTeam -> False
    NoTeam -> False

jsonField :: (FromJSON a) => Key -> Value -> Maybe a
jsonField f u = u ^? key f >>= maybeFromJSON

testUsersEmailVisibleIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> EmailVisibilityConfig -> Http ()
testUsersEmailVisibleIffExpected opts brig galley viewingUserIs visibilitySetting = do
  (viewerId, userA, userB, nonTeamUser) <- setup brig galley viewingUserIs
  let uids =
        C8.intercalate "," $
          toByteString' <$> [userId userA, userId userB, userId nonTeamUser]
      expected :: Set (Maybe UserId, Maybe EmailAddress)
      expected =
        Set.fromList
          [ ( Just $ userId userA,
              if expectEmailVisible visibilitySetting viewingUserIs SameTeam
                then userEmail userA
                else Nothing
            ),
            ( Just $ userId userB,
              if expectEmailVisible visibilitySetting viewingUserIs DifferentTeam
                then userEmail userB
                else Nothing
            ),
            ( Just $ userId nonTeamUser,
              if expectEmailVisible visibilitySetting viewingUserIs NoTeam
                then userEmail nonTeamUser
                else Nothing
            )
          ]
  let newOpts = opts & Opt.settingsLens . Opt.emailVisibilityLens .~ visibilitySetting
  withSettingsOverrides newOpts $ do
    get (apiVersion "v1" . brig . zUser viewerId . path "users" . queryItem "ids" uids) !!! do
      const 200 === statusCode
      const (Just expected) === result
  where
    result r = Set.fromList . map (jsonField "id" &&& jsonField "email") <$> responseJsonMaybe r

testGetUserEmailShowsEmailsIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> EmailVisibilityConfig -> Http ()
testGetUserEmailShowsEmailsIffExpected opts brig galley viewingUserIs visibilitySetting = do
  (viewerId, userA, userB, nonTeamUser) <- setup brig galley viewingUserIs
  let expectations :: [(UserId, Maybe EmailAddress)]
      expectations =
        [ ( userId userA,
            if expectEmailVisible visibilitySetting viewingUserIs SameTeam
              then userEmail userA
              else Nothing
          ),
          ( userId userB,
            if expectEmailVisible visibilitySetting viewingUserIs DifferentTeam
              then userEmail userB
              else Nothing
          ),
          ( userId nonTeamUser,
            if expectEmailVisible visibilitySetting viewingUserIs NoTeam
              then userEmail nonTeamUser
              else Nothing
          )
        ]
  let newOpts = opts & Opt.settingsLens . Opt.emailVisibilityLens .~ visibilitySetting
  withSettingsOverrides newOpts $ do
    forM_ expectations $ \(uid, expectedEmail) ->
      get (apiVersion "v1" . brig . zUser viewerId . paths ["users", toByteString' uid]) !!! do
        const 200 === statusCode
        const expectedEmail === emailResult
  where
    emailResult :: Response (Maybe LByteString) -> Maybe EmailAddress
    emailResult r = responseJsonMaybe r >>= jsonField "email"

setup :: Brig -> Galley -> ViewingUserIs -> Http (UserId, User, User, User)
setup brig galley viewingUserIs = do
  (creatorId, tid) <- createUserWithTeam brig
  (otherTeamCreatorId, otherTid) <- createUserWithTeam brig
  userA <- createTeamMember brig galley creatorId tid (rolePermissions RoleMember)
  userB <- createTeamMember brig galley otherTeamCreatorId otherTid (rolePermissions RoleExternalPartner)
  nonTeamUser <- createUser "joe" brig
  viewerId <- case viewingUserIs of
    Creator -> pure creatorId
    Member -> userId <$> createTeamMember brig galley creatorId tid (rolePermissions RoleMember)
    Guest -> userId <$> createTeamMember brig galley creatorId tid (rolePermissions RoleExternalPartner)
  pure (viewerId, userA, userB, nonTeamUser)
