-- Disabling to stop warnings on HasCallStack
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- 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 Galley.Intra.User
  ( getConnections,
    getConnectionsUnqualified,
    putConnectionInternal,
    deleteBot,
    reAuthUser,
    lookupActivatedUsers,
    getUsers,
    deleteUser,
    getContactList,
    chunkify,
    getRichInfoMultiUser,
    getAccountConferenceCallingConfigClient,
    updateSearchVisibilityInbound,
  )
where

import Bilge hiding (getHeader, host, options, port, statusCode)
import Bilge.RPC
import Brig.Types.Intra qualified as Brig
import Control.Error hiding (bool, isRight)
import Control.Lens (view, (^.))
import Control.Monad.Catch
import Data.ByteString.Char8 (pack)
import Data.ByteString.Char8 qualified as BSC
import Data.ByteString.Conversion
import Data.Id
import Data.Qualified
import Data.Text qualified as Text
import Data.Text.Lazy qualified as Lazy
import Galley.API.Error
import Galley.Env
import Galley.Intra.Util
import Galley.Monad
import Imports
import Network.HTTP.Client (HttpExceptionContent (..))
import Network.HTTP.Client.Internal qualified as Http
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status
import Network.Wai.Utilities.Error
import Network.Wai.Utilities.Error qualified as Wai
import Servant.Client qualified as Client
import Util.Options
import Wire.API.Connection
import Wire.API.Error.Galley
import Wire.API.Routes.Internal.Brig qualified as IAPI
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
import Wire.API.Routes.Named
import Wire.API.Team.Feature
import Wire.API.User
import Wire.API.User.Auth.ReAuth
import Wire.API.User.RichInfo (RichInfo)

-- | 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 ::
  [UserId] ->
  Maybe [UserId] ->
  Maybe Relation ->
  App [ConnectionStatus]
getConnectionsUnqualified :: [UserId]
-> Maybe [UserId] -> Maybe Relation -> App [ConnectionStatus]
getConnectionsUnqualified [UserId]
uFrom Maybe [UserId]
uTo Maybe Relation
rlt = do
  Response (Maybe ByteString)
r <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
POST
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/users/connections-status"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (Relation -> Request -> Request)
-> Maybe Relation
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id Relation -> Request -> Request
rfilter Maybe Relation
rlt
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionsStatusRequest -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json ConnectionsStatusRequest {$sel:csrFrom:ConnectionsStatusRequest :: [UserId]
csrFrom = [UserId]
uFrom, $sel:csrTo:ConnectionsStatusRequest :: Maybe [UserId]
csrTo = Maybe [UserId]
uTo}
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  (LText -> Error)
-> Response (Maybe ByteString) -> App [ConnectionStatus]
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, FromJSON a) =>
(LText -> e) -> Response (Maybe ByteString) -> m a
parseResponse (Status -> LText -> LText -> Error
mkError Status
status502 LText
"server-error") Response (Maybe ByteString)
r
  where
    rfilter :: Relation -> Request -> Request
rfilter = ByteString -> ByteString -> Request -> Request
queryItem ByteString
"filter" (ByteString -> Request -> Request)
-> (Relation -> ByteString) -> Relation -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ByteString
pack (String -> ByteString)
-> (Relation -> String) -> Relation -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Relation -> String) -> Relation -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation -> String
forall a. Show a => a -> String
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 ::
  [UserId] ->
  Maybe [Qualified UserId] ->
  Maybe Relation ->
  App [ConnectionStatusV2]
getConnections :: [UserId]
-> Maybe [Qualified UserId]
-> Maybe Relation
-> App [ConnectionStatusV2]
getConnections [] Maybe [Qualified UserId]
_ Maybe Relation
_ = [ConnectionStatusV2] -> App [ConnectionStatusV2]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getConnections [UserId]
uFrom Maybe [Qualified UserId]
uTo Maybe Relation
rlt = do
  Response (Maybe ByteString)
