-- 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.AccessUpdate where

import API.Brig
import API.Galley
import Control.Monad.Codensity
import Control.Monad.Reader
import GHC.Stack
import MLS.Util
import Notifications
import SetupHelpers
import Testlib.Prelude
import Testlib.ResourcePool

-- These two commented out tests exist to test the Setup.hs code.
-- Both of these tests should not appear in the output.

-- testBar :: HasCallStack => App ()
-- testBar = pure ()

{-
testBaz :: HasCallStack => App ()
testBaz = pure ()
-}

data ConversationProtocol
  = ConversationProtocolProteus
  | ConversationProtocolMLS

instance TestCases ConversationProtocol where
  mkTestCases :: IO [TestCase ConversationProtocol]
mkTestCases =
    [TestCase ConversationProtocol]
-> IO [TestCase ConversationProtocol]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> ConversationProtocol -> TestCase ConversationProtocol
forall a. String -> a -> TestCase a
MkTestCase String
"[proto=proteus]" ConversationProtocol
ConversationProtocolProteus,
        String -> ConversationProtocol -> TestCase ConversationProtocol
forall a. String -> a -> TestCase a
MkTestCase String
"[proto=mls]" ConversationProtocol
ConversationProtocolMLS
      ]

-- | @SF.Federation @SF.Separation @TSFI.RESTfulAPI @S2
--
-- The test asserts that, among others, remote users are removed from a
-- conversation when an access update occurs that disallows guests from
-- accessing.
testAccessUpdateGuestRemoved :: (HasCallStack) => ConversationProtocol -> App ()
testAccessUpdateGuestRemoved :: HasCallStack => ConversationProtocol -> App ()
testAccessUpdateGuestRemoved ConversationProtocol
proto = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
dee <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OtherDomain CreateUser
forall a. Default a => a
def
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice) [Value
charlie, Value
dee]

  (Value
conv, [String
aliceClient, String
bobClient, String
charlieClient, String
deeClient]) <- case ConversationProtocol
proto of
    ConversationProtocol
ConversationProtocolProteus -> do
      [String]
clients <-
        (Value -> App String) -> [Value] -> App [String]
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
          (\Value
user -> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
user AddClient
forall a. Default a => a
def) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201)
          [Value
alice, Value
bob, Value
charlie, Value
dee]
      Value
conv <-
        Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
          Value
alice
          CreateConv
defProteus
            { qualifiedUsers = [bob, charlie, dee],
              team = Just tid
            }
          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
201
      (Value, [String]) -> App (Value, [String])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
conv, [String]
clients)
    ConversationProtocol
ConversationProtocolMLS -> do
      ClientIdentity
alice1 <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
alice
      [ClientIdentity]
clients <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
bob, Value
charlie, Value
dee]
      (ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity]
clients

      Value
conv <- ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
alice1 CreateConv
defMLS {team = Just tid} 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
201
      ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
      Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId

      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
dee] 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
      Value
convQid <- Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
      (Value, [String]) -> App (Value, [String])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
convQid, (ClientIdentity -> String) -> [ClientIdentity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (.client) (ClientIdentity
alice1 ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: [ClientIdentity]
clients))

  let update :: [Pair]
update = [String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]), String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"team_member"]]
  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
$ Value -> Value -> [Pair] -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess Value
alice Value
conv [Pair]
update 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

  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
alice String
aliceClient) [Value
charlie, Value
dee]
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
bob String
bobClient) [Value
charlie, Value
dee]
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
charlie String
charlieClient) [Value
charlie, Value
dee]
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
dee String
deeClient) [Value
charlie, Value
dee]

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
bob

-- @END

testAccessUpdateGuestRemovedUnreachableRemotes :: (HasCallStack) => App ()
testAccessUpdateGuestRemovedUnreachableRemotes :: HasCallStack => App ()
testAccessUpdateGuestRemovedUnreachableRemotes = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
charlie
  [String
aliceClient, String
bobClient, String
charlieClient] <-
    (Value -> App String) -> [Value] -> App [String]
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
      (\Value
user -> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
user AddClient
forall a. Default a => a
def) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201)
      [Value
alice, Value
bob, Value
charlie]
  (Value
conv, Value
dee) <- Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App (Value, Value)) -> App (Value, Value))
-> ([BackendResource] -> App (Value, Value)) -> App (Value, Value)
forall a b. (a -> b) -> a -> b
$ \[BackendResource
dynBackend] ->
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
dynBackend ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App (Value, Value)) -> App (Value, Value))
-> (String -> App (Value, Value)) -> App (Value, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
dee <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser BackendResource
dynBackend.berDomain CreateUser
forall a. Default a => a
def
      Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
dee
      Value
conv <-
        Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
          Value
alice
          ( CreateConv
defProteus
              { qualifiedUsers = [bob, charlie, dee],
                team = Just tid
              }
          )
          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
201
      (Value, Value) -> App (Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
conv, Value
dee)

  let update :: [Pair]
update = [String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]), String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"team_member"]]
  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
$ Value -> Value -> [Pair] -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess Value
alice Value
conv [Pair]
update 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

  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
alice String
aliceClient) [Value
charlie, Value
dee]
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
bob String
bobClient) [Value
charlie, Value
dee]
  (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
alice Value
conv Value
charlie String
charlieClient) [Value
charlie, Value
dee]

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
bob

testAccessUpdateWithRemotes :: (HasCallStack) => App ()
testAccessUpdateWithRemotes :: HasCallStack => App ()
testAccessUpdateWithRemotes = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OwnDomain]
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
charlie
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob, charlie]})
      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
201
  let update_access_value :: [String]
update_access_value = [String
"code"]
      update_access_role_value :: [String]
update_access_role_value = [String
"team_member", String
"non_team_member", String
"guest", String
"service"]
      update :: [Pair]
update = [String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String]
update_access_value, String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String]
update_access_role_value]
  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob, Value
charlie] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
$ Value -> Value -> [Pair] -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess Value
alice Value
conv [Pair]
update 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
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      Value
notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall n. (HasCallStack, MakesValue n) => n -> App Bool
isConvAccessUpdateNotif WebSocket
ws
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
conv
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.access" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String]
update_access_value
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.access_role_v2" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String]
update_access_role_value