{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 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 Test.MLS.Message where

import API.Galley
import API.Gundeck
import Data.Bits (shiftR)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import MLS.Util
import Notifications
import SetupHelpers
import Testlib.Prelude

-- @SF.Separation @TSFI.RESTfulAPI @S2
-- This test verifies whether a message actually gets sent all the way to
-- cannon.

testApplicationMessage :: (HasCallStack) => App ()
testApplicationMessage :: HasCallStack => App ()
testApplicationMessage = do
  -- Test happy case of federated MLS message sending in both directions.

  -- local alice and alex, remote bob
  [alice, alex, bob, betty] <-
    [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers
      [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  for_ [alex, bob, betty] $ \Value
user -> Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
user

  clients@[alice1, _alice2, alex1, _alex2, bob1, _bob2, _, _] <-
    traverse
      (createMLSClient def)
      [alice, alice, alex, alex, bob, bob, betty, betty]
  traverse_ (uploadNewKeyPackage def) clients
  convId <- createNewGroup def alice1

  withWebSockets [alice, alex, bob, betty] $ \[WebSocket]
wss -> do
    -- alice adds all other users (including her own client)
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
alice, Value
alex, Value
bob, Value
betty] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif) [WebSocket]
wss

    -- alex sends a message
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alex1 String
"hello" App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss

    -- bob sends a message
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
bob1 String
"hey" App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss

-- @END

testAppMessageSomeReachable :: (HasCallStack) => App ()
testAppMessageSomeReachable :: HasCallStack => App ()
testAppMessageSomeReachable = do
  (alice1, convId) <- [ServiceOverrides]
-> ([String] -> App (ClientIdentity, ConvId))
-> App (ClientIdentity, ConvId)
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Monoid a => a
mempty] (([String] -> App (ClientIdentity, ConvId))
 -> App (ClientIdentity, ConvId))
-> ([String] -> App (ClientIdentity, ConvId))
-> App (ClientIdentity, ConvId)
forall a b. (a -> b) -> a -> b
$ \[String
thirdDomain] -> do
    ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    otherDomain <- make OtherDomain & asString
    [alice, bob, charlie] <- createAndConnectUsers [ownDomain, otherDomain, thirdDomain]

    [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
    traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
    convId <- createNewGroup def alice1
    void $ withWebSocket charlie $ \WebSocket
ws -> do
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
      HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
ws
    pure (alice1, convId)

  -- charlie isn't able to receive this message, so we make sure we can post it
  -- successfully, but not attempt to consume it
  mp <- createApplicationMessage convId alice1 "hi, bob!"
  void $ postMLSMessage mp.sender mp.message >>= getJSON 201

testTargetedMessageFederatedRecipient :: (HasCallStack) => App ()
testTargetedMessageFederatedRecipient :: HasCallStack => App ()
testTargetedMessageFederatedRecipient = do
  ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  remoteDomain <- make OtherDomain & asString
  [alice, bob, charlie] <- createAndConnectUsers [ownDomain, remoteDomain, remoteDomain]

  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    targeted <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"federated targeted hello"
    postMLSTargetedMessage targeted.sender targeted.message >>= assertStatus 201

    notification <- awaitMatch isNewMLSTargetedMessageNotif bobWs
    event <- notification %. "payload.0"
    event %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    event %. "from" `shouldMatch` targeted.sender.user
    event %. "data" `shouldMatch` (B8.unpack (Base64.encode targeted.message))

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif charlieWs

testTargetedMessageFederatedSender :: (HasCallStack) => App ()
testTargetedMessageFederatedSender :: HasCallStack => App ()
testTargetedMessageFederatedSender = do
  ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  remoteDomain <- make OtherDomain & asString
  [alice, bob, charlie, david] <- createAndConnectUsers [ownDomain, ownDomain, remoteDomain, remoteDomain]

  [alice1, bob1, charlie1, david1] <- traverse (createMLSClient def) [alice, bob, charlie, david]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1, david1]
  convId <- createNewGroup def alice1

  withWebSockets [alice, bob, charlie, david] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs, WebSocket
davidWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie, Value
david] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif) [WebSocket
bobWs, WebSocket
charlieWs, WebSocket
davidWs]

    targetedToLocal <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
charlie1 ClientIdentity
bob1 String
"targeted from remote to local"
    postMLSTargetedMessage targetedToLocal.sender targetedToLocal.message >>= assertStatus 201
    localNotification <- awaitMatch isNewMLSTargetedMessageNotif bobWs
    localEvent <- localNotification %. "payload.0"
    localEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    localEvent %. "from" `shouldMatch` targetedToLocal.sender.user
    localEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode targetedToLocal.message))
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif charlieWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif davidWs

    targetedToRemote <- createTargetedMessage convId charlie1 david1 "targeted from remote to remote"
    postMLSTargetedMessage targetedToRemote.sender targetedToRemote.message >>= assertStatus 201
    remoteNotification <- awaitMatch isNewMLSTargetedMessageNotif davidWs
    remoteEvent <- remoteNotification %. "payload.0"
    remoteEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    remoteEvent %. "from" `shouldMatch` targetedToRemote.sender.user
    remoteEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode targetedToRemote.message))
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif bobWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif charlieWs

