-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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 Wire.BrigAPIAccess.Rpc where

import Bilge
import Control.Monad.Catch (throwM)
import Data.Aeson
import Data.ByteString.Char8 qualified as BSC
import Data.ByteString.Conversion
import Data.Handle
import Data.HavePendingInvitations (HavePendingInvitations (..))
import Data.Id
import Data.Misc
import Data.Qualified
import Data.Set qualified as Set
import Data.Text.Encoding qualified as Text
import Imports
import Network.HTTP.Client (HttpExceptionContent (..))
import Network.HTTP.Client qualified as Http
import Network.HTTP.Types (StdMethod (..))
import Network.HTTP.Types.Status hiding (statusCode)
import Network.Wai.Utilities.Error qualified as Wai
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog
import SAML2.WebSSO qualified as SAML
import System.Logger.Message qualified as Logger
import Util.Options
import Web.Cookie (SetCookie, parseSetCookie)
import Web.HttpApiData
import Web.Scim.Filter as Scim
import Wire.API.Connection
import Wire.API.Error.Galley
import Wire.API.Locale
import Wire.API.MLS.CipherSuite
import Wire.API.Routes.Internal.Brig (CreateGroupInternalRequest (..), GetBy, IdpChangedNotification (..), UpdateGroupInternalRequest (..))
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
import Wire.API.Team.Export
import Wire.API.Team.Feature
import Wire.API.Team.LegalHold.Internal
import Wire.API.Team.Role (Role)
import Wire.API.Team.Size
import Wire.API.User hiding (DeleteUser (..))
import Wire.API.User.Auth (CookieLabel)
import Wire.API.User.Auth.LegalHold
import Wire.API.User.Auth.ReAuth
import Wire.API.User.Auth.Sso qualified as Sso
import Wire.API.User.Client
import Wire.API.User.Client.Prekey
import Wire.API.User.RichInfo
import Wire.API.UserGroup (NewUserGroup, UserGroup)
import Wire.API.UserGroup.Pagination
import Wire.BrigAPIAccess (BrigAPIAccess (..), DeleteGroupManagedError (..), OpaqueAuthToken (..))
import Wire.ParseException
import Wire.Rpc
import Wire.RpcException