r <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
POST
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/users/connections-status/v2"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionsStatusRequestV2 -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json ([UserId]
-> Maybe [Qualified UserId]
-> Maybe Relation
-> ConnectionsStatusRequestV2
ConnectionsStatusRequestV2 [UserId]
uFrom Maybe [Qualified UserId]
uTo Maybe Relation
rlt)
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  (LText -> Error)
-> Response (Maybe ByteString) -> App [ConnectionStatusV2]
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, FromJSON a) =>
(LText -> e) -> Response (Maybe ByteString) -> m a
parseResponse (Status -> LText -> LText -> Error
mkError Status
status502 LText
"server-error") Response (Maybe ByteString)
r

putConnectionInternal ::
  UpdateConnectionsInternal ->
  App Status
putConnectionInternal :: UpdateConnectionsInternal -> App Status
putConnectionInternal UpdateConnectionsInternal
updateConn = do
  Response (Maybe ByteString)
response <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
PUT
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"/i/connections/connection-update"]
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateConnectionsInternal -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json UpdateConnectionsInternal
updateConn
  Status -> App Status
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status -> App Status) -> Status -> App Status
forall a b. (a -> b) -> a -> b
$ Response (Maybe ByteString) -> Status
forall body. Response body -> Status
responseStatus Response (Maybe ByteString)
response

deleteBot ::
  ConvId ->
  BotId ->
  App ()
deleteBot :: ConvId -> BotId -> App ()
deleteBot ConvId
cid BotId
bot = do
  App (Response (Maybe ByteString)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response (Maybe ByteString)) -> App ())
-> App (Response (Maybe ByteString)) -> App ()
forall a b. (a -> b) -> a -> b
$
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
DELETE
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/bot/self"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString -> Request -> Request
header HeaderName
"Z-Type" ByteString
"bot"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString -> Request -> Request
header HeaderName
"Z-Bot" (BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' BotId
bot)
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString -> Request -> Request
header HeaderName
"Z-Conversation" (ConvId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ConvId
cid)
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx

-- | Calls 'Brig.User.API.Auth.reAuthUserH'.
reAuthUser ::
  UserId ->
  ReAuthUser ->
  App (Either AuthenticationError ())
reAuthUser :: UserId -> ReAuthUser -> App (Either AuthenticationError ())
reAuthUser UserId
uid ReAuthUser
auth = do
  let req :: Request -> Request
req =
        StdMethod -> Request -> Request
