module Galley.Intra.Client
( lookupClients,
lookupClientsFull,
notifyClientsAboutLegalHoldRequest,
addLegalHoldClientToUser,
removeLegalHoldClientFromUser,
getLegalHoldAuthToken,
getLocalMLSClients,
)
where
import Bilge hiding (getHeader, options, statusCode)
import Bilge.RPC
import Brig.Types.Intra
import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..))
import Data.ByteString.Conversion
import Data.Id
import Data.Misc
import Data.Qualified
import Data.Set qualified as Set
import Data.Text.Encoding
import Galley.API.Error
import Galley.Effects
import Galley.Env
import Galley.External.LegalHoldService.Types
import Galley.Intra.Util
import Galley.Monad
import Imports
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status
import Network.Wai.Utilities.Error hiding (Error)
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog qualified as P
import Servant.API
import System.Logger.Class qualified as Logger
import Wire.API.Error.Galley
import Wire.API.MLS.CipherSuite
import Wire.API.User.Auth.LegalHold
import Wire.API.User.Client
import Wire.API.User.Client.Prekey
lookupClients :: [UserId] -> App UserClients
lookupClients :: [UserId] -> App UserClients
lookupClients [UserId]
uids = 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/clients"
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserSet -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json (Set UserId -> UserSet
UserSet (Set UserId -> UserSet) -> Set UserId -> UserSet
forall a b. (a -> b) -> a -> b
$ [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList [UserId]
uids)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
UserClients
clients <- (LText -> Error) -> Response (Maybe ByteString) -> App UserClients
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
UserClients -> App UserClients
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserClients -> App UserClients) -> UserClients -> App UserClients
forall a b. (a -> b) -> a -> b
$ (Set ClientId -> Bool) -> UserClients -> UserClients
filterClients (Bool -> Bool
not (Bool -> Bool) -> (Set ClientId -> Bool) -> Set ClientId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ClientId -> Bool
forall a. Set a -> Bool
Set.null) UserClients
clients
lookupClientsFull ::
[UserId] ->
App UserClientsFull
lookupClientsFull :: [UserId] -> App UserClientsFull
lookupClientsFull [UserId]
uids = 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/clients/full"
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserSet -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json (Set UserId -> UserSet
UserSet (Set UserId -> UserSet) -> Set UserId -> UserSet
forall a b. (a -> b) -> a -> b
$ [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList [UserId]
uids)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
UserClientsFull
clients <- (LText -> Error)
-> Response (Maybe ByteString) -> App UserClientsFull
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
UserClientsFull -> App UserClientsFull
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserClientsFull -> App UserClientsFull)
-> UserClientsFull -> App UserClientsFull
forall a b. (a -> b) -> a -> b
$ (Set Client -> Bool) -> UserClientsFull -> UserClientsFull
filterClientsFull (Bool -> Bool
not (Bool -> Bool) -> (Set Client -> Bool) -> Set Client -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Client -> Bool
forall a. Set a -> Bool
Set.null) UserClientsFull
clients
notifyClientsAboutLegalHoldRequest ::
UserId ->
UserId ->
LastPrekey ->
App ()
notifyClientsAboutLegalHoldRequest :: UserId -> UserId -> LastPrekey -> App ()
notifyClientsAboutLegalHoldRequest UserId
requesterUid UserId
targetUid LastPrekey
lastPrekey' = do
App (Response (Maybe ByteString)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response (Maybe ByteString)) -> App ())
-> ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request)
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App ()) -> (Request -> Request) -> App ()
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
paths [ByteString
"i", ByteString
"clients", ByteString
"legalhold", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
targetUid, ByteString
"request"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalHoldClientRequest -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json (UserId -> LastPrekey -> LegalHoldClientRequest
LegalHoldClientRequest UserId
requesterUid LastPrekey
lastPrekey')
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
getLegalHoldAuthToken ::
( Member (Embed IO) r,
Member (Error InternalError) r,
Member P.TinyLog r,
Member (Input Env) r
) =>
UserId ->
Maybe PlainTextPassword6 ->
Sem r OpaqueAuthToken
getLegalHoldAuthToken :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error InternalError) r,
Member TinyLog r, Member (Input Env) r) =>
UserId -> Maybe PlainTextPassword6 -> Sem r OpaqueAuthToken
getLegalHoldAuthToken UserId
uid Maybe PlainTextPassword6
pw = do
Response (Maybe ByteString)
r <-
App (Response (Maybe ByteString))
-> Sem r (Response (Maybe ByteString))
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App (Response (Maybe ByteString))
-> Sem r (Response (Maybe ByteString)))
-> ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request)
-> Sem r (Response (Maybe ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> Sem r (Response (Maybe ByteString)))
-> (Request -> Request) -> Sem r (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/legalhold-login"
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
queryItem ByteString
"persist" ByteString
"true"
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalHoldLogin -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json (UserId
-> Maybe PlainTextPassword6 -> Maybe CookieLabel -> LegalHoldLogin
LegalHoldLogin UserId
uid Maybe PlainTextPassword6
pw Maybe CookieLabel
forall a. Maybe a
Nothing)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
case ByteString -> Response (Maybe ByteString) -> Maybe ByteString
forall a. ByteString -> Response a -> Maybe ByteString
getCookieValue ByteString
"zuid" Response (Maybe ByteString)
r of
Maybe ByteString
Nothing -> do
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall a. ToBytes a => a -> Msg -> Msg
Logger.msg @Text Text
"Response from login missing auth cookie"
InternalError -> Sem r OpaqueAuthToken
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (InternalError -> Sem r OpaqueAuthToken)
-> InternalError -> Sem r OpaqueAuthToken
forall a b. (a -> b) -> a -> b
$ LText -> InternalError
InternalErrorWithDescription LText
"internal error"
Just ByteString
c -> OpaqueAuthToken -> Sem r OpaqueAuthToken
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpaqueAuthToken -> Sem r OpaqueAuthToken)
-> (ByteString -> OpaqueAuthToken)
-> ByteString
-> Sem r OpaqueAuthToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OpaqueAuthToken
OpaqueAuthToken (Text -> OpaqueAuthToken)
-> (ByteString -> Text) -> ByteString -> OpaqueAuthToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Sem r OpaqueAuthToken)
-> ByteString -> Sem r OpaqueAuthToken
forall a b. (a -> b) -> a -> b
$ ByteString
c
addLegalHoldClientToUser ::
UserId ->
ConnId ->
[Prekey] ->
LastPrekey ->
App (Either AuthenticationError ClientId)
addLegalHoldClientToUser :: UserId
-> ConnId
-> [Prekey]
-> LastPrekey
-> App (Either AuthenticationError ClientId)
addLegalHoldClientToUser UserId
uid ConnId
connId [Prekey]
prekeys LastPrekey
lastPrekey' = do
(Client -> ClientId)
-> Either AuthenticationError Client
-> Either AuthenticationError ClientId
forall a b.
(a -> b)
-> Either AuthenticationError a -> Either AuthenticationError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Client -> ClientId
clientId (Either AuthenticationError Client
-> Either AuthenticationError ClientId)
-> App (Either AuthenticationError Client)
-> App (Either AuthenticationError ClientId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId
-> ConnId -> NewClient -> App (Either AuthenticationError Client)
brigAddClient UserId
uid ConnId
connId NewClient
lhClient
where
lhClient :: NewClient
lhClient =
[Prekey]
-> LastPrekey
-> ClientType
-> Maybe Text
-> Maybe ClientClass
-> Maybe CookieLabel
-> Maybe PlainTextPassword6
-> Maybe Text
-> Maybe ClientCapabilityList
-> MLSPublicKeys
-> Maybe Value
-> NewClient
NewClient
[Prekey]
prekeys
LastPrekey
lastPrekey'
ClientType
LegalHoldClientType
Maybe Text
forall a. Maybe a
Nothing
(ClientClass -> Maybe ClientClass
forall a. a -> Maybe a
Just ClientClass
LegalHoldClient)
Maybe CookieLabel
forall a. Maybe a
Nothing
Maybe PlainTextPassword6
forall a. Maybe a
Nothing
Maybe Text
forall a. Maybe a
Nothing
Maybe ClientCapabilityList
forall a. Maybe a
Nothing
MLSPublicKeys
forall a. Monoid a => a
mempty
Maybe Value
forall a. Maybe a
Nothing
removeLegalHoldClientFromUser ::
UserId ->
App ()
removeLegalHoldClientFromUser :: UserId -> App ()
removeLegalHoldClientFromUser UserId
targetUid = do
App (Response (Maybe ByteString)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response (Maybe ByteString)) -> App ())
-> ((Request -> Request) -> App (Response (Maybe ByteString)))
-> (Request -> Request)
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
Brig ((Request -> Request) -> App ()) -> (Request -> Request) -> App ()
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", ByteString
"clients", ByteString
"legalhold", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
targetUid]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
contentJson
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
brigAddClient :: UserId -> ConnId -> NewClient -> App (Either AuthenticationError Client)
brigAddClient :: UserId
-> ConnId -> NewClient -> App (Either AuthenticationError Client)
brigAddClient UserId
uid ConnId
connId NewClient
client = 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
. HeaderName -> ByteString -> Request -> Request
header HeaderName
"Z-Connection" (ConnId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ConnId
connId)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"i", ByteString
"clients", 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
contentJson
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewClient -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json NewClient
client
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Request -> Request
expectStatus ((Int -> [Int] -> Bool) -> [Int] -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Int
201, Int
403])
if Status -> Int
statusCode (Response (Maybe ByteString) -> Status
forall body. Response body -> Status
responseStatus Response (Maybe ByteString)
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
201
then Client -> Either AuthenticationError Client
forall a b. b -> Either a b
Right (Client -> Either AuthenticationError Client)
-> App Client -> App (Either AuthenticationError Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LText -> Error) -> Response (Maybe ByteString) -> App Client
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
else Either AuthenticationError Client
-> App (Either AuthenticationError Client)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticationError -> Either AuthenticationError Client
forall a b. a -> Either a b
Left AuthenticationError
ReAuthFailed)
getLocalMLSClients :: Local UserId -> CipherSuiteTag -> App (Set ClientInfo)
getLocalMLSClients :: Local UserId -> CipherSuiteTag -> App (Set ClientInfo)
getLocalMLSClients Local UserId
lusr CipherSuiteTag
suite =
IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call
IntraComponent
Brig
( 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",
ByteString
"mls",
ByteString
"clients",
UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
queryItem
ByteString
"ciphersuite"
(CipherSuite -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader (CipherSuiteTag -> CipherSuite
tagCipherSuite CipherSuiteTag
suite))
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
)
App (Response (Maybe ByteString))
-> (Response (Maybe ByteString) -> App (Set ClientInfo))
-> App (Set ClientInfo)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LText -> Error)
-> Response (Maybe ByteString) -> App (Set ClientInfo)
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")