interpretBrigAccess ::
  ( Member TinyLog r,
    Member Rpc r,
    Member (Error ParseException) r,
    Member (Error RpcException) r
  ) =>
  Endpoint ->
  Sem (BrigAPIAccess ': r) a ->
  Sem r a
interpretBrigAccess brigEndpoint =
  interpret $
    runInputConst brigEndpoint . \case
      GetConnectionsUnqualified uids muids mrel -> do
        getConnectionsUnqualified uids muids mrel
      GetConnections uids mquids mrel -> do
        getConnections uids mquids mrel
      PutConnectionInternal uc -> do
        putConnectionInternal uc
      ReauthUser uid reauth -> do
        reAuthUser uid reauth
      LookupActivatedUsers uids -> do
        lookupActivatedUsers uids
      GetUsers uids -> do
        getUsers uids
      DeleteUser uid -> do
        deleteUser uid
      GetContactList uid -> do
        getContactList uid
      GetUserExportData uid -> do
        getUserExportData uid
      GetSize tid -> do
        getSize tid
      LookupClients uids -> do
        lookupClients uids
      LookupClientsFull uids -> do
        lookupClientsFull uids
      NotifyClientsAboutLegalHoldRequest self other pk -> do
        notifyClientsAboutLegalHoldRequest self other pk
      GetLegalHoldAuthToken uid mpwd -> do
        getLegalHoldAuthToken uid mpwd
      AddLegalHoldClientToUserEither uid conn pks lpk -> do
        addLegalHoldClientToUser uid conn pks lpk
      RemoveLegalHoldClientFromUser uid -> do
        removeLegalHoldClientFromUser uid
      GetAccountConferenceCallingConfigClient uid -> do
        getAccountConferenceCallingConfigClient uid
      GetLocalMLSClients qusr ss -> do
        getLocalMLSClients qusr ss
      GetLocalMLSClient qusr cid ss -> do
        getLocalMLSClient qusr cid ss
      UpdateSearchVisibilityInbound status -> do
        updateSearchVisibilityInbound status
      DeleteBot convId botId ->
        deleteBot convId botId
      UpdateSearchIndex uid -> updateSearchIndex uid
      GetAccountsBy localGetBy ->
        getAccountsBy localGetBy
      GetUsersByVariousKeys uids handles emails includePendingInvitations ->
        getUsersByVariousKeys uids handles emails includePendingInvitations
      CreateGroupInternal managedBy teamId creatorUserId newGroup ->
        createGroupInternal managedBy teamId creatorUserId newGroup
      GetGroupsInternal tid mbFilter mbManagedBy startIndex mbCount ->
        getGroupsInternal tid mbFilter mbManagedBy startIndex mbCount
      GetGroupInternal tid gid includeChannels ->
        getGroupInternal tid gid includeChannels
      UpdateGroup req ->
        updateGroup req
      DeleteGroupInternal managedBy teamId groupId ->
        deleteGroupInternal managedBy teamId groupId
      GetAppIdsForTeam teamId ->
        getAppIdsForTeam teamId
      SetAccountStatus uid status ->
        setAccountStatus uid status
      DeleteApp teamId uid ->
        deleteApp teamId uid
      CreateSAML uref buid teamid name managedBy handle richInfo mLocale role ->
        createSAML uref buid teamid name managedBy handle richInfo mLocale role
      CreateNoSAML extId email uid teamid uname locale role ->
        createNoSAML extId email uid teamid uname locale role
      UpdateEmail uid email activation ->
        updateEmail uid email activation
      GetAccount havePending uid ->
        getAccount havePending uid
      GetAccountByHandle handle ->
        getByHandle handle
      GetByEmail email ->
        getByEmail email
      SetName uid name ->
        setName uid name
      SetHandle uid handle ->
        setHandle uid handle
      SetManagedBy uid managedBy ->
        setManagedBy uid managedBy
      DeletePendingEmailUpdate uid ->
        deletePendingEmailUpdate uid
      SetSSOId uid ssoId ->
        setSSOId uid ssoId
      SetRichInfo uid richInfo ->
        setRichInfo uid richInfo
      SetLocale uid mLocale ->
        setLocale uid mLocale
      GetRichInfo uid ->
        getRichInfo uid
      CheckHandleAvailable handle ->
        checkHandleAvailable handle
      SsoLogin uid mLabel ->
        ssoLogin uid mLabel
      GetStatus uid ->
        getStatus uid
      GetStatusMaybe uid ->
        getStatusMaybe uid
      SetStatus uid status ->
        setStatus uid status
      GetDefaultUserLocale ->
        getDefaultUserLocale
      CheckAdminGetTeamId uid ->
        checkAdminGetTeamId uid
      SendSAMLIdPChangedEmail notif ->
        sendSAMLIdPChangedEmail notif

brigRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString))
brigRequest req = do
  ep <- input
  rpcWithRetries "brig" ep req

decodeBodyOrThrow :: forall a r. (Typeable a, FromJSON a, Member (Error ParseException) r) => Text -> Response (Maybe LByteString) -> Sem r a
decodeBodyOrThrow ctx r = either (throw . ParseException ctx) pure (responseJsonEither r)

-- \| Get statuses of all connections between two groups of users (the usual
-- pattern is to check all connections from one user to several, or from
-- several users to one).
--
-- When a connection does not exist, it is skipped.
-- Calls 'Brig.API.Internal.getConnectionsStatusUnqualified'.
getConnectionsUnqualified ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  [UserId] ->
  Maybe [UserId] ->
  Maybe Relation ->
  Sem r [ConnectionStatus]
getConnectionsUnqualified uFrom uTo rlt = do
  r <-
    brigRequest $
      method POST
        . path "/i/users/connections-status"
        . maybe id rfilter rlt
        . json ConnectionsStatusRequest {csrFrom = uFrom, csrTo = uTo}
        . expect2xx
  decodeBodyOrThrow "brig" r
  where
    rfilter = queryItem "filter" . (BSC.pack . map toLower . show)

-- | Get statuses of all connections between two groups of users (the usual
-- pattern is to check all connections from one user to several, or from
-- several users to one).
--
-- When a connection does not exist, it is skipped.
-- Calls 'Brig.API.Internal.getConnectionsStatus'.
getConnections ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  [UserId] ->
  Maybe [Qualified UserId] ->
  Maybe Relation ->
  Sem r [ConnectionStatusV2]
getConnections [] _ _ = pure []
getConnections uFrom uTo rlt = do
  r <-
    brigRequest $
      method POST
        . path "/i/users/connections-status/v2"
        . json (ConnectionsStatusRequestV2 uFrom uTo rlt)
        . expect2xx
  decodeBodyOrThrow "brig" r

putConnectionInternal ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UpdateConnectionsInternal ->
  Sem r Status