method StdMethod
GET
          (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"/i/users", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
uid, ByteString
"reauthenticate"]
          (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReAuthUser -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json ReAuthUser
auth
  Response (Maybe ByteString)
resp <- IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ([Status] -> Request -> Request
check [Status
status200, Status
status403] (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
req)
  Either AuthenticationError ()
-> App (Either AuthenticationError ())
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthenticationError ()
 -> App (Either AuthenticationError ()))
-> Either AuthenticationError ()
-> App (Either AuthenticationError ())
forall a b. (a -> b) -> a -> b
$ case (Status -> Int
statusCode (Status -> Int)
-> (Response (Maybe ByteString) -> Status)
-> Response (Maybe ByteString)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (Maybe ByteString) -> Status
forall body. Response body -> Status
responseStatus (Response (Maybe ByteString) -> Int)
-> Response (Maybe ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ Response (Maybe ByteString)
resp, Response (Maybe ByteString) -> Maybe LText
errorLabel Response (Maybe ByteString)
resp) of
    (Int
200, Maybe LText
_) -> () -> Either AuthenticationError ()
forall a b. b -> Either a b
Right ()
    (Int
403, Just LText
"code-authentication-required") -> AuthenticationError -> Either AuthenticationError ()
forall a b. a -> Either a b
Left AuthenticationError
VerificationCodeRequired
    (Int
403, Just LText
"code-authentication-failed") -> AuthenticationError -> Either AuthenticationError ()
forall a b. a -> Either a b
Left AuthenticationError
VerificationCodeAuthFailed
    (Int
403, Maybe LText
_) -> AuthenticationError -> Either AuthenticationError ()
forall a b. a -> Either a b
Left AuthenticationError
ReAuthFailed
    (Int
_, Maybe LText
_) -> AuthenticationError -> Either AuthenticationError ()
forall a b. a -> Either a b
Left AuthenticationError
ReAuthFailed
  where
    errorLabel :: ResponseLBS -> Maybe Lazy.Text
    errorLabel :: Response (Maybe ByteString) -> Maybe LText
errorLabel = (Error -> LText) -> Maybe Error -> Maybe LText
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Error -> LText
Wai.label (Maybe Error -> Maybe LText)
-> (Response (Maybe ByteString) -> Maybe Error)
-> Response (Maybe ByteString)
-> Maybe LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (Maybe ByteString) -> Maybe Error
forall a.
(HasCallStack, Typeable a, FromJSON a) =>
Response (Maybe ByteString) -> Maybe a
responseJsonMaybe

check :: [Status] -> Request -> Request
check :: [Status] -> Request -> Request
check [Status]
allowed Request
r =
  Request
r
    { Http.checkResponse = \Request
rq Response BodyReader
rs ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Response BodyReader -> Status
forall body. Response body -> Status
responseStatus Response BodyReader
rs Status -> [Status] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
allowed) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          let ex :: HttpExceptionContent
ex = Response () -> ByteString -> HttpExceptionContent
StatusCodeException (Response BodyReader
rs {responseBody = ()}) ByteString
forall a. Monoid a => a
mempty
           in HttpException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (HttpException -> IO ()) -> HttpException -> IO ()
forall a b. (a -> b) -> a -> b
$ Request -> HttpExceptionContent -> HttpException
HttpExceptionRequest Request
rq HttpExceptionContent
ex
    }

-- | Calls 'Brig.API.listActivatedAccountsH'.
lookupActivatedUsers :: [UserId] -> App [User]
lookupActivatedUsers :: [UserId] -> App [User]
lookupActivatedUsers = ([UserId] -> App [User]) -> [UserId] -> App [User]
forall (m :: * -> *) key a.
(Monad m, Monoid a) =>
([key] -> m a) -> [key] -> m a
chunkify (([UserId] -> App [User]) -> [UserId] -> App [User])
-> ([UserId] -> App [User]) -> [UserId] -> App [User]
forall a b. (a -> b) -> a -> b
$ \[UserId]
uids -> do
  let users :: ByteString
users = ByteString -> [ByteString] -> ByteString
BSC.intercalate ByteString
"," ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (UserId -> ByteString) -> [UserId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
uids
  Response (Maybe ByteString)
r <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
GET
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/users"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
queryItem ByteString
"ids" ByteString
users
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  (LText -> Error) -> Response (Maybe ByteString) -> App [User]
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, FromJSON a) =>
(LText -> e) -> Response (Maybe ByteString) -> m a
parseResponse (Status -> LText -> LText -> Error
mkError Status
status502 LText
"server-error") Response (Maybe ByteString)
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 :: forall (m :: * -> *) key a.
(Monad m, Monoid a) =>
([key] -> m a) -> [key] -> m a
chunkify [key] -> m a
doChunk [key]
keys = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([key] -> m a
doChunk ([key] -> m a) -> [[key]] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [key] -> [[key]]
forall any. [any] -> [[any]]
chunks [key]
keys)
  where
    maxSize :: Int
    maxSize :: Int
maxSize = Int
100

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

-- | Calls 'Brig.API.listActivatedAccountsH'.
getUsers :: [UserId] -> App [Brig.UserAccount]
getUsers :: [UserId] -> App [UserAccount]
getUsers = ([UserId] -> App [UserAccount]) -> [UserId] -> App [UserAccount]
forall (m :: * -> *) key a.
(Monad m, Monoid a) =>
([key] -> m a) -> [key] -> m a
chunkify (([UserId] -> App [UserAccount]) -> [UserId] -> App [UserAccount])
-> ([UserId] -> App [UserAccount]) -> [UserId] -> App [UserAccount]
forall a b. (a -> b) -> a -> b
$ \[UserId]
uids -> do
  Response (Maybe ByteString)
resp <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
GET
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/users"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
queryItem ByteString
"ids" (ByteString -> [ByteString] -> ByteString
BSC.intercalate ByteString
"," (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (UserId -> ByteString) -> [UserId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
uids))
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  [UserAccount] -> App [UserAccount]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UserAccount] -> App [UserAccount])
-> (Response (Maybe ByteString) -> [UserAccount])
-> Response (Maybe ByteString)
-> App [UserAccount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UserAccount] -> Maybe [UserAccount] -> [UserAccount]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [UserAccount] -> [UserAccount])
-> (Response (Maybe ByteString) -> Maybe [UserAccount])
-> Response (Maybe ByteString)
-> [UserAccount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (Maybe ByteString) -> Maybe [UserAccount]
forall a.
(HasCallStack, Typeable a, FromJSON a) =>
Response (Maybe ByteString) -> Maybe a
responseJsonMaybe (Response (Maybe ByteString) -> App [UserAccount])
-> Response (Maybe ByteString) -> App [UserAccount]
forall a b. (a -> b) -> a -> b
$ Response (Maybe ByteString)
resp

-- | Calls 'Brig.API.deleteUserNoAuthH'.
deleteUser :: UserId -> App ()
deleteUser :: UserId -> App ()
deleteUser UserId
uid = do
  App (Response (Maybe ByteString)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response (Maybe ByteString)) -> App ())