testMessageNotifications :: (HasCallStack) => Domain -> App ()
testMessageNotifications :: HasCallStack => Domain -> App ()
testMessageNotifications Domain
bobDomain = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
bobDomain]

  [alice1, alice2, bob1, bob2] <- traverse (createMLSClient def) [alice, alice, bob, bob]
  bobClient <- bob1 %. "client_id" & asString

  traverse_ (uploadNewKeyPackage def) [alice1, alice2, bob1, bob2]

  convId <- createNewGroup def alice1

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
alice, Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
ws

  let get (GetNotifications
opts :: GetNotifications) = do
        notifs <- Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
bob GetNotifications
opts {size = Just 10000} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
        notifs %. "has_more" `shouldMatch` False
        length <$> (notifs %. "notifications" & asList)

  numNotifs <- get def
  numNotifsClient <- get def {client = Just bobClient}

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alice1 String
"hi bob" App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
    HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isNewMLSMessageNotif WebSocket
ws

  get def `shouldMatchInt` (numNotifs + 1)
  get def {client = Just bobClient} `shouldMatchInt` (numNotifsClient + 1)

testMultipleMessages :: (HasCallStack) => App ()
testMultipleMessages :: HasCallStack => App ()
testMultipleMessages = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  withWebSockets [bob] $ \[WebSocket]
wss -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif) [WebSocket]
wss

    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alice1 String
"hello" App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss

    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alice1 String
"world" App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss

testTargetedMessage :: (HasCallStack) => App ()
testTargetedMessage :: HasCallStack => App ()
testTargetedMessage = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    targeted <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"targeted hello"
    postMLSTargetedMessage targeted.sender targeted.message >>= assertStatus 201

    notification <- awaitMatch isNewMLSTargetedMessageNotif bobWs
    event <- notification %. "payload.0"
    event %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    event %. "from" `shouldMatch` targeted.sender.user
    event %. "data" `shouldMatch` (B8.unpack (Base64.encode targeted.message))

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif charlieWs

testTargetedMessageNotificationSync :: (HasCallStack) => App ()
testTargetedMessageNotificationSync :: HasCallStack => App ()
testTargetedMessageNotificationSync = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  bobClient <- bob1 %. "client_id" & asString
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle

  targeted <- createTargetedMessage convId alice1 bob1 "targeted message notification sync"
  postMLSTargetedMessage targeted.sender targeted.message >>= assertStatus 201

  -- The recipient has no websocket open while the message is sent. It must be
  -- available later through the persistent notification sync endpoint.
  notification <- awaitNotificationClient bob bobClient noValue isNewMLSTargetedMessageNotif
  event <- notification %. "payload.0"
  event %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
  event %. "from" `shouldMatch` targeted.sender.user
  event %. "data" `shouldMatch` (B8.unpack (Base64.encode targeted.message))