putConnectionInternal updateConn = do
  response <-
    brigRequest $
      method PUT
        . paths ["/i/connections/connection-update"]
        . json updateConn
  pure $ responseStatus response

deleteBot ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  ConvId ->
  BotId ->
  Sem r ()
deleteBot cid bot = do
  void $
    brigRequest $
      method DELETE
        . path "/bot/self"
        . header "Z-Type" "bot"
        . header "Z-Bot" (toByteString' bot)
        . header "Z-Conversation" (toByteString' cid)
        . expect2xxOr404

-- | Calls 'Brig.User.API.Auth.reAuthUserH'.
reAuthUser ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  ReAuthUser ->
  Sem r (Either AuthenticationError ())
reAuthUser uid auth = do
  let req =
        method GET
          . paths ["/i/users", toByteString' uid, "reauthenticate"]
          . json auth
  resp <- brigRequest (check [status200, status403, status429] . req)
  pure $ case (statusCode resp, errorLabel resp) of
    (200, _) -> Right ()
    (403, Just "code-authentication-required") -> Left VerificationCodeRequired
    (403, Just "code-authentication-failed") -> Left VerificationCodeAuthFailed
    (403, _) -> Left ReAuthFailed
    (429, _) -> Left RateLimitExceeded
    (_, _) -> Left ReAuthFailed
  where
    errorLabel :: ResponseLBS -> Maybe LText
    errorLabel = fmap Wai.label . responseJsonMaybe

check :: [Status] -> Request -> Request
check allowed r =
  r
    { Http.checkResponse = \rq rs ->
        unless (responseStatus rs `elem` allowed) $
          let ex = StatusCodeException (rs {responseBody = ()}) mempty
           in throwM $ HttpExceptionRequest rq ex
    }

-- | Calls 'Brig.API.listActivatedAccountsH'.
lookupActivatedUsers :: (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) => [UserId] -> Sem r [User]
lookupActivatedUsers = chunkify $ \uids -> do
  let users = BSC.intercalate "," $ toByteString' <$> uids
  r <-
    brigRequest $
      method GET
        . path "/i/users"
        . queryItem "ids" users
        . expect2xx
  decodeBodyOrThrow "brig" r

-- | URLs with more than ~160 uids produce 400 responses, because HAProxy has a
--   URL length limit of ~6500 (determined experimentally). 100 is a
--   conservative setting. A uid contributes about 36+3 characters (+3 for the
--   comma separator) to the overall URL length.
chunkify :: forall m key a. (Monad m, Monoid a) => ([key] -> m a) -> [key] -> m a
chunkify doChunk keys = mconcat <$> (doChunk `mapM` chunks keys)
  where
    maxSize :: Int
    maxSize = 100

    chunks :: [any] -> [[any]]
    chunks [] = []
    chunks uids = case splitAt maxSize uids of (h, t) -> h : chunks t

-- | Calls 'Brig.API.listActivatedAccountsH'.
getUsers ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  [UserId] ->
  Sem r [User]
getUsers = chunkify $ \uids -> do
  resp <-
    brigRequest $
      method GET
        . path "/i/users"
        . queryItem "ids" (BSC.intercalate "," (toByteString' <$> uids))
        . expect2xx
  pure . fromMaybe [] . responseJsonMaybe $ resp

-- | Calls 'Brig.API.deleteUserNoAuthH'.
deleteUser ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  Sem r ()
deleteUser uid = do
  void $
    brigRequest $
      method DELETE
        . paths ["/i/users", toByteString' uid]
        . expect2xxOr404

-- | Calls 'Brig.API.getContactListH'.
getContactList ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UserId ->
  Sem r [UserId]
getContactList uid = do
  r <-
    brigRequest $
      method GET
        . paths ["/i/users", toByteString' uid, "contacts"]
        . expect2xx
  cUsers <$> decodeBodyOrThrow "brig" r

-- | Calls 'Brig.API.Internal.getUserExportDataH'
getUserExportData ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UserId ->
  Sem r (Maybe TeamExportUser)
getUserExportData uid = do
  resp <-
    brigRequest $
      check [status200, status404]
        . method GET
        . paths ["i/users", toByteString' uid, "export-data"]
  if statusCode resp == 404
    then pure Nothing
    else decodeBodyOrThrow "brig" resp

getAccountConferenceCallingConfigClient ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UserId ->
  Sem r (Feature ConferenceCallingConfig)
getAccountConferenceCallingConfigClient uid = do
  resp <-
    brigRequest $
      method GET
        . paths ["i", "users", toByteString' uid, "features", "conferenceCalling"]
        . expect2xx
  decodeBodyOrThrow "brig" resp

updateSearchVisibilityInbound ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  Multi.TeamStatus SearchVisibilityInboundConfig ->
  Sem r ()
updateSearchVisibilityInbound update = do
  void . brigRequest $
    method POST
      . paths ["i", "teams"]
      . json update
      . expect2xx

getSize ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  TeamId ->
  Sem r TeamSize
getSize tid = do
  r <-
    brigRequest $
      method GET
        . paths ["/i/teams", toByteString' tid, "size"]
        . expect2xx
  decodeBodyOrThrow "brig" r

-- | Calls 'Brig.API.internalListClientsH'.
lookupClients ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  [UserId] ->
  Sem r UserClients
lookupClients uids = do
  r <-
    brigRequest $
      method POST
        . path "/i/clients"
        . json (UserSet $ Set.fromList uids)
        . expect2xx
  clients <- decodeBodyOrThrow "brig" r
  pure $ filterClients (not . Set.null) clients

-- | Calls 'Brig.API.internalListClientsFullH'.
lookupClientsFull ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  [UserId] ->
  Sem r UserClientsFull
lookupClientsFull uids = do
  r <-
    brigRequest $
      method POST
        . path "/i/clients/full"
        . json (UserSet $ Set.fromList uids)
        . expect2xx
  clients <- decodeBodyOrThrow "brig" r
  pure $ filterClientsFull (not . Set.null) clients

-- | Calls 'Brig.API.legalHoldClientRequestedH'.
notifyClientsAboutLegalHoldRequest ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  UserId ->
  LastPrekey ->
  Sem r ()
notifyClientsAboutLegalHoldRequest requesterUid targetUid lastPrekey' = do
  void . brigRequest $
    method POST
      . paths ["i", "clients", "legalhold", toByteString' targetUid, "request"]
      . json (LegalHoldClientRequest requesterUid lastPrekey')
      . expect2xxOr404

-- | Calls 'Brig.User.API.Auth.legalHoldLoginH'.
getLegalHoldAuthToken ::
  ( Member TinyLog r,
    Member (Input Endpoint) r,
    Member Rpc r,
    Member (Error ParseException) r
  ) =>
  UserId ->
  Maybe PlainTextPassword6 ->
  Sem r OpaqueAuthToken
getLegalHoldAuthToken uid pw = do
  r <-
    brigRequest $
      method POST
        . path "/i/legalhold-login"
        . queryItem "persist" "true"
        . json (LegalHoldLogin uid pw Nothing)
        . expect2xx
  case getCookieValue "zuid" r of
    Nothing -> do
      warn $ Logger.msg @Text "Response from login missing auth cookie"
      throw $ ParseException "brig" "Response from login missing auth cookie"
    Just c -> pure . OpaqueAuthToken . Text.decodeUtf8 $ c

-- | Calls 'Brig.API.addClientInternalH'.
addLegalHoldClientToUser ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UserId ->
  ConnId ->
  [UncheckedPrekeyBundle] ->
  LastPrekey ->
  Sem r (Either AuthenticationError ClientId)
addLegalHoldClientToUser uid connId prekeys lastPrekey' = do
  fmap (.clientId) <$> brigAddClient uid connId lhClient
  where
    lhClient =
      NewClient
        prekeys
        lastPrekey'
        LegalHoldClientType
        Nothing
        (Just LegalHoldClient)
        Nothing
        Nothing
        Nothing
        Nothing
        mempty
        Nothing

-- | Calls 'Brig.API.removeLegalHoldClientH'.
removeLegalHoldClientFromUser ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  Sem r ()
removeLegalHoldClientFromUser targetUid = do
  void . brigRequest $
    method DELETE
      . paths ["i", "clients", "legalhold", toByteString' targetUid]
      . contentJson
      . expect2xxOr404

-- | Calls 'Brig.API.addClientInternalH'.
brigAddClient ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UserId ->
  ConnId ->
  NewClient ->
  Sem r (Either AuthenticationError Client)
brigAddClient uid connId client = do
  r <-
    brigRequest $
      method POST
        . header "Z-Connection" (toByteString' connId)
        . paths ["i", "clients", toByteString' uid]
        . contentJson
        . json client
        . expectStatus (flip elem [201, 403])
  if statusCode r == 201
    then Right <$> decodeBodyOrThrow "brig" r
    else pure (Left ReAuthFailed)

-- | Calls 'Brig.API.Internal.getMLSClients'.
getLocalMLSClients ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  Local UserId ->
  CipherSuiteTag ->
  Sem r (Set ClientInfo)
getLocalMLSClients lusr suite =
  brigRequest
    ( method GET
        . paths ["i", "mls", "clients", toByteString' (tUnqualified lusr)]
        . queryItem
          "ciphersuite"
          (toHeader (tagCipherSuite suite))
        . expect2xx
    )
    >>= decodeBodyOrThrow "brig"

-- | Calls 'Brig.API.Internal.getMLSClient'.
getLocalMLSClient ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  Local UserId ->
  ClientId ->
  CipherSuiteTag ->
  Sem r ClientInfo
getLocalMLSClient lusr cid suite =
  brigRequest
    ( method GET
        . paths
          ["i", "mls", "client", toByteString' (tUnqualified lusr), toByteString' cid]
        . queryItem
          "ciphersuite"
          (toHeader (tagCipherSuite suite))
        . expect2xx
    )
    >>= decodeBodyOrThrow "brig"

updateSearchIndex ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  Sem r ()
updateSearchIndex uid = do
  void . brigRequest $
    method POST
      . paths ["i", "index", "update", toByteString' uid]
      . expect2xx

-- | Calls 'Brig.API.Internal.getAccountsByInternalH'.
getAccountsBy ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  GetBy ->
  Sem r [User]
getAccountsBy localGetBy = do
  r <-
    brigRequest $
      method POST
        . path "/i/users/accounts-by"
        . json localGetBy
        . expect2xx
  decodeBodyOrThrow "brig" r

-- | Calls 'Brig.API.Internal.listActivatedAccountsH' (iGetUsersByVariousKeys).
--
-- FUTUREWORK: are we sure this is really needed?  the only call site
-- looks weird.
getUsersByVariousKeys ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  [UserId] ->
  [Handle] ->
  [EmailAddress] ->
  HavePendingInvitations ->
  Sem r [User]
getUsersByVariousKeys uids handles emails includePendingInvitations = do
  r <-
    brigRequest $
      method GET
        . path "/i/users"
        . queryItemList "ids" uids
        . queryItemList "handles" handles
        . queryItemList "email" emails
        . ( case includePendingInvitations of
              WithPendingInvitations -> queryItem "includePendingInvitations" "true"
              NoPendingInvitations -> id
          )
        . expect2xx
  decodeBodyOrThrow "brig" r
  where
    queryItemList :: (ToByteString a) => ByteString -> [a] -> Request -> Request
    queryItemList _ [] = id
    queryItemList key values = queryItem key (BSC.intercalate "," (map toByteString' values))

-- | Calls 'Brig.API.Internal.createGroupInternalH'.
createGroupInternal ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  ManagedBy ->
  TeamId ->
  Maybe UserId ->
  NewUserGroup ->
  Sem r (Either Wai.Error UserGroup)
createGroupInternal managedBy teamId creatorUserId newGroup = do
  let req =
        CreateGroupInternalRequest
          { managedBy,
            teamId,
            creatorUserId,
            newGroup
          }
  r <-
    brigRequest $
      method POST
        . path "/i/user-groups/full"
        . json req
  if is2xx r
    then Right <$> decodeBodyOrThrow @UserGroup "brig" r
    else Left <$> decodeBodyOrThrow @Wai.Error "brig" r

getGroupInternal ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  TeamId ->
  UserGroupId ->
  Bool ->
  Sem r (Maybe UserGroup)
getGroupInternal tid gid includeChannels = do
  r <-
    brigRequest $
      check [status200, status404]
        . method GET
        . paths ["i", "user-groups", toByteString' tid, toByteString' gid, toByteString' includeChannels]
  if statusCode r == 404
    then pure Nothing
    else decodeBodyOrThrow "brig" r

getGroupsInternal ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  TeamId ->
  Maybe Scim.Filter ->
  Maybe ManagedBy ->
  Word ->
  Maybe Word ->
  Sem r UserGroupPageWithMembers
getGroupsInternal tid mbFilter mbManagedBy startIndex mbCount = do
  maybeDisplayName :: Maybe Text <- case mbFilter of
    Just filter' -> case filter' of
      FilterAttrCompare (AttrPath _schema "displayName" Nothing) OpCo (ValString str) -> pure $ Just str
      _ -> throw $ ParseException "brig" $ "Unsupported SCIM filter: " <> show filter'
    Nothing -> pure Nothing
  r <-
    brigRequest $
      method GET
        . paths ["i", "user-groups", toByteString' tid]
        . maybe id (queryItem "nameContains" . Text.encodeUtf8) maybeDisplayName
        . maybe id (queryItem "managedBy" . toByteString') mbManagedBy
        . queryItem "startIndex" (toByteString' startIndex)
        . maybe id (queryItem "count" . toByteString') mbCount
        . expect2xx
  decodeBodyOrThrow "brig" r

updateGroup ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
  UpdateGroupInternalRequest ->
  Sem r (Either Wai.Error ())
updateGroup reqBody = do
  resp <-
    brigRequest $
      method PUT
        . paths ["i", "user-groups"]
        . json reqBody
  if is2xx resp
    then pure (Right ())
    else Left <$> decodeBodyOrThrow @Wai.Error "brig" resp

deleteGroupInternal ::
  ( Member Rpc r,
    Member (Input Endpoint) r,
    Member (Error ParseException) r
  ) =>
  ManagedBy ->
  TeamId ->
  UserGroupId ->
  Sem r (Either DeleteGroupManagedError ())
deleteGroupInternal managedBy teamId groupId = do
  resp <-
    brigRequest $
      method DELETE
        . paths ["i", "user-groups", toByteString' teamId, toByteString' groupId, "managed", toByteString' managedBy]
  case (statusCode resp, errorLabel resp) of
    (status, _) | statusIs2xx status -> pure $ Right ()
    (404, _) -> pure $ Right ()
    (403, Just "user-group-managed-by-mismatch") -> pure $ Left DeleteGroupManagedManagedByMismatch
    (status, label) ->
      throw $
        ParseException
          { _parseExceptionRemote = "brig",
            _parseExceptionMsg = "unexpected delete group managed response: " <> show status <> " / " <> show label
          }
  where
    errorLabel :: ResponseLBS -> Maybe LText
    errorLabel = fmap Wai.label . responseJsonMaybe

deleteApp ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  TeamId ->
  UserId ->
  Sem r ()
deleteApp teamId uid = do
  void $
    brigRequest $
      method DELETE
        . paths ["i", "teams", toByteString' teamId, "apps", toByteString' uid]
        . expect2xx

getAppIdsForTeam ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  TeamId ->
  Sem r [UserId]
getAppIdsForTeam teamId = do
  resp <-
    brigRequest $
      method GET
        . paths ["i", "teams", toByteString' teamId, "apps"]
        . expect2xx
  pure . fromMaybe [] . responseJsonMaybe $ resp

setAccountStatus ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  AccountStatus ->
  Sem r ()
setAccountStatus uid status =
  void $
    brigRequest $
      method PUT
        . paths ["i", "users", toByteString' uid, "status"]
        . json (AccountStatusUpdate status)
        . expect2xx

is2xx :: ResponseLBS -> Bool
is2xx = statusIs2xx . statusCode

statusIs2xx :: Int -> Bool
statusIs2xx s = s >= 200 && s < 300

-- SAML / SCIM user management (migrated from Spar.Intra.Brig)

createSAML ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  SAML.UserRef ->
  UserId ->
  TeamId ->
  Name ->
  ManagedBy ->
  Maybe Handle ->
  Maybe RichInfo ->
  Maybe Locale ->
  Role ->
  Sem r UserId
createSAML uref (Id buid) teamid name managedBy handle richInfo mLocale role = do
  let newUser =
        NewUserSpar
          { newUserSparUUID = buid,
            newUserSparDisplayName = name,
            newUserSparSSOId = UserSSOId uref,
            newUserSparTeamId = teamid,
            newUserSparManagedBy = managedBy,
            newUserSparHandle = handle,
            newUserSparRichInfo = richInfo,
            newUserSparLocale = mLocale,
            newUserSparRole = role
          }
  resp <- brigRequest $ method POST . path "/i/users/spar" . json newUser
  if statusCode resp `elem` [200, 201]
    then userId . selfUser <$> decodeBodyOrThrow @SelfProfile "brig" resp
    else rethrow "brig" resp

createNoSAML ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  Text ->
  EmailAddress ->
  UserId ->
  TeamId ->
  Name ->
  Maybe Locale ->
  Role ->
  Sem r UserId
createNoSAML extId email uid teamid uname locale role = do
  let newUser = NewUserScimInvitation teamid uid extId locale uname email role
  resp <-
    brigRequest $
      method POST
        . paths ["/i/teams", toByteString' teamid, "invitations"]
        . json newUser
  if statusCode resp `elem` [200, 201]
    then userId <$> decodeBodyOrThrow @User "brig" resp
    else
      rethrow "brig" resp

updateEmail ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  EmailAddress ->
  EmailActivation ->
  Sem r ()
updateEmail buid email activation = do
  resp <-
    brigRequest $
      method PUT
        . path "/i/self/email"
        . header "Z-User" (toByteString' buid)
        . query
          [ ("activation", Just (toByteString' activation)),
            ("validate", Just (fromBool validate)),
            ("activate", Just (fromBool activate))
          ]
        . json (EmailUpdate email)
  case statusCode resp of
    204 -> pure ()
    202 -> pure ()
    _ -> rethrow "brig" resp
  where
    (validate, activate) = case activation of
      AutoActivate -> (False, True)
      SendActivationEmail -> (True, False)

    fromBool :: Bool -> ByteString
    fromBool True = "true"
    fromBool False = "false"

getAccount ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  HavePendingInvitations ->
  UserId ->
  Sem r (Maybe User)
getAccount havePending buid = do
  resp <-
    brigRequest $
      method GET
        . paths ["/i/users"]
        . query
          [ ("ids", Just $ toByteString' buid),
            ( "includePendingInvitations",
              Just . toByteString' $
                case havePending of
                  WithPendingInvitations -> True
                  NoPendingInvitations -> False
            )
          ]
  case statusCode resp of
    200 ->
      decodeBodyOrThrow @[User] "brig" resp >>= \case
        [account] ->
          pure $
            if userDeleted account
              then Nothing
              else Just account
        _ -> pure Nothing
    404 -> pure Nothing
    _ -> rethrow "brig" resp

getByHandle ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  Handle ->
  Sem r (Maybe User)
getByHandle handle = do
  resp <-
    brigRequest $
      method GET
        . path "/i/users"
        . queryItem "handles" (toByteString' handle)
        . queryItem "includePendingInvitations" "true"
  case statusCode resp of
    200 -> listToMaybe <$> decodeBodyOrThrow @[User] "brig" resp
    404 -> pure Nothing
    _ -> rethrow "brig" resp

getByEmail ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  EmailAddress ->
  Sem r (Maybe User)
getByEmail email = do
  resp <-
    brigRequest $
      method GET
        . path "/i/users"
        . queryItem "email" (toByteString' email)
        . queryItem "includePendingInvitations" "true"
  case statusCode resp of
    200 -> do
      macc <- listToMaybe <$> decodeBodyOrThrow @[User] "brig" resp
      case userEmail =<< macc of
        Just email' | email' == email -> pure macc
        _ -> pure Nothing
    404 -> pure Nothing
    _ -> rethrow "brig" resp

setName ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  Name ->
  Sem r ()
setName buid (Name name) = do
  resp <-
    brigRequest $
      method PUT
        . paths ["/i/users", toByteString' buid, "name"]
        . json (NameUpdate name)
  if statusCode resp < 300
    then pure ()
    else rethrow "brig" resp

setHandle ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  Handle ->
  Sem r ()
setHandle buid handle = do
  resp <-
    brigRequest $
      method PUT
        . paths ["/i/users", toByteString' buid, "handle"]
        . json (HandleUpdate (fromHandle handle))
  case (statusCode resp, Wai.label <$> responseJsonMaybe @Wai.Error resp) of
    (200, Nothing) -> pure ()
    _ -> rethrow "brig" resp

setManagedBy ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  ManagedBy ->
  Sem r ()
setManagedBy buid managedBy = do
  resp <-
    brigRequest $
      method PUT
        . paths ["/i/users", toByteString' buid, "managed-by"]
        . json (ManagedByUpdate managedBy)
  unless (statusCode resp == 200) $
    rethrow "brig" resp

deletePendingEmailUpdate ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  Sem r ()
deletePendingEmailUpdate buid = do
  resp <-
    brigRequest $
      method DELETE
        . paths ["i", "users", toByteString' buid, "pending-email-update"]
  unless (statusCode resp == 200) $
    rethrow "brig" resp

setSSOId ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  UserSSOId ->
  Sem r ()
setSSOId buid ssoId = do
  resp <-
    brigRequest $
      method PUT
        . paths ["i", "users", toByteString' buid, "sso-id"]
        . json ssoId
  unless (statusCode resp == 200) $
    rethrow "brig" resp

setRichInfo ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  RichInfo ->
  Sem r ()
setRichInfo buid richInfo = do
  resp <-
    brigRequest $
      method PUT
        . paths ["i", "users", toByteString' buid, "rich-info"]
        . json (RichInfoUpdate $ unRichInfo richInfo)
  unless (statusCode resp == 200) $
    rethrow "brig" resp

setLocale ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  Maybe Locale ->
  Sem r ()
setLocale buid = \case
  Just locale -> do
    resp <-
      brigRequest $
        method PUT
          . paths ["i", "users", toByteString' buid, "locale"]
          . json (LocaleUpdate locale)
    unless (statusCode resp == 200) $
      rethrow "brig" resp
  Nothing -> do
    resp <-
      brigRequest $
        method DELETE
          . paths ["i", "users", toByteString' buid, "locale"]
    unless (statusCode resp == 200) $
      rethrow "brig" resp

getRichInfo ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  UserId ->
  Sem r RichInfo
getRichInfo buid = do
  resp <-
    brigRequest $
      method GET
        . paths ["/i/users", toByteString' buid, "rich-info"]
  if statusCode resp == 200
    then decodeBodyOrThrow "brig" resp
    else rethrow "brig" resp

checkHandleAvailable ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  Handle ->
  Sem r Bool
checkHandleAvailable hnd = do
  resp <-
    brigRequest $
      method HEAD
        . paths ["/i/users/handles", toByteString' hnd]
  case statusCode resp of
    200 -> pure False -- handle exists
    404 -> pure True -- 404: handle not found
    _ -> rethrow "brig" resp

ssoLogin ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  UserId ->
  Maybe CookieLabel ->
  Sem r SetCookie
ssoLogin buid mlabel = do
  resp <-
    brigRequest $
      method POST
        . path "/i/sso-login"
        . json (Sso.SsoLogin buid mlabel)
        . queryItem "persist" "true"
  case statusCode resp of
    200 ->
      case getHeader "Set-Cookie" resp of
        Nothing -> throw $ ParseException "brig" "Missing Set-Cookie header in SSO login response"
        Just cky -> pure $ parseSetCookie cky
    _ -> rethrow "brig" resp

getStatusRaw ::
  (Member Rpc r, Member (Input Endpoint) r) =>
  UserId ->
  Sem r ResponseLBS
getStatusRaw uid =
  brigRequest $
    check [status200, status404]
      . method GET
      . paths ["/i/users", toByteString' uid, "status"]

getStatus ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  UserId ->
  Sem r AccountStatus
getStatus uid = do
  resp <- getStatusRaw uid
  case statusCode resp of
    200 -> fromAccountStatusResp <$> decodeBodyOrThrow @AccountStatusResp "brig" resp
    _ -> rethrow "brig" resp

getStatusMaybe ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  UserId ->
  Sem r (Maybe AccountStatus)
getStatusMaybe uid = do
  resp <- getStatusRaw uid
  case statusCode resp of
    200 -> Just . fromAccountStatusResp <$> decodeBodyOrThrow @AccountStatusResp "brig" resp
    404 -> pure Nothing
    _ -> rethrow "brig" resp

setStatus ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  UserId ->
  AccountStatus ->
  Sem r ()
setStatus uid status = do
  resp <-
    brigRequest $
      method PUT
        . paths ["/i/users", toByteString' uid, "status"]
        . json (AccountStatusUpdate status)
  unless (statusCode resp == 200) $
    rethrow "brig" resp

getDefaultUserLocale ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  Sem r Locale
getDefaultUserLocale = do
  resp <- brigRequest $ method GET . path "/i/users/locale"
  case statusCode resp of
    200 -> luLocale <$> decodeBodyOrThrow @LocaleUpdate "brig" resp
    _ -> rethrow "brig" resp

checkAdminGetTeamId ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) =>
  UserId ->
  Sem r (Either Wai.Error TeamId)
checkAdminGetTeamId uid = do
  resp <-
    brigRequest $
      check [status200, status403]
        . method GET
        . paths ["/i/users", toByteString' uid, "check-admin-get-team-id"]
  case statusCode resp of
    200 -> Right <$> decodeBodyOrThrow "brig" resp
    _ -> rethrow "brig" resp

sendSAMLIdPChangedEmail ::
  (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) =>
  IdpChangedNotification ->
  Sem r ()
sendSAMLIdPChangedEmail notif = do
  resp <-
    brigRequest $
      method POST
        . path "/i/idp/send-idp-changed-email"
        . json notif
  unless (statusCode resp == 200) $
    rethrow "brig" resp