-> App (Response (Maybe ByteString)) -> App ()
forall a b. (a -> b) -> a -> b
$
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
DELETE
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"/i/users", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
uid]
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx

-- | Calls 'Brig.API.getContactListH'.
getContactList :: UserId -> App [UserId]
getContactList :: UserId -> App [UserId]
getContactList UserId
uid = do
  Response (Maybe ByteString)
r <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
GET
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"/i/users", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
uid, ByteString
"contacts"]
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  UserIds -> [UserId]
cUsers (UserIds -> [UserId]) -> App UserIds -> App [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LText -> Error) -> Response (Maybe ByteString) -> App UserIds
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, FromJSON a) =>
(LText -> e) -> Response (Maybe ByteString) -> m a
parseResponse (Status -> LText -> LText -> Error
mkError Status
status502 LText
"server-error") Response (Maybe ByteString)
r

-- | Calls 'Brig.API.Internal.getRichInfoMultiH'
getRichInfoMultiUser :: [UserId] -> App [(UserId, RichInfo)]
getRichInfoMultiUser :: [UserId] -> App [(UserId, RichInfo)]
getRichInfoMultiUser = ([UserId] -> App [(UserId, RichInfo)])
-> [UserId] -> App [(UserId, RichInfo)]
forall (m :: * -> *) key a.
(Monad m, Monoid a) =>
([key] -> m a) -> [key] -> m a
chunkify (([UserId] -> App [(UserId, RichInfo)])
 -> [UserId] -> App [(UserId, RichInfo)])
-> ([UserId] -> App [(UserId, RichInfo)])
-> [UserId]
-> App [(UserId, RichInfo)]
forall a b. (a -> b) -> a -> b
$ \[UserId]
uids -> do
  Response (Maybe ByteString)
resp <-
    IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request) -> App (Response (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
GET
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"/i/users/rich-info"]
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
queryItem ByteString
"ids" (List UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ([UserId] -> List UserId
forall a. [a] -> List a
List [UserId]
uids))
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  (LText -> Error)
-> Response (Maybe ByteString) -> App [(UserId, RichInfo)]
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, FromJSON a) =>
(LText -> e) -> Response (Maybe ByteString) -> m a
parseResponse (Status -> LText -> LText -> Error
mkError Status
status502 LText
"server-error: could not parse response to `GET brig:/i/users/rich-info`") Response (Maybe ByteString)
resp

getAccountConferenceCallingConfigClient :: (HasCallStack) => UserId -> App (Feature ConferenceCallingConfig)
getAccountConferenceCallingConfigClient :: HasCallStack => UserId -> App (Feature ConferenceCallingConfig)
getAccountConferenceCallingConfigClient UserId
uid =
  ClientM (Feature ConferenceCallingConfig)