testTransientTargetedMessage :: (HasCallStack) => App ()
testTransientTargetedMessage :: HasCallStack => App ()
testTransientTargetedMessage = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    targeted <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTransientTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"transient targeted hello"
    postMLSTransientTargetedMessage targeted.sender targeted.message `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])

    notification <- awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    event <- notification %. "payload.0"
    event %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    event %. "from" `shouldMatch` targeted.sender.user
    event %. "data" `shouldMatch` (B8.unpack (Base64.encode targeted.message))

    assertNoNotifications bob bob1.client Nothing isNewMLSTransientTargetedMessageNotif

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs

testTransientTargetedMessageOfflineRecipient :: (HasCallStack) => App ()
testTransientTargetedMessageOfflineRecipient :: HasCallStack => App ()
testTransientTargetedMessageOfflineRecipient = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle
  targeted <- createTransientTargetedMessage convId alice1 bob1 "transient to offline recipient"
  postMLSTransientTargetedMessage targeted.sender targeted.message >>= assertStatus 201

  -- With no websocket connected, the transient message must not be available
  -- from notification sync either.
  assertNoNotifications bob bob1 Nothing isNewMLSTransientTargetedMessageNotif

testTransientTargetedMessageBatch :: (HasCallStack) => App ()
testTransientTargetedMessageBatch :: HasCallStack => App ()
testTransientTargetedMessageBatch = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    bobMessage <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTransientTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"transient hello bob"
    charlieMessage <- createTransientTargetedMessage convId alice1 charlie1 "transient hello charlie"
    postMLSTransientTargetedMessage alice1 (bobMessage.message <> charlieMessage.message) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])

    bobNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    bobEvent <- bobNotification %. "payload.0"
    bobEvent %. "from" `shouldMatch` alice1.user
    bobEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode bobMessage.message))

    charlieNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs
    charlieEvent <- charlieNotification %. "payload.0"
    charlieEvent %. "from" `shouldMatch` alice1.user
    charlieEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode charlieMessage.message))

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs

testTransientTargetedMessageBatchIsAtomic :: (HasCallStack) => App ()
testTransientTargetedMessageBatchIsAtomic :: HasCallStack => App ()
testTransientTargetedMessageBatchIsAtomic = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    valid <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTransientTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"valid first message"
    invalid <- createTransientTargetedMessage convId alice1 charlie1 "invalid later message"
    let invalidRecipient = ByteString -> Word32 -> ByteString
replaceTargetedRecipient MessagePackage
invalid.message Word32
99
    postMLSTransientTargetedMessage alice1 (valid.message <> invalidRecipient) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-invalid-leaf-node-index"

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs

testTransientTargetedMessageFederatedRecipients :: (HasCallStack) => App ()
testTransientTargetedMessageFederatedRecipients :: HasCallStack => App ()
testTransientTargetedMessageFederatedRecipients = do
  ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  remoteDomain <- make OtherDomain & asString
  [alice, bob, charlie, david] <- createAndConnectUsers [ownDomain, remoteDomain, remoteDomain, remoteDomain]

  [alice1, bob1, charlie1, david1] <- traverse (createMLSClient def) [alice, bob, charlie, david]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1, david1]
  convId <- createNewGroup def alice1

  withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie, Value
david] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    bobMessage <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTransientTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"federated transient hello bob"
    charlieMessage <- createTransientTargetedMessage convId alice1 charlie1 "federated transient hello charlie"
    postMLSTransientTargetedMessage alice1 (bobMessage.message <> charlieMessage.message) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])

    bobNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    bobEvent <- bobNotification %. "payload.0"
    bobEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    bobEvent %. "from" `shouldMatch` alice1.user
    bobEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode bobMessage.message))

    charlieNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs
    charlieEvent <- charlieNotification %. "payload.0"
    charlieEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    charlieEvent %. "from" `shouldMatch` alice1.user
    charlieEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode charlieMessage.message))

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs

  -- David has no websocket. A transient message forwarded to his backend
  -- must not become available from that backend's notification sync endpoint.
  davidMessage <- createTransientTargetedMessage convId alice1 david1 "federated transient offline"
  postMLSTransientTargetedMessage alice1 davidMessage.message >>= assertStatus 201
  assertNoNotifications david david1.client Nothing isNewMLSTransientTargetedMessageNotif

testTransientTargetedMessageFederatedSender :: (HasCallStack) => App ()
testTransientTargetedMessageFederatedSender :: HasCallStack => App ()
testTransientTargetedMessageFederatedSender = do
  ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  remoteDomain <- make OtherDomain & asString
  [alice, bob, charlie, david] <- createAndConnectUsers [ownDomain, ownDomain, remoteDomain, remoteDomain]

  [alice1, bob1, charlie1, david1] <- traverse (createMLSClient def) [alice, bob, charlie, david]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1, david1]
  convId <- createNewGroup def alice1

  withWebSockets [alice, bob, charlie, david] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs, WebSocket
davidWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie, Value
david] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    (WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif) [WebSocket
bobWs, WebSocket
charlieWs, WebSocket
davidWs]

    transientToLocal <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTransientTargetedMessage ConvId
convId ClientIdentity
charlie1 ClientIdentity
bob1 String
"transient from remote to local"
    postMLSTransientTargetedMessage transientToLocal.sender transientToLocal.message `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    localNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    localEvent <- localNotification %. "payload.0"
    localEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    localEvent %. "from" `shouldMatch` charlie1.user
    localEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode transientToLocal.message))
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif davidWs

    transientToRemote <- createTransientTargetedMessage convId charlie1 david1 "transient from remote to remote"
    postMLSTransientTargetedMessage transientToRemote.sender transientToRemote.message `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    remoteNotification <- awaitMatch isNewMLSTransientTargetedMessageNotif davidWs
    remoteEvent <- remoteNotification %. "payload.0"
    remoteEvent %. "qualified_conversation" `shouldMatch` convIdToQidObject convId
    remoteEvent %. "from" `shouldMatch` charlie1.user
    remoteEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode transientToRemote.message))
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif aliceWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif charlieWs

    validFirst <- createTransientTargetedMessage convId charlie1 bob1 "valid federated batch item"
    invalidLater <- createTransientTargetedMessage convId charlie1 david1 "invalid federated batch item"
    let invalidBatchItem = ByteString -> Word32 -> ByteString
replaceTargetedRecipient MessagePackage
invalidLater.message Word32
99
    postMLSTransientTargetedMessage charlie1 (validFirst.message <> invalidBatchItem) `bindResponse` \Response
resp -> do
      -- The conversation owner rejects the invalid leaf index with 400, but
      -- this request crosses federation, whose remote-error wrapper is 533.
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"federation-remote-error"
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"inner.label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-invalid-leaf-node-index"
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif bobWs
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTransientTargetedMessageNotif davidWs

testTargetedMessageBatch :: (HasCallStack) => App ()
testTargetedMessageBatch :: HasCallStack => App ()
testTargetedMessageBatch = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1, charlie1]
  convId <- createNewGroup def alice1

  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket
aliceWs, WebSocket
bobWs, WebSocket
charlieWs] -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob, Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
charlieWs

    bobMessage <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"targeted hello bob"
    charlieMessage <- createTargetedMessage convId alice1 charlie1 "targeted hello charlie"
    postMLSTargetedMessage alice1 (bobMessage.message <> charlieMessage.message) >>= assertStatus 201

    bobNotification <- awaitMatch isNewMLSTargetedMessageNotif bobWs
    bobEvent <- bobNotification %. "payload.0"
    bobEvent %. "from" `shouldMatch` alice1.user
    bobEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode bobMessage.message))

    charlieNotification <- awaitMatch isNewMLSTargetedMessageNotif charlieWs
    charlieEvent <- charlieNotification %. "payload.0"
    charlieEvent %. "from" `shouldMatch` alice1.user
    charlieEvent %. "data" `shouldMatch` (B8.unpack (Base64.encode charlieMessage.message))

    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif aliceWs

testTargetedMessageRejectsUnauthorizedSender :: (HasCallStack) => App ()
testTargetedMessageRejectsUnauthorizedSender :: HasCallStack => App ()
testTargetedMessageRejectsUnauthorizedSender = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
ws

    targeted <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"unauthorized sender"
    postMLSTargetedMessage bob1 targeted.message `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-client-sender-user-mismatch"
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif ws