-> App (Either ClientError (Feature ConferenceCallingConfig))
forall a. HasCallStack => ClientM a -> App (Either ClientError a)
runHereClientM (forall api (name :: Symbol) (m :: * -> *) endpoint.
(HasEndpoint api endpoint name, HasClient m endpoint) =>
Client m endpoint
namedClient @IAPI.API @"get-account-conference-calling-config" UserId
uid)
    App (Either ClientError (Feature ConferenceCallingConfig))
-> (Either ClientError (Feature ConferenceCallingConfig)
    -> App (Feature ConferenceCallingConfig))
-> App (Feature ConferenceCallingConfig)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ClientError (Feature ConferenceCallingConfig)
-> App (Feature ConferenceCallingConfig)
forall a. Either ClientError a -> App a
handleServantResp

updateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig -> App ()
updateSearchVisibilityInbound :: TeamStatus SearchVisibilityInboundConfig -> App ()
updateSearchVisibilityInbound =
  Either ClientError () -> App ()
forall a. Either ClientError a -> App a
handleServantResp
    (Either ClientError () -> App ())
-> (TeamStatus SearchVisibilityInboundConfig
    -> App (Either ClientError ()))
-> TeamStatus SearchVisibilityInboundConfig
-> App ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ClientM () -> App (Either ClientError ())
forall a. HasCallStack => ClientM a -> App (Either ClientError a)
runHereClientM
    (ClientM () -> App (Either ClientError ()))
-> (TeamStatus SearchVisibilityInboundConfig -> ClientM ())
-> TeamStatus SearchVisibilityInboundConfig
-> App (Either ClientError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall api (name :: Symbol) (m :: * -> *) endpoint.
(HasEndpoint api endpoint name, HasClient m endpoint) =>
Client m endpoint
namedClient @IAPI.API @"updateSearchVisibilityInbound"

runHereClientM :: (HasCallStack) => Client.ClientM a -> App (Either Client.ClientError a)
runHereClientM :: forall a. HasCallStack => ClientM a -> App (Either ClientError a)
runHereClientM ClientM a
action = do
  Manager
mgr <- Getting Manager Env Manager -> App Manager
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Manager Env Manager
Lens' Env Manager
manager
  Endpoint
brigep <- Getting Endpoint Env Endpoint -> App Endpoint
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Endpoint Env Endpoint
Lens' Env Endpoint
brig
  let env :: ClientEnv
env = Manager -> BaseUrl -> ClientEnv
Client.mkClientEnv Manager
mgr BaseUrl
baseurl
      baseurl :: BaseUrl
baseurl = Scheme -> String -> Int -> String -> BaseUrl
Client.BaseUrl Scheme
Client.Http (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Endpoint
brigep Endpoint -> Getting Text Endpoint Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Endpoint Text
Lens' Endpoint Text
host) (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Endpoint
brigep Endpoint -> Getting Word16 Endpoint Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 Endpoint Word16
Lens' Endpoint Word16
port) String
""
  IO (Either ClientError a) -> App (Either ClientError a)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError a) -> App (Either ClientError a))
-> IO (Either ClientError a) -> App (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
Client.runClientM ClientM a
action ClientEnv
env

handleServantResp ::
  Either Client.ClientError a ->
  App a
handleServantResp :: forall a. Either ClientError a -> App a
handleServantResp (Right a
cfg) = a -> App a
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
cfg
handleServantResp (Left ClientError
errmsg) = Error -> App a
forall e a. (HasCallStack, Exception e) => e -> App a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Error -> App a) -> (ClientError -> Error) -> ClientError -> App a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LText -> Error
internalErrorWithDescription (LText -> Error) -> (ClientError -> LText) -> ClientError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LText
Lazy.pack (String -> LText)
-> (ClientError -> String) -> ClientError -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> String
forall a. Show a => a -> String
show (ClientError -> App a) -> ClientError -> App a
forall a b. (a -> b) -> a -> b
$ ClientError
errmsg