testTargetedMessageRejectsInvalidRecipient :: (HasCallStack) => App ()
testTargetedMessageRejectsInvalidRecipient :: HasCallStack => App ()
testTargetedMessageRejectsInvalidRecipient = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
ws

    targeted <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"invalid recipient"
    let invalidRecipient = ByteString -> Word32 -> ByteString
replaceTargetedRecipient MessagePackage
targeted.message Word32
99
    postMLSTargetedMessage alice1 invalidRecipient `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-invalid-leaf-node-index"
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif ws

testTargetedMessageRejectsDuplicateRecipient :: (HasCallStack) => App ()
testTargetedMessageRejectsDuplicateRecipient :: HasCallStack => App ()
testTargetedMessageRejectsDuplicateRecipient = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  convId <- createNewGroup def alice1

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
ws

    first <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
convId ClientIdentity
alice1 ClientIdentity
bob1 String
"duplicate recipient one"
    second <- createTargetedMessage convId alice1 bob1 "duplicate recipient two"
    postMLSTargetedMessage alice1 (first.message <> second.message) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif ws

testTargetedMessageRejectsCrossGroupBatch :: (HasCallStack) => App ()
testTargetedMessageRejectsCrossGroupBatch :: HasCallStack => App ()
testTargetedMessageRejectsCrossGroupBatch = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]
  void $ uploadNewKeyPackage def bob1
  firstConvId <- createNewGroup def alice1
  secondConvId <- createNewGroup def alice1

  void $ withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
firstConvId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
secondConvId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

    first <- HasCallStack =>
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
ConvId
-> ClientIdentity -> ClientIdentity -> String -> App MessagePackage
createTargetedMessage ConvId
firstConvId ClientIdentity
alice1 ClientIdentity
bob1 String
"first group"
    second <- createTargetedMessage secondConvId alice1 bob1 "second group"
    postMLSTargetedMessage alice1 (first.message <> second.message) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"
    expectFailure (const (pure ())) $ awaitMatch isNewMLSTargetedMessageNotif ws

-- Replace the four-byte, big-endian recipient field at offset 12. The
-- signature is deliberately left unchanged: this test exercises the
-- server's leaf-index validation before any cryptographic verification.
replaceTargetedRecipient :: ByteString -> Word32 -> ByteString
replaceTargetedRecipient :: ByteString -> Word32 -> ByteString
replaceTargetedRecipient ByteString
message Word32
recipient =
  Int -> ByteString -> ByteString
BS.take Int
12 ByteString
message
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack
      [ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
recipient Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24),
        Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
recipient Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16),
        Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
recipient Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8),
        Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
recipient
      ]
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
16 ByteString
message