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

module Test.Events where

import API.Brig
import API.BrigCommon
import API.Common
import API.Galley
import API.Gundeck
import qualified API.GundeckInternal as GundeckInternal
import qualified Control.Concurrent.Timeout as Timeout
import Control.Lens ((.~), (^?!))
import Control.Monad.Codensity
import Control.Monad.RWS (asks)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Control.Retry
import Data.ByteString.Conversion (toByteString')
import qualified Data.ProtoLens as Proto
import Data.ProtoLens.Labels ()
import Data.Proxy (Proxy (..))
import qualified Data.Text as Text
import Data.Timeout
import Network.AMQP.Extended
import Network.RabbitMqAdmin
import qualified Network.WebSockets as WS
import Notifications
import Numeric.Lens
import qualified Proto.Otr as Proto
import qualified Proto.Otr_Fields as Proto
import Servant.API (AsApi, ToServant, toServant)
import Servant.API.Generic (fromServant)
import Servant.Client (AsClientT)
import qualified Servant.Client as Servant
import SetupHelpers
import Testlib.Prelude
import Testlib.ResourcePool
import UnliftIO hiding (handle)

testConsumeEventsOneWebSocket :: (HasCallStack) => App ()
testConsumeEventsOneWebSocket :: HasCallStack => App ()
testConsumeEventsOneWebSocket = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  Response
lastNotifResp <-
    RetryPolicyM App
-> (RetryStatus -> Response -> App Bool)
-> (RetryStatus -> App Response)
-> App Response
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
      (Int -> RetryPolicyM App
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
10_000 RetryPolicyM App -> RetryPolicyM App -> RetryPolicyM App
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
10)
      (\RetryStatus
_ Response
resp -> Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> App Bool) -> Bool -> App Bool
forall a b. (a -> b) -> a -> b
$ Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
404)
      (\RetryStatus
_ -> Value -> GetNotification -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotification -> App Response
getLastNotification Value
alice GetNotification
forall a. Default a => a
def)
  String
lastNotifId <- Response
lastNotifResp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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

  Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    Value
deliveryTag <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

    String
handle <- App String
randomHandle
    Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
alice String
handle App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle

  -- No new notifications should be stored in Cassandra as the user doesn't have
  -- any legacy clients
  Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
alice GetNotifications
forall a. Default a => a
def {since = Just lastNotifId} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications"

testWebSocketTimeout :: (HasCallStack) => App ()
testWebSocketTimeout :: HasCallStack => App ()
testWebSocketTimeout = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ServiceOverrides
forall a. Default a => a
def
    { cannonCfg =
        setField "wsOpts.activityTimeout" (1000000 :: Int)
          >=> setField "wsOpts.pongTimeout" (1000000 :: Int)
    }
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      Value
deliveryTag <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
      HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False

      Maybe ()
result <- Int -> App () -> App (Maybe ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
2500000 (EventWebSocket -> App ()
killWebSocketClient EventWebSocket
ws)
      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ()
result)
        (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected web socket timeout"

testConsumeTempEvents :: (HasCallStack) => App ()
testConsumeTempEvents :: HasCallStack => App ()
testConsumeTempEvents = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  Value
client0 <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
clientId0 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client0

  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    EventWebSocket
ws0 <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId0)

    -- Ensure there is no race between event for this client being pushed and temp
    -- consumer being created
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ do
      EventWebSocket -> String -> App ()
expectAndAckNewClientEvent EventWebSocket
ws0 String
clientId0
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws0

    EventWebSocket
wsTemp <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice Maybe String
forall a. Maybe a
Nothing

    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ do
      Value
client1 <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
      String
clientId1 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client1

      -- Temp client gets this event as it happens after temp client has started
      -- listening
      App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> String -> App ()
expectAndAckNewClientEvent EventWebSocket
wsTemp String
clientId1

      -- Client0 should also be notified even if there is a temp client
      App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> String -> App ()
expectAndAckNewClientEvent EventWebSocket
ws0 String
clientId1

      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
wsTemp
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws0
  where
    expectAndAckNewClientEvent :: EventWebSocket -> String -> App ()
    expectAndAckNewClientEvent :: EventWebSocket -> String -> App ()
expectAndAckNewClientEvent EventWebSocket
ws String
cid =
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
cid

        HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

testTemporaryQueuesAreDeletedAfterUse :: (HasCallStack) => App ()
testTemporaryQueuesAreDeletedAfterUse :: HasCallStack => App ()
testTemporaryQueuesAreDeletedAfterUse = do
  [ServiceOverrides] -> ([BackendResource] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([BackendResource] -> App a) -> App a
startDynamicBackendsReturnResources [ServiceOverrides
forall a. Default a => a
def] (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
beResource] -> do
    let domain :: String
domain = BackendResource
beResource.berDomain
    AdminAPI (AsClientT App)
rabbitmqAdmin <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
beResource
    [Value
alice, Value
bob] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain]

    -- Create client for alice, so their temp websocket works
    Value
aliceClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
aliceId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id"
    String
aliceClientId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
aliceClient Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

    let aliceClientQueueName :: String
aliceClientQueueName = String
"user-notifications." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
aliceId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
aliceClientId
        aliceClientQueue :: Queue
aliceClientQueue = Queue {name :: VHost
name = String -> VHost
forall a. IsString a => String -> a
fromString String
aliceClientQueueName, vhost :: VHost
vhost = String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost}
        deadNotifsQueue :: Queue
deadNotifsQueue = Queue {name :: VHost
name = String -> VHost
forall a. IsString a => String -> a
fromString String
"dead-user-notifications", vhost :: VHost
vhost = String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost}
        cellsEventsQueue :: Queue
cellsEventsQueue = Queue {name :: VHost
name = String -> VHost
forall a. IsString a => String -> a
fromString String
"cells_events", vhost :: VHost
vhost = String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost}

    -- Wait for queue for the new client to be created
    App () -> App ()
forall a. App a -> App a
eventually (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Page Queue
queuesBeforeWS <- AdminAPI (AsClientT App)
rabbitmqAdmin.listQueuesByVHost (String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost) (String -> VHost
forall a. IsString a => String -> a
fromString String
"") Bool
True Int
100 Int
1
      Page Queue
queuesBeforeWS.items [Queue] -> [Queue] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Queue
deadNotifsQueue, Queue
cellsEventsQueue, Queue
aliceClientQueue]

    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice Maybe String
forall a. Maybe a
Nothing) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      String
handle <- App String
randomHandle
      Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
bob String
handle App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

      Page Queue
queuesDuringWS <- AdminAPI (AsClientT App)
rabbitmqAdmin.listQueuesByVHost (String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost) (String -> VHost
forall a. IsString a => String -> a
fromString String
"") Bool
True Int
100 Int
1
      String -> Page Queue -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"queuesDuringWS" Page Queue
queuesDuringWS (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
        [Queue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Page Queue
queuesDuringWS.items Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
4

      -- We cannot use 'assertEvent' here because there is a race between the temp
      -- queue being created and rabbitmq fanning out the previous events.
      App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle

        HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

    App () -> App ()
forall a. App a -> App a
eventually (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Page Queue
queuesAfterWS <- AdminAPI (AsClientT App)
rabbitmqAdmin.listQueuesByVHost (String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost) (String -> VHost
forall a. IsString a => String -> a
fromString String
"") Bool
True Int
100 Int
1
      Page Queue
queuesAfterWS.items [Queue] -> [Queue] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Queue
deadNotifsQueue, Queue
cellsEventsQueue, Queue
aliceClientQueue]

testSendMessageNoReturnToSenderWithConsumableNotificationsProteus :: (HasCallStack) => App ()
testSendMessageNoReturnToSenderWithConsumableNotificationsProteus :: HasCallStack => App ()
testSendMessageNoReturnToSenderWithConsumableNotificationsProteus = do
  (Value
alice, String
tid, Value
bob : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
aliceOldClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def 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
aliceClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
aliceClientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
aliceClient
  Value
bobClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
bobClientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bobClient
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid, qualifiedUsers = [bob]} 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
  QualifiedUserEntry
msg <- Value -> [(Value, [Value])] -> String -> App QualifiedUserEntry
forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
 MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients Value
alice [(Value
bob, [Value
bobClient]), (Value
alice, [Value
aliceOldClient])] String
"hello, bob"

  let protoMsg :: QualifiedNewOtrMessage
protoMsg =
        forall msg. Message msg => msg
Proto.defMessage @Proto.QualifiedNewOtrMessage
          QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& (ClientId -> Identity ClientId)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage
#sender ((ClientId -> Identity ClientId)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> ((Word64 -> Identity Word64) -> ClientId -> Identity ClientId)
-> (Word64 -> Identity Word64)
-> QualifiedNewOtrMessage
-> Identity QualifiedNewOtrMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64) -> ClientId -> Identity ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.client ((Word64 -> Identity Word64)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> Word64 -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
aliceClientId String -> Getting (Endo Word64) String Word64 -> Word64
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Word64) String Word64
forall a. Integral a => Prism' String a
Prism' String Word64
hex)
          QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
#recipients ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
-> [QualifiedUserEntry]
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [QualifiedUserEntry
msg]
          QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
#reportAll ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
-> ClientMismatchStrategy'ReportAll
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientMismatchStrategy'ReportAll
forall msg. Message msg => msg
Proto.defMessage
  Value -> Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
alice Value
conv QualifiedNewOtrMessage
protoMsg App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
bob (String -> Maybe String
forall a. a -> Maybe a
Just String
bobClientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.otr-message-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.data.text" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchBase64` String
"hello, bob"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
aliceClientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.create"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testEventsForSpecificClients :: (HasCallStack) => App ()
testEventsForSpecificClients :: HasCallStack => App ()
testEventsForSpecificClients = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  String
uid <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice
  Value
client1 <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
cid1 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client1
  Value
client2 <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def 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
  String
cid2 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client2

  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    EventWebSocket
ws1 <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid1)
    EventWebSocket
wsTemp <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice Maybe String
forall a. Maybe a
Nothing
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ 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
$ EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws1

      let eventForClient1 :: Value
eventForClient1 =
            [Pair] -> Value
object
              [ String
"recipients" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid, String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
cid1], String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"]],
                String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"hello" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"client1"]]
              ]
          eventForClient2 :: Value
eventForClient2 =
            [Pair] -> Value
object
              [ String
"recipients" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid, String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
cid2], String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"]],
                String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"hello" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"client2"]]
              ]

      Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [Value
eventForClient1, Value
eventForClient2] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws1 ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e ->
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.hello" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"client1"

      String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext String
"client 1 should not get any events meant for client 2"
        (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws1

      String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext String
"temp client should not get any events meant solely for client 1 or 2"
        (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
wsTemp

testConsumeEventsForDifferentUsers :: (HasCallStack) => App ()
testConsumeEventsForDifferentUsers :: HasCallStack => App ()
testConsumeEventsForDifferentUsers = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  Value
aliceClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
aliceClientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
aliceClient

  Value
bobClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
bobClientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bobClient

  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    EventWebSocket
aliceWS <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
aliceClientId)
    EventWebSocket
bobWS <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
bob (String -> Maybe String
forall a. a -> Maybe a
Just String
bobClientId)
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> EventWebSocket -> App ()
String -> EventWebSocket -> App ()
assertClientAdd String
aliceClientId EventWebSocket
aliceWS
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> EventWebSocket -> App ()
String -> EventWebSocket -> App ()
assertClientAdd String
bobClientId EventWebSocket
bobWS
  where
    assertClientAdd :: (HasCallStack) => String -> EventWebSocket -> App ()
    assertClientAdd :: HasCallStack => String -> EventWebSocket -> App ()
assertClientAdd String
clientId EventWebSocket
ws = do
      Value
deliveryTag <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws
      HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False

testConsumeEventsWhileHavingLegacyClients :: (HasCallStack) => App ()
testConsumeEventsWhileHavingLegacyClients :: HasCallStack => App ()
testConsumeEventsWhileHavingLegacyClients = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  -- Even if alice has no clients, the notifications should still be persisted
  -- in Cassandra. This choice is kinda arbitrary as these notifications
  -- probably don't mean much, however, it ensures backwards compatibility.
  String
lastNotifId <-
    Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
alice Maybe Value
noValue (App Bool -> Value -> App Bool
forall a b. a -> b -> a
const (App Bool -> Value -> App Bool) -> App Bool -> Value -> App Bool
forall a b. (a -> b) -> a -> b
$ Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
notif -> do
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.activate"
      -- There is only one notification (at the time of writing), so we assume
      -- it to be the last one.
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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

  Value
oldClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just []} 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) -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket (Value
alice, String
"anything-but-conn", Value
oldClient Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
oldWS -> do
    Value
newClient <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
newClientId <- Value
newClient Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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

    Value
oldNotif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientAddNotif WebSocket
oldWS
    Value
oldNotif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newClientId

    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
newClientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newClientId

  -- All notifs are also in Cassandra because of the legacy client
  Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
alice GetNotifications
forall a. Default a => a
def {since = Just lastNotifId} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.0.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.1.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"

testConsumeEventsAcks :: (HasCallStack) => App ()
testConsumeEventsAcks :: HasCallStack => App ()
testConsumeEventsAcks = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId

  -- without ack, we receive the same event again
  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    Value
deliveryTag <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testConsumeEventsMultipleAcks :: (HasCallStack) => App ()
testConsumeEventsMultipleAcks :: HasCallStack => App ()
testConsumeEventsMultipleAcks = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

  String
handle <- App String
randomHandle
  Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
alice String
handle App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId

    Value
deliveryTag <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"

    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
True

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testConsumeEventsAckNewEventWithoutAckingOldOne :: (HasCallStack) => App ()
testConsumeEventsAckNewEventWithoutAckingOldOne :: HasCallStack => App ()
testConsumeEventsAckNewEventWithoutAckingOldOne = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

  String
handle <- App String
randomHandle
  Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
alice String
handle App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId

    Value
deliveryTagHandleAdd <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"

    -- Only ack the handle add delivery tag
    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTagHandleAdd Bool
False

  -- Expect client-add event to be delivered again.
  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    Value
deliveryTagClientAdd <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"

    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTagClientAdd Bool
False

  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testEventsDeadLettered :: (HasCallStack) => App ()
testEventsDeadLettered :: HasCallStack => App ()
testEventsDeadLettered = do
  let notifTTL :: Timeout
notifTTL = Word64
1 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Second
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend (ServiceOverrides
forall a. Default a => a
def {gundeckCfg = setField "settings.notificationTTL" (notifTTL #> Second)}) ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def

    -- This generates an event
    Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

    -- We expire the add client event by waiting it out
    Timeout -> App ()
forall (μ :: * -> *). MonadBase IO μ => Timeout -> μ ()
Timeout.threadDelay (Timeout
notifTTL Timeout -> Timeout -> Timeout
forall a. Num a => a -> a -> a
+ Word64
500 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
MilliSecond)

    -- Generate a second event
    String
handle1 <- App String
randomHandle
    Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
alice String
handle1 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"notifications_missed"

      -- Until we ack the full sync, we can't get new events
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
ackFullSync EventWebSocket
ws

      -- withEventsWebSocket alice clientId $ \eventsChan ackChan -> do
      -- Now we can see the next event
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle1
        HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

      -- We've consumed the whole queue.
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testEventsDeadLetteredWithReconnect :: (HasCallStack) => App ()
testEventsDeadLetteredWithReconnect :: HasCallStack => App ()
testEventsDeadLetteredWithReconnect = do
  let notifTTL :: Timeout
notifTTL = Word64
1 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Second
  [ServiceOverrides] -> ([BackendResource] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([BackendResource] -> App a) -> App a
startDynamicBackendsReturnResources [ServiceOverrides
forall a. Default a => a
def {gundeckCfg = setField "settings.notificationTTL" (notifTTL #> Second)}] (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
resources] -> do
    let String
domain :: String = BackendResource
resources.berDomain
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def

    -- This generates an event
    Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

    -- Force a reconnect by deleting the existing connection
    HasCallStack => BackendResource -> App ()
BackendResource -> App ()
killAllDeadUserNotificationRabbitMqConns BackendResource
resources

    -- We expire the add client event by waiting it out
    Timeout -> App ()
forall (μ :: * -> *). MonadBase IO μ => Timeout -> μ ()
Timeout.threadDelay (Timeout
notifTTL Timeout -> Timeout -> Timeout
forall a. Num a => a -> a -> a
+ Word64
500 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
MilliSecond)

    -- Generate a second event
    String
handle1 <- App String
randomHandle
    Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
alice String
handle1 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) (((String, EventWebSocket) -> App ()) -> App ())
-> ((String, EventWebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
endMarker, EventWebSocket
ws) -> do
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"notifications_missed"

      -- Until we ack the full sync, we can't get new events
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
ackFullSync EventWebSocket
ws

      -- Now we can see the next event
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle1
        HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

      -- We've consumed the whole queue.
      HasCallStack => EventWebSocket -> String -> App ()
EventWebSocket -> String -> App ()
assertEndOfIniitalSync EventWebSocket
ws String
endMarker
  where
    killAllDeadUserNotificationRabbitMqConns :: (HasCallStack) => BackendResource -> App ()
    killAllDeadUserNotificationRabbitMqConns :: HasCallStack => BackendResource -> App ()
killAllDeadUserNotificationRabbitMqConns BackendResource
backend = do
      AdminAPI (AsClientT App)
rabbitmqAdminClient <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
backend
      [Connection]
connections <- App [Connection] -> App [Connection]
forall a. App a -> App a
eventually (App [Connection] -> App [Connection])
-> App [Connection] -> App [Connection]
forall a b. (a -> b) -> a -> b
$ do
        [Connection]
conns <- HasCallStack =>
AdminAPI (AsClientT App) -> String -> App [Connection]
AdminAPI (AsClientT App) -> String -> App [Connection]
getDeadUserNotificationConnections AdminAPI (AsClientT App)
rabbitmqAdminClient BackendResource
backend.berVHost
        [Connection] -> App ()
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App ()
assertAtLeastOne [Connection]
conns
        [Connection] -> App [Connection]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Connection]
conns
      [Connection] -> (Connection -> App NoContent) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Connection]
connections ((Connection -> App NoContent) -> App ())
-> (Connection -> App NoContent) -> App ()
forall a b. (a -> b) -> a -> b
$ \Connection
connection -> do
        AdminAPI (AsClientT App)
rabbitmqAdminClient.deleteConnection Connection
connection.name

    getDeadUserNotificationConnections :: (HasCallStack) => AdminAPI (AsClientT App) -> String -> App [Connection]
    getDeadUserNotificationConnections :: HasCallStack =>
AdminAPI (AsClientT App) -> String -> App [Connection]
getDeadUserNotificationConnections AdminAPI (AsClientT App)
rabbitmqAdminClient String
vhost = do
      [Connection]
connections <- AdminAPI (AsClientT App)
rabbitmqAdminClient.listConnectionsByVHost (String -> VHost
Text.pack String
vhost)
      [Connection] -> App [Connection]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Connection] -> App [Connection])
-> [Connection] -> App [Connection]
forall a b. (a -> b) -> a -> b
$ (Connection -> Bool) -> [Connection] -> [Connection]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Connection
c -> VHost -> Maybe VHost
forall a. a -> Maybe a
Just (String -> VHost
forall a. IsString a => String -> a
fromString String
"dead-user-notifications-watcher") Maybe VHost -> Maybe VHost -> Bool
forall a. Eq a => a -> a -> Bool
== Connection
c.userProvidedName) [Connection]
connections

testTransientEventsDoNotTriggerDeadLetters :: (HasCallStack) => App ()
testTransientEventsDoNotTriggerDeadLetters :: HasCallStack => App ()
testTransientEventsDoNotTriggerDeadLetters = do
  let notifTTL :: Timeout
notifTTL = Word64
1 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Second
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend (ServiceOverrides
forall a. Default a => a
def {gundeckCfg = setField "settings.notificationTTL" (notifTTL #> Second)}) ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    -- Creates a non-transient event
    Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
    String
clientId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client

    -- consume it
    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
        Value
deliveryTag <- Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
        HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False

    -- Self conv ID is same as user's ID, we'll use this to send typing
    -- indicators, so we don't have to create another conv.
    Value
selfConvId <- Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
    -- Typing status is transient, currently no one is listening.
    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
alice Value
selfConvId String
"started" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
      HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testTransientEvents :: (HasCallStack) => App ()
testTransientEvents :: HasCallStack => App ()
testTransientEvents = do
  (Value
alice, String
_, String
_) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  (Value
bob, String
_, String
bobClient) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  String
bobClientId <- String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId String
bobClient

  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob]} 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

  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
bob (String -> Maybe String
forall a. a -> Maybe a
Just String
bobClientId)) (((String, EventWebSocket) -> App ()) -> App ())
-> ((String, EventWebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
marker, EventWebSocket
bobWs) -> 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 => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
bobWs String
marker

    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
alice Value
conv String
"started" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
bobWs ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.typing"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
bobWs Value
e

  String
handle1 <- App String
randomHandle
  Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
bob String
handle1 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
alice Value
conv String
"stopped" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  String
handle2 <- App String
randomHandle
  Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
bob String
handle2 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  -- We shouldn't see the stopped typing status because we were not connected to
  -- the websocket when it was sent. The other events should still show up in
  -- order.
  Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
bob (String -> Maybe String
forall a. a -> Maybe a
Just String
bobClient)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String
handle1, String
handle2] ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
handle ->
      EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.update"
        Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.user.handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
handle
        HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testChannelLimit :: (HasCallStack) => App ()
testChannelLimit :: HasCallStack => App ()
testChannelLimit = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ( ServiceOverrides
forall a. Default a => a
def
      { cannonCfg =
          setField "rabbitMqMaxChannels" (2 :: Int)
            >=> setField "rabbitMqMaxConnections" (1 :: Int)
      }
  )
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    (String
client0 : [String]
clients) <-
      Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3
        (App String -> App [String]) -> App String -> App [String]
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]}
        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
        App Value -> (Value -> 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
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
        App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

    Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      [String] -> (String -> Codensity App ()) -> Codensity App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
clients ((String -> Codensity App ()) -> Codensity App ())
-> (String -> Codensity App ()) -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ \String
c -> do
        EventWebSocket
ws <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
c)
        App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
c

      -- the first client fails to connect because the server runs out of channels
      do
        Either HandshakeException EventWebSocket
eithWS <- Value
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
createEventsWebSocketEither Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
client0) Maybe String
forall a. Maybe a
Nothing
        case Either HandshakeException EventWebSocket
eithWS of
          Left (WS.MalformedResponse ResponseHead
respHead String
_) ->
            App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ResponseHead
respHead.responseCode Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
503
          Left HandshakeException
e ->
            App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected websocket to fail with response code 503, got some other handshake exception: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HandshakeException -> String
forall e. Exception e => e -> String
displayException HandshakeException
e
          Right EventWebSocket
_ -> App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected websocket hanshake to fail, but it didn't"

testChannelKilled :: (HasCallStack) => App ()
testChannelKilled :: HasCallStack => App ()
testChannelKilled = do
  ResourcePool BackendResource
pool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  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
pool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
backend] -> do
    -- Some times RabbitMQ still remembers connections from previous uses of the
    -- dynamic backend. So we wait to ensure that we kill connection only for our
    -- current.
    App [Connection] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Connection] -> App ()) -> App [Connection] -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => BackendResource -> App [Connection]
BackendResource -> App [Connection]
killAllRabbitMqConns BackendResource
backend
    HasCallStack => BackendResource -> App ()
BackendResource -> App ()
waitUntilNoRabbitMqConns BackendResource
backend

    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
backend ServiceOverrides
forall a. Default a => a
def) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      let domain :: String
domain = BackendResource
backend.berDomain
      Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      [String
c1, String
c2] <-
        Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2
          (App String -> App [String]) -> App String -> App [String]
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]}
          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
          App Value -> (Value -> 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
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
          App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

      Codensity App EventWebSocket
-> forall b. (EventWebSocket -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
c1)) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
        -- If creating the user takes longer (async) than adding the clients, we get a
        -- `"user.activate"` here, so we use `assertFindsEvent`.
        EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
c1
          HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

        EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
          Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
c2
          HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

        -- The RabbitMQ admin API takes some time to see new connections, so we need
        -- to try a few times.
        RetryPolicyM App -> (RetryStatus -> App ()) -> App ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll (Int -> RetryPolicyM App
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
500_000 RetryPolicyM App -> RetryPolicyM App -> RetryPolicyM App
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
10) ((RetryStatus -> App ()) -> App ())
-> (RetryStatus -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> do
          [Connection]
conns <- HasCallStack => BackendResource -> App [Connection]
BackendResource -> App [Connection]
killAllRabbitMqConns BackendResource
backend
          [Connection] -> App ()
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App ()
assertAtLeastOne [Connection]
conns

        HasCallStack => BackendResource -> App ()
BackendResource -> App ()
waitUntilNoRabbitMqConns BackendResource
backend

        HasCallStack => EventWebSocket -> App NoEvent
EventWebSocket -> App NoEvent
assertNoEventHelper EventWebSocket
ws App NoEvent -> NoEvent -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` NoEvent
WebSocketDied

testSingleConsumer :: (HasCallStack) => App ()
testSingleConsumer :: HasCallStack => App ()
testSingleConsumer = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  String
clientId <-
    Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]}
      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
      App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId

  -- add a second client in order to generate one more notification
  String
clientId' <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
alice AddClient
forall a. Default a => a
def 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 App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId

  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    EventWebSocket
ws <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)
    EventWebSocket
ws' <- Value -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
clientId)

    -- the second websocket should get no notifications as long as the first
    -- one is connected
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws'

    Value
deliveryTag1 <- App Value -> Codensity App Value
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App Value -> Codensity App Value)
-> App Value -> Codensity App Value
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"

    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws'

    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag1 Bool
False
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws'

    Value
deliveryTag2 <- App Value -> Codensity App Value
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App Value -> Codensity App Value)
-> App Value -> Codensity App Value
forall a b. (a -> b) -> a -> b
$ EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App Value) -> App Value)
-> (HasCallStack => Value -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"event"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user.client-add"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
clientId'
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag2 Bool
False

    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws'

testPrefetchCount :: (HasCallStack) => App ()
testPrefetchCount :: HasCallStack => App ()
testPrefetchCount = do
  (Value
alice, String
uid, String
cid) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  Value -> String -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App ()
emptyQueue Value
alice String
cid

  [Int] -> (Int -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
1 :: Int .. Int
550] ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    do
      let event :: Value
event =
            [Pair] -> Value
object
              [ String
"recipients" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid, String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
cid], String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"]],
                String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"no" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Int -> String
forall a. Show a => a -> String
show Int
i]]
              ]
      Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [Value
event] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) \(String
endMarker, EventWebSocket
ws) -> do
    [Value]
es <- EventWebSocket -> App [Value]
consumeAllEventsNoAck EventWebSocket
ws
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool (String
"First 500 events expected, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
es)) (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
es Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
500

    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value]
es (HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws)

    [Value]
es' <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Receive at least one outstanding event" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
es')

testEndOfInitialSync :: (HasCallStack) => App ()
testEndOfInitialSync :: HasCallStack => App ()
testEndOfInitialSync = do
  (Value
alice, String
uid, String
cid) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  let n :: Int
n = Int
20
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  -- marker0 <- randomId
  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) \(String
endMarker, EventWebSocket
ws) -> do
    [Value]
preExistingEvents <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    [Value]
otherEvents <- EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws

    -- we expect one user.client-add event, n more events, and one sync event
    [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value]
preExistingEvents [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherEvents) Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

    -- more events should not be followed by the sync event
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"test"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

  -- when we reconnect, there are no messages but we still get the
  -- synchronization notification.
  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) \(String
endMarker, EventWebSocket
ws) -> do
    [Value]
preExistingEvents <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    [Value]
otherEvents <- EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws
    let events :: [Value]
events = [Value]
preExistingEvents [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherEvents
    [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
events Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

    -- more events should not be followed by synchronization event
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"test"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
ws

testEndOfInitialSyncMoreEventsAfterSyncMessage :: (HasCallStack) => App ()
testEndOfInitialSyncMoreEventsAfterSyncMessage :: HasCallStack => App ()
testEndOfInitialSyncMoreEventsAfterSyncMessage = do
  (Value
alice, String
uid, String
cid) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  let n :: Int
n = Int
20
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) \(String
endMarker, EventWebSocket
ws) -> do
    -- it seems this is needed to reduce flakiness,
    -- when the messages below are pushed faster than the sync message is inserted
    Timeout -> App ()
forall (μ :: * -> *). MonadBase IO μ => Timeout -> μ ()
Timeout.threadDelay (Word64
1 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Second)

    -- before consuming, we push n more events
    Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    [Value]
preExistingEvents <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    [Value]
otherEvents <- EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws

    [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value]
preExistingEvents [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherEvents) Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (String
"We should have received " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" more events after the sync event but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
otherEvents))
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
otherEvents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n)
      Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

testEndOfInitialSyncIgnoreExpired :: (HasCallStack) => App ()
testEndOfInitialSyncIgnoreExpired :: HasCallStack => App ()
testEndOfInitialSyncIgnoreExpired = do
  (Value
alice, String
uid, String
cid) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  let n :: Int
n = Int
20
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
True] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  -- Wait for transient events to expire
  Timeout -> App ()
forall (μ :: * -> *). MonadBase IO μ => Timeout -> μ ()
Timeout.threadDelay (Word64
1 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Second)

  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) (((String, EventWebSocket) -> App ()) -> App ())
-> ((String, EventWebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
endMarker, EventWebSocket
ws) -> do
    [Value]
preExistingEvents <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    [Value]
otherEvents <- EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws
    let events :: [Value]
events = [Value]
preExistingEvents [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherEvents
    [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
events Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) -- +1 for the sync event, +1 for the client add event

testEndOfInitialSyncAckMultiple :: (HasCallStack) => App ()
testEndOfInitialSyncAckMultiple :: HasCallStack => App ()
testEndOfInitialSyncAckMultiple = do
  (Value
alice, String
uid, String
cid) <- App (Value, String, String)
HasCallStack => App (Value, String, String)
mkUserPlusClient
  let n :: Int
n = Int
20
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
GundeckInternal.postPush Domain
OwnDomain [String -> String -> Bool -> Value
forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent String
uid String
cid Bool
False] App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Value -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) (((String, EventWebSocket) -> App ()) -> App ())
-> ((String, EventWebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
endMarker, EventWebSocket
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
$ EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws HasCallStack => Value -> App Value
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Value
e <- EventWebSocket -> (HasCallStack => Value -> App Value) -> App Value
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws HasCallStack => Value -> App Value
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Value
dt <- Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
    -- we ack the first 2 events with one ack
    HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
dt Bool
True
    let expectedNumEvents :: Int
expectedNumEvents = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 -- +1 for the sync event, +1 for the client add event
    [Value]
preExistingEvents <- HasCallStack => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker
    [Value]
otherEvents <- EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws
    let events :: [Value]
events = [Value]
preExistingEvents [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherEvents
    [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
events Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
expectedNumEvents

mkEvent :: (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent :: forall a1 a2. (ToJSON a1, ToJSON a2) => a1 -> a2 -> Bool -> Value
mkEvent a1
uid a2
cid Bool
transient =
  [Pair] -> Value
object
    [ String
"recipients" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"user_id" String -> a1 -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a1
uid, String
"clients" String -> [a2] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [a2
cid], String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"]],
      String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"hello" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"world", String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test"]],
      String
"transient" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
transient
    ]

testTypingIndicatorIsNotSentToOwnClient :: (HasCallStack) => TaggedBool "federated" -> App ()
testTypingIndicatorIsNotSentToOwnClient :: HasCallStack => TaggedBool "federated" -> App ()
testTypingIndicatorIsNotSentToOwnClient (TaggedBool Bool
federated) = do
  (Value
alice, String
_, String
aliceClient) <- Domain -> App (Value, String, String)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, String, String)
mkUserPlusClientWithDomain Domain
OwnDomain
  (Value
bob, String
_, String
bobClient) <- Domain -> App (Value, String, String)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, String, String)
mkUserPlusClientWithDomain (if Bool
federated then Domain
OtherDomain else Domain
OwnDomain)
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  String
aliceClientId <- String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId String
aliceClient
  String
bobClientId <- String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId String
bobClient
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob]} 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

  Codensity App [EventWebSocket]
-> forall b. ([EventWebSocket] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity ([(Value, Maybe String)] -> Codensity App [EventWebSocket]
forall user.
(HasCallStack, MakesValue user) =>
[(user, Maybe String)] -> Codensity App [EventWebSocket]
createEventWebSockets [(Value
alice, String -> Maybe String
forall a. a -> Maybe a
Just String
aliceClientId), (Value
bob, String -> Maybe String
forall a. a -> Maybe a
Just String
bobClientId)]) (([EventWebSocket] -> App ()) -> App ())
-> ([EventWebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[EventWebSocket
aliceWs, EventWebSocket
bobWs] -> do
    -- consume all events to ensure we start with a clean slate
    EventWebSocket -> App ()
consumeAllEvents_ EventWebSocket
aliceWs
    EventWebSocket -> App ()
consumeAllEvents_ EventWebSocket
bobWs

    -- Alice is typing
    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
alice Value
conv String
"started" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- Bob should receive the typing indicator for Alice
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
bobWs ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.typing"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
bobWs Value
e

    -- Alice should not receive the typing indicator for herself
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
aliceWs

    -- Bob is typing
    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
bob Value
conv String
"started" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- Alice should receive the typing indicator for Bob
    EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
aliceWs ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.typing"
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
aliceWs Value
e

    -- Bob should not receive the typing indicator for himself
    HasCallStack => EventWebSocket -> App ()
EventWebSocket -> App ()
assertNoEvent_ EventWebSocket
bobWs

-- We only delete queues to clean up federated integration tests. So, we
-- mostly want to ensure we don't get stuck there.
testBackendPusherRecoversFromQueueDeletion :: (HasCallStack) => App ()
testBackendPusherRecoversFromQueueDeletion :: HasCallStack => App ()
testBackendPusherRecoversFromQueueDeletion = do
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  String
domain1 <- (Env -> String) -> App String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.domain1)

  let remotesRefreshInterval :: Int
remotesRefreshInterval = Int
10000 :: Int
  [ServiceOverrides] -> ([BackendResource] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([BackendResource] -> App a) -> App a
startDynamicBackendsReturnResources
    [ ServiceOverrides
forall a. Default a => a
def
        { backgroundWorkerCfg =
            setField
              "backendNotificationPusher.remotesRefreshInterval"
              remotesRefreshInterval
        }
    ]
    (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
beResource] -> do
      let domain :: String
domain = BackendResource
beResource.berDomain
      (Value
alice, String
team, [Value
alex, Value
alison]) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
3

      -- Create a federated conversion
      Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
      [Value
alexId, Value
alisonId, Value
bobId] <-
        [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value
alex, Value
alison, Value
bob] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      let nc :: CreateConv
nc = (CreateConv
defProteus {qualifiedUsers = [alexId, alisonId, bobId], team = Just team})
      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 -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
nc 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] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bob] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket
wsBob] -> do
        AdminAPI (AsClientT App)
rabbitmqAdminClient <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
beResource
        let App [String]
getActiveQueues :: App [String] =
              VHost -> String
Text.unpack (VHost -> String) -> (Queue -> VHost) -> Queue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.name)
                (Queue -> String) -> App [Queue] -> App [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> ( (.items)
                         (Page Queue -> [Queue]) -> App (Page Queue) -> App [Queue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AdminAPI (AsClientT App)
rabbitmqAdminClient.listQueuesByVHost
                           (String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost)
                           (String -> VHost
forall a. IsString a => String -> a
fromString String
"")
                           Bool
True
                           Int
100
                           Int
1
                     )

        App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
team Value
alice Value
alex App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
202

        WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsBob Value
alexId

        -- Delete the queue
        let backendNotificationQueueName :: String
backendNotificationQueueName = String
"backend-notifications." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain1
        App NoContent -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
          (App NoContent -> App ()) -> App NoContent -> App ()
forall a b. (a -> b) -> a -> b
$ AdminAPI (AsClientT App)
rabbitmqAdminClient.deleteQueue
            (String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost)
            (String -> VHost
forall a. IsString a => String -> a
fromString String
backendNotificationQueueName)

        -- Ensure the queue was deleted
        App () -> App ()
forall a. App a -> App a
eventually (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
          [String]
queueNames <- App [String]
getActiveQueues
          [String]
queueNames [String] -> [String] -> App ()
forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> App ()
`shouldNotContain` [String
backendNotificationQueueName]

        App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
team Value
alice Value
alison App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
202

        Timeout -> App ()
forall (μ :: * -> *). MonadBase IO μ => Timeout -> μ ()
Timeout.threadDelay (Timeout -> App ()) -> (Int -> Timeout) -> Int -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Timeout
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> App ()) -> Int -> App ()
forall a b. (a -> b) -> a -> b
$ Int
remotesRefreshInterval Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2

        -- Check that the queue was recreated
        App () -> App ()
forall a. App a -> App a
eventually (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
          [String]
queueNames <- App [String]
getActiveQueues
          [String]
queueNames [String] -> [String] -> App ()
forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> App ()
`shouldContain` [String
backendNotificationQueueName]

        WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsBob Value
alisonId

----------------------------------------------------------------------
-- helpers
mkUserPlusClientWithDomain :: (HasCallStack, MakesValue domain) => domain -> App (Value, String, String)
mkUserPlusClientWithDomain :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, String, String)
mkUserPlusClientWithDomain domain
domain = do
  Value
user <- domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
domain CreateUser
forall a. Default a => a
def
  String
uid <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
user
  Value
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
user AddClient
forall a. Default a => a
def {acapabilities = Just ["consumable-notifications"]} 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
  String
cid <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
client
  (Value, String, String) -> App (Value, String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
user, String
uid, String
cid)

mkUserPlusClient :: (HasCallStack) => App (Value, String, String)
mkUserPlusClient :: HasCallStack => App (Value, String, String)
mkUserPlusClient = Domain -> App (Value, String, String)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, String, String)
mkUserPlusClientWithDomain Domain
OwnDomain

data EventWebSocket = EventWebSocket
  { EventWebSocket -> Chan (Either ConnectionException Value)
events :: Chan (Either WS.ConnectionException Value),
    EventWebSocket -> MVar (Maybe Value)
ack :: MVar (Maybe Value),
    EventWebSocket -> MVar ()
kill :: MVar (),
    EventWebSocket -> MVar ()
done :: MVar ()
  }

createEventWebSockets ::
  (HasCallStack, MakesValue user) =>
  [(user, Maybe String)] ->
  Codensity App [EventWebSocket]
createEventWebSockets :: forall user.
(HasCallStack, MakesValue user) =>
[(user, Maybe String)] -> Codensity App [EventWebSocket]
createEventWebSockets = ((user, Maybe String) -> Codensity App EventWebSocket)
-> [(user, Maybe String)] -> Codensity App [EventWebSocket]
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 ((user -> Maybe String -> Codensity App EventWebSocket)
-> (user, Maybe String) -> Codensity App EventWebSocket
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry user -> Maybe String -> Codensity App EventWebSocket
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket)

createEventsWebSocket ::
  (HasCallStack, MakesValue user) =>
  user ->
  Maybe String ->
  Codensity App EventWebSocket
createEventsWebSocket :: forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket user
user Maybe String
cid = do
  Either HandshakeException EventWebSocket
eithWS <- user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
createEventsWebSocketEither user
user Maybe String
cid Maybe String
forall a. Maybe a
Nothing
  case Either HandshakeException EventWebSocket
eithWS of
    Left HandshakeException
e -> App EventWebSocket -> Codensity App EventWebSocket
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App EventWebSocket -> Codensity App EventWebSocket)
-> App EventWebSocket -> Codensity App EventWebSocket
forall a b. (a -> b) -> a -> b
$ String -> App EventWebSocket
forall a. HasCallStack => String -> App a
assertFailure (String -> App EventWebSocket) -> String -> App EventWebSocket
forall a b. (a -> b) -> a -> b
$ String
"Websocket failed to connect due to handshake exception: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HandshakeException -> String
forall e. Exception e => e -> String
displayException HandshakeException
e
    Right EventWebSocket
ws -> EventWebSocket -> Codensity App EventWebSocket
forall a. a -> Codensity App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventWebSocket
ws

createEventsWebSocketWithSync ::
  (HasCallStack, MakesValue user) =>
  user ->
  Maybe String ->
  Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync :: forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync user
user Maybe String
cid = do
  String
syncMarker <- App String -> Codensity App String
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift App String
HasCallStack => App String
randomId
  Either HandshakeException EventWebSocket
eithWS <- user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
createEventsWebSocketEither user
user Maybe String
cid (String -> Maybe String
forall a. a -> Maybe a
Just String
syncMarker)
  case Either HandshakeException EventWebSocket
eithWS of
    Left HandshakeException
e -> App (String, EventWebSocket)
-> Codensity App (String, EventWebSocket)
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (String, EventWebSocket)
 -> Codensity App (String, EventWebSocket))
-> App (String, EventWebSocket)
-> Codensity App (String, EventWebSocket)
forall a b. (a -> b) -> a -> b
$ String -> App (String, EventWebSocket)
forall a. HasCallStack => String -> App a
assertFailure (String -> App (String, EventWebSocket))
-> String -> App (String, EventWebSocket)
forall a b. (a -> b) -> a -> b
$ String
"Websocket failed to connect due to handshake exception: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HandshakeException -> String
forall e. Exception e => e -> String
displayException HandshakeException
e
    Right EventWebSocket
ws -> (String, EventWebSocket) -> Codensity App (String, EventWebSocket)
forall a. a -> Codensity App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
syncMarker, EventWebSocket
ws)

createEventsWebSocketEither ::
  (HasCallStack, MakesValue user) =>
  user ->
  Maybe String ->
  Maybe String ->
  Codensity App (Either WS.HandshakeException EventWebSocket)
createEventsWebSocketEither :: forall user.
(HasCallStack, MakesValue user) =>
user
-> Maybe String
-> Maybe String
-> Codensity App (Either HandshakeException EventWebSocket)
createEventsWebSocketEither user
user Maybe String
cid Maybe String
mSyncMarker = do
  Chan (Either ConnectionException Value)
eventsChan <- IO (Chan (Either ConnectionException Value))
-> Codensity App (Chan (Either ConnectionException Value))
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Chan (Either ConnectionException Value))
forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
  MVar (Maybe Value)
ackChan <- IO (MVar (Maybe Value)) -> Codensity App (MVar (Maybe Value))
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (Maybe Value))
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  ServiceMap
serviceMap <- App ServiceMap -> Codensity App ServiceMap
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App ServiceMap -> Codensity App ServiceMap)
-> App ServiceMap -> Codensity App ServiceMap
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> App ServiceMap
String -> App ServiceMap
getServiceMap (String -> App ServiceMap) -> App String -> App ServiceMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain user
user
  Int
apiVersion <- App Int -> Codensity App Int
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App Int -> Codensity App Int) -> App Int -> Codensity App Int
forall a b. (a -> b) -> a -> b
$ App String -> App Int
forall domain. MakesValue domain => domain -> App Int
getAPIVersionFor (App String -> App Int) -> App String -> App Int
forall a b. (a -> b) -> a -> b
$ user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain user
user
  MVar (Either HandshakeException ())
wsStarted <- Codensity App (MVar (Either HandshakeException ()))
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  let minAPIVersion :: Int
minAPIVersion = Int
8
  App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
    (App () -> Codensity App ())
-> (App () -> App ()) -> App () -> Codensity App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
apiVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minAPIVersion)
    (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"Events websocket can only be created when APIVersion is at least " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
minAPIVersion)

  MVar ()
varKill <- App (MVar ()) -> Codensity App (MVar ())
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (MVar ()) -> Codensity App (MVar ()))
-> App (MVar ()) -> Codensity App (MVar ())
forall a b. (a -> b) -> a -> b
$ App (MVar ())
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  MVar ()
varDone <- App (MVar ()) -> Codensity App (MVar ())
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (MVar ()) -> Codensity App (MVar ()))
-> App (MVar ()) -> Codensity App (MVar ())
forall a b. (a -> b) -> a -> b
$ App (MVar ())
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar

  String
uid <- App String -> Codensity App String
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App String -> Codensity App String)
-> App String -> Codensity App String
forall a b. (a -> b) -> a -> b
$ Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (Value -> App String) -> App Value -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< user -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject user
user
  let HostPort String
caHost Word16
caPort = ServiceMap -> Service -> HostPort
serviceHostPort ServiceMap
serviceMap Service
Cannon
      path :: String
path = String
"/v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
apiVersion String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/events" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"?client=" <>) Maybe String
cid String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"&sync_marker=" <>) Maybe String
mSyncMarker
      caHdrs :: [(CI ByteString, ByteString)]
caHdrs = [(String -> CI ByteString
forall a. IsString a => String -> a
fromString String
"Z-User", String -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' String
uid)]
      app :: Connection -> IO ()
app Connection
conn = do
        MVar (Either HandshakeException ())
-> Either HandshakeException () -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (Either HandshakeException ())
wsStarted (() -> Either HandshakeException ()
forall a b. b -> Either a b
Right ())
        IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
race_
          (Connection -> IO ()
wsRead Connection
conn IO () -> (ConnectionException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (Chan (Either ConnectionException Value)
-> Either ConnectionException Value -> IO ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan (Either ConnectionException Value)
eventsChan (Either ConnectionException Value -> IO ())
-> (ConnectionException -> Either ConnectionException Value)
-> ConnectionException
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionException -> Either ConnectionException Value
forall a b. a -> Either a b
Left))
          (Connection -> IO ()
wsWrite Connection
conn)

      wsRead :: Connection -> IO ()
wsRead Connection
conn = IO Any -> (Async Any -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (Connection -> IO Any
wsReadLoop Connection
conn) ((Async Any -> IO ()) -> IO ()) -> (Async Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async Any
loop -> do
        Either () Any
r <- IO () -> IO Any -> IO (Either () Any)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race (MVar () -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar ()
varKill) (Async Any -> IO Any
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async Any
loop)
        case Either () Any
r of
          Left ()
_ -> Async Any -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async Any
loop IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Connection -> IO ()
waitClosed Connection
conn
          Right Any
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      waitClosed :: Connection -> IO ()
waitClosed Connection
conn = do
        Connection -> IO Message
WS.receive Connection
conn IO Message -> (Message -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          WS.ControlMessage (WS.Close Word16
_ ByteString
_) ->
            IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar MVar ()
varDone ()
          Message
_ -> Connection -> IO ()
waitClosed Connection
conn

      wsReadLoop :: Connection -> IO Any
wsReadLoop Connection
conn = IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs <- Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn
        case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict' ByteString
bs of
          Just Value
n -> Chan (Either ConnectionException Value)
-> Either ConnectionException Value -> IO ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan (Either ConnectionException Value)
eventsChan (Value -> Either ConnectionException Value
forall a b. b -> Either a b
Right Value
n)
          Maybe Value
Nothing ->
            String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode events: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs

      wsWrite :: Connection -> IO ()
wsWrite Connection
conn = do
        Maybe Value
mAck <- MVar (Maybe Value) -> IO (Maybe Value)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (Maybe Value)
ackChan
        case Maybe Value
mAck of
          Maybe Value
Nothing -> Connection -> VHost -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendClose Connection
conn (String -> VHost
Text.pack String
"")
          Just Value
ack ->
            Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendBinaryData Connection
conn (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
ack)
              IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Connection -> IO ()
wsWrite Connection
conn

  Async ()
wsThread <-
    (forall b. (Async () -> App b) -> App b)
-> Codensity App (Async ())
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity
      ((forall b. (Async () -> App b) -> App b)
 -> Codensity App (Async ()))
-> (forall b. (Async () -> App b) -> App b)
-> Codensity App (Async ())
forall a b. (a -> b) -> a -> b
$ App () -> (Async () -> App b) -> App b
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync
      (App () -> (Async () -> App b) -> App b)
-> App () -> (Async () -> App b) -> App b
forall a b. (a -> b) -> a -> b
$ IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String
-> Int
-> String
-> ConnectionOptions
-> [(CI ByteString, ByteString)]
-> (Connection -> IO ())
-> IO ()
forall a.
String
-> Int
-> String
-> ConnectionOptions
-> [(CI ByteString, ByteString)]
-> ClientApp a
-> IO a
WS.runClientWith String
caHost (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
caPort) String
path ConnectionOptions
WS.defaultConnectionOptions [(CI ByteString, ByteString)]
caHdrs Connection -> IO ()
app
      IO () -> (HandshakeException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(HandshakeException
e :: WS.HandshakeException) -> MVar (Either HandshakeException ())
-> Either HandshakeException () -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (Either HandshakeException ())
wsStarted (HandshakeException -> Either HandshakeException ()
forall a b. a -> Either a b
Left HandshakeException
e)

  Int
timeOutSeconds <- (Env -> Int) -> Codensity App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
  Maybe (Either HandshakeException ())
mStarted <- App (Maybe (Either HandshakeException ()))
-> Codensity App (Maybe (Either HandshakeException ()))
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (Maybe (Either HandshakeException ()))
 -> Codensity App (Maybe (Either HandshakeException ())))
-> App (Maybe (Either HandshakeException ()))
-> Codensity App (Maybe (Either HandshakeException ()))
forall a b. (a -> b) -> a -> b
$ Int
-> App (Either HandshakeException ())
-> App (Maybe (Either HandshakeException ()))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (MVar (Either HandshakeException ())
-> App (Either HandshakeException ())
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar (Either HandshakeException ())
wsStarted)
  case Maybe (Either HandshakeException ())
mStarted of
    Maybe (Either HandshakeException ())
Nothing -> do
      Async () -> Codensity App ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async ()
wsThread
      App (Either HandshakeException EventWebSocket)
-> Codensity App (Either HandshakeException EventWebSocket)
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (Either HandshakeException EventWebSocket)
 -> Codensity App (Either HandshakeException EventWebSocket))
-> App (Either HandshakeException EventWebSocket)
-> Codensity App (Either HandshakeException EventWebSocket)
forall a b. (a -> b) -> a -> b
$ String -> App (Either HandshakeException EventWebSocket)
forall a. HasCallStack => String -> App a
assertFailure (String -> App (Either HandshakeException EventWebSocket))
-> String -> App (Either HandshakeException EventWebSocket)
forall a b. (a -> b) -> a -> b
$ String
"Websocket failed to connect within " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
timeOutSeconds String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
    Just (Left HandshakeException
e) ->
      Either HandshakeException EventWebSocket
-> Codensity App (Either HandshakeException EventWebSocket)
forall a. a -> Codensity App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HandshakeException -> Either HandshakeException EventWebSocket
forall a b. a -> Either a b
Left HandshakeException
e)
    Just (Right ()) ->
      (forall b.
 (Either HandshakeException EventWebSocket -> App b) -> App b)
-> Codensity App (Either HandshakeException EventWebSocket)
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b.
  (Either HandshakeException EventWebSocket -> App b) -> App b)
 -> Codensity App (Either HandshakeException EventWebSocket))
-> (forall b.
    (Either HandshakeException EventWebSocket -> App b) -> App b)
-> Codensity App (Either HandshakeException EventWebSocket)
forall a b. (a -> b) -> a -> b
$ \Either HandshakeException EventWebSocket -> App b
k ->
        Either HandshakeException EventWebSocket -> App b
k (EventWebSocket -> Either HandshakeException EventWebSocket
forall a b. b -> Either a b
Right (EventWebSocket -> Either HandshakeException EventWebSocket)
-> EventWebSocket -> Either HandshakeException EventWebSocket
forall a b. (a -> b) -> a -> b
$ Chan (Either ConnectionException Value)
-> MVar (Maybe Value) -> MVar () -> MVar () -> EventWebSocket
EventWebSocket Chan (Either ConnectionException Value)
eventsChan MVar (Maybe Value)
ackChan MVar ()
varKill MVar ()
varDone) App b -> App () -> App b
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` do
          MVar (Maybe Value) -> Maybe Value -> App ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar (Maybe Value)
ackChan Maybe Value
forall a. Maybe a
Nothing
          IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Async () -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async ()
wsThread

ackFullSync :: (HasCallStack) => EventWebSocket -> App ()
ackFullSync :: HasCallStack => EventWebSocket -> App ()
ackFullSync EventWebSocket
ws =
  MVar (Maybe Value) -> Maybe Value -> App ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar EventWebSocket
ws.ack
    (Maybe Value -> App ()) -> Maybe Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just ([Pair] -> Value
object [String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"ack_full_sync"])

ackEvent :: (HasCallStack) => EventWebSocket -> Value -> App ()
ackEvent :: HasCallStack => EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
event = do
  Value
deliveryTag <- Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.delivery_tag"
  HasCallStack => EventWebSocket -> Value -> Bool -> App ()
EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
False

sendAck :: (HasCallStack) => EventWebSocket -> Value -> Bool -> App ()
sendAck :: HasCallStack => EventWebSocket -> Value -> Bool -> App ()
sendAck EventWebSocket
ws Value
deliveryTag Bool
multiple =
  do
    MVar (Maybe Value) -> Maybe Value -> App ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (MVar (Maybe Value) -> Maybe Value -> App ())
-> MVar (Maybe Value) -> Maybe Value -> App ()
forall a b. (a -> b) -> a -> b
$ EventWebSocket
ws.ack
    (Maybe Value -> App ()) -> Maybe Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just
    (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
      [ String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"ack",
        String
"data"
          String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
            [ String
"delivery_tag" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
deliveryTag,
              String
"multiple" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
multiple
            ]
      ]

killWebSocketClient :: EventWebSocket -> App ()
killWebSocketClient :: EventWebSocket -> App ()
killWebSocketClient EventWebSocket
ws = do
  App Bool -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Bool -> App ()) -> App Bool -> App ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> App Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar EventWebSocket
ws.kill ()
  MVar () -> App ()
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar EventWebSocket
ws.done

assertEvent :: (HasCallStack) => EventWebSocket -> ((HasCallStack) => Value -> App a) -> App a
assertEvent :: forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws HasCallStack => Value -> App a
expectations = do
  Int
timeOutSeconds <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
  Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> App a) -> App a
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Either ConnectionException Value)
Nothing -> String -> App a
forall a. HasCallStack => String -> App a
assertFailure (String -> App a) -> String -> App a
forall a b. (a -> b) -> a -> b
$ String
"No event received for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
timeOutSeconds String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
    Just (Left ConnectionException
ex) ->
      String -> App a -> App a
forall a. String -> App a -> App a
addFailureContext (String
"WSException: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> String
forall e. Exception e => e -> String
displayException ConnectionException
ex)
        (App a -> App a) -> App a -> App a
forall a b. (a -> b) -> a -> b
$ String -> App a
forall a. HasCallStack => String -> App a
assertFailure String
"Websocket closed when waiting for more events"
    Just (Right Value
e) -> do
      String
pretty <- Value -> App String
forall a. MakesValue a => a -> App String
prettyJSON Value
e
      String -> App a -> App a
forall a. String -> App a -> App a
addFailureContext (String
"event:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pretty)
        (App a -> App a) -> App a -> App a
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> App a
Value -> App a
expectations Value
e

-- | Tolerates and consumes other events before expected event
assertFindsEvent :: forall a. (HasCallStack) => EventWebSocket -> ((HasCallStack) => Value -> App a) -> App a
assertFindsEvent :: forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEvent = (HasCallStack => EventWebSocket -> Value -> App ())
-> EventWebSocket -> (HasCallStack => Value -> App a) -> App a
forall a.
HasCallStack =>
(HasCallStack => EventWebSocket -> Value -> App ())
-> EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEventConfigurableAck HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent

assertFindsEventConfigurableAck ::
  forall a.
  (HasCallStack) =>
  ((HasCallStack) => EventWebSocket -> Value -> App ()) ->
  EventWebSocket ->
  ((HasCallStack) => Value -> App a) ->
  App a
assertFindsEventConfigurableAck :: forall a.
HasCallStack =>
(HasCallStack => EventWebSocket -> Value -> App ())
-> EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertFindsEventConfigurableAck HasCallStack => EventWebSocket -> Value -> App ()
ackFun EventWebSocket
ws HasCallStack => Value -> App a
expectations = Int -> App a
go Int
0
  where
    go :: Int -> App a
    go :: Int -> App a
go Int
ignoredEventCount = do
      Int
timeOutSeconds <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
      Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> App a) -> App a
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Either ConnectionException Value)
Nothing -> String -> App a
forall a. HasCallStack => String -> App a
assertFailure (String -> App a) -> String -> App a
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ignoredEventCount String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" event(s) received, no matching event received for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
timeOutSeconds String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
        Just (Left ConnectionException
ex) ->
          String -> App a -> App a
forall a. String -> App a -> App a
addFailureContext (String
"WSException: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> String
forall e. Exception e => e -> String
displayException ConnectionException
ex)
            (App a -> App a) -> App a -> App a
forall a b. (a -> b) -> a -> b
$ String -> App a
forall a. HasCallStack => String -> App a
assertFailure String
"Websocket closed when waiting for more events"
        Just (Right Value
ev) -> do
          (HasCallStack => Value -> App a
Value -> App a
expectations Value
ev)
            App a -> (AssertionFailure -> App a) -> App a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(AssertionFailure
_ :: AssertionFailure) -> do
              String
ignoredEventType <-
                App String -> (Value -> App String) -> Maybe Value -> App String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"No Type") Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
                  (Maybe Value -> App String) -> App (Maybe Value) -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT App Value -> App (Maybe Value)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
                    ( (Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
ev String
"data.event" MaybeT App Value -> (Value -> MaybeT App Value) -> MaybeT App Value
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> MaybeT App Value)
-> String -> Value -> MaybeT App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM String
"payload.0.type")
                        MaybeT App Value -> MaybeT App Value -> MaybeT App Value
forall a. MaybeT App a -> MaybeT App a -> MaybeT App a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
ev String
"type")
                    )
              HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackFun EventWebSocket
ws Value
ev
              String -> Value -> App a -> App a
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext (String
"Ignored Event (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ignoredEventType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")") Value
ev
                (App a -> App a) -> App a -> App a
forall a b. (a -> b) -> a -> b
$ Int -> App a
go (Int
ignoredEventCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

data NoEvent = NoEvent | WebSocketDied

instance ToJSON NoEvent where
  toJSON :: NoEvent -> Value
toJSON NoEvent
NoEvent = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
"no-event"
  toJSON NoEvent
WebSocketDied = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
"web-socket-died"

assertNoEventHelper :: (HasCallStack) => EventWebSocket -> App NoEvent
assertNoEventHelper :: HasCallStack => EventWebSocket -> App NoEvent
assertNoEventHelper EventWebSocket
ws = do
  Int
timeOutSeconds <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
  Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> App NoEvent)
-> App NoEvent
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Either ConnectionException Value)
Nothing -> NoEvent -> App NoEvent
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoEvent
NoEvent
    Just (Left ConnectionException
_) -> NoEvent -> App NoEvent
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoEvent
WebSocketDied
    Just (Right Value
e) -> do
      String
eventJSON <- Value -> App String
forall a. MakesValue a => a -> App String
prettyJSON Value
e
      String -> App NoEvent
forall a. HasCallStack => String -> App a
assertFailure (String -> App NoEvent) -> String -> App NoEvent
forall a b. (a -> b) -> a -> b
$ String
"Did not expect event: \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
eventJSON

-- | Similar to `assertNoEvent` from Testlib, but with rabbitMQ typing (`/event` end-point, not
-- `/await`).
assertNoEvent_ :: (HasCallStack) => EventWebSocket -> App ()
assertNoEvent_ :: HasCallStack => EventWebSocket -> App ()
assertNoEvent_ = App NoEvent -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App NoEvent -> App ())
-> (EventWebSocket -> App NoEvent) -> EventWebSocket -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => EventWebSocket -> App NoEvent
EventWebSocket -> App NoEvent
assertNoEventHelper

assertWebSocketDied :: (HasCallStack) => EventWebSocket -> App ()
assertWebSocketDied :: HasCallStack => EventWebSocket -> App ()
assertWebSocketDied EventWebSocket
ws = do
  RetryPolicyM App
recpol <- do
    Int
timeOutSeconds <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
    RetryPolicyM App -> App (RetryPolicyM App)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RetryPolicyM App -> App (RetryPolicyM App))
-> RetryPolicyM App -> App (RetryPolicyM App)
forall a b. (a -> b) -> a -> b
$ Int -> RetryPolicyM App -> RetryPolicyM App
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Int -> RetryPolicyM App
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
800_000)
  RetryPolicyM App -> (RetryStatus -> App ()) -> App ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM App
recpol ((RetryStatus -> App ()) -> App ())
-> (RetryStatus -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ ->
    HasCallStack => EventWebSocket -> App NoEvent
EventWebSocket -> App NoEvent
assertNoEventHelper EventWebSocket
ws App NoEvent -> (NoEvent -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      NoEvent
NoEvent -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"WebSocket is still open"
      NoEvent
WebSocketDied -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

consumeEventsUntilEndOfInitialSync :: (HasCallStack) => EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync :: HasCallStack => EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
expectedMarkerId = [Value] -> App [Value]
go []
  where
    go :: [Value] -> App [Value]
go [Value]
events = do
      Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
1_000_000 (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> 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
>>= \case
        Maybe (Either ConnectionException Value)
Nothing ->
          String -> [Value] -> App [Value] -> App [Value]
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"events" [Value]
events
            (App [Value] -> App [Value]) -> App [Value] -> App [Value]
forall a b. (a -> b) -> a -> b
$ String -> App [Value]
forall a. HasCallStack => String -> App a
assertFailure String
"timed out waiting for end-of-initial-sync event"
        Just (Left ConnectionException
e) ->
          String -> App [Value]
forall a. HasCallStack => String -> App a
assertFailure
            (String -> App [Value]) -> String -> App [Value]
forall a b. (a -> b) -> a -> b
$ String
"Websocket closed while waiting for end-of-initial-sync event "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> String
forall e. Exception e => e -> String
displayException ConnectionException
e
        Just (Right Value
e) -> do
          HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
          String
t <- Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" 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
          if (String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"synchronization")
            then do
              String
markerId <- Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.marker_id" 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
              if (String
markerId String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expectedMarkerId)
                then [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value]
events [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value
e])
                else String -> App [Value]
forall a. HasCallStack => String -> App a
assertFailure (String -> App [Value]) -> String -> App [Value]
forall a b. (a -> b) -> a -> b
$ String
"Expected marker_id " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expectedMarkerId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
markerId
            else [Value] -> App [Value]
go ([Value]
events [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value
e])

assertEndOfIniitalSync :: (HasCallStack) => EventWebSocket -> String -> App ()
assertEndOfIniitalSync :: HasCallStack => EventWebSocket -> String -> App ()
assertEndOfIniitalSync EventWebSocket
ws String
endMarker =
  EventWebSocket -> (HasCallStack => Value -> App ()) -> App ()
forall a.
HasCallStack =>
EventWebSocket -> (HasCallStack => Value -> App a) -> App a
assertEvent EventWebSocket
ws ((HasCallStack => Value -> App ()) -> App ())
-> (HasCallStack => Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
e -> do
    Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"synchronization"
    Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.marker_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
endMarker

consumeAllEvents_ :: EventWebSocket -> App ()
consumeAllEvents_ :: EventWebSocket -> App ()
consumeAllEvents_ = App [Value] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Value] -> App ())
-> (EventWebSocket -> App [Value]) -> EventWebSocket -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventWebSocket -> App [Value]
consumeAllEvents

emptyQueue :: (HasCallStack, MakesValue user) => user -> String -> App ()
emptyQueue :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App ()
emptyQueue user
user String
cid = do
  Codensity App (String, EventWebSocket)
-> forall b. ((String, EventWebSocket) -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (user -> Maybe String -> Codensity App (String, EventWebSocket)
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> Codensity App (String, EventWebSocket)
createEventsWebSocketWithSync user
user (String -> Maybe String
forall a. a -> Maybe a
Just String
cid)) (((String, EventWebSocket) -> App ()) -> App ())
-> ((String, EventWebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
endMarker, EventWebSocket
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 => EventWebSocket -> String -> App [Value]
EventWebSocket -> String -> App [Value]
consumeEventsUntilEndOfInitialSync EventWebSocket
ws String
endMarker

consumeAllEvents :: EventWebSocket -> App [Value]
consumeAllEvents :: EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws = do
  Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
1_000_000 (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> 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
>>= \case
    Maybe (Either ConnectionException Value)
Nothing -> [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just (Left ConnectionException
e) ->
      String -> App [Value]
forall a. HasCallStack => String -> App a
assertFailure
        (String -> App [Value]) -> String -> App [Value]
forall a b. (a -> b) -> a -> b
$ String
"Websocket closed while consuming all events: "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> String
forall e. Exception e => e -> String
displayException ConnectionException
e
    Just (Right Value
e) -> do
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e
      (Value
e :) ([Value] -> [Value]) -> App [Value] -> App [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventWebSocket -> App [Value]
consumeAllEvents EventWebSocket
ws

consumeAllEventsNoAck :: EventWebSocket -> App [Value]
consumeAllEventsNoAck :: EventWebSocket -> App [Value]
consumeAllEventsNoAck EventWebSocket
ws = do
  Int
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
1_000_000 (Chan (Either ConnectionException Value)
-> App (Either ConnectionException Value)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan EventWebSocket
ws.events) App (Maybe (Either ConnectionException Value))
-> (Maybe (Either ConnectionException Value) -> 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
>>= \case
    Maybe (Either ConnectionException Value)
Nothing -> [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just (Left ConnectionException
e) ->
      String -> App [Value]
forall a. HasCallStack => String -> App a
assertFailure
        (String -> App [Value]) -> String -> App [Value]
forall a b. (a -> b) -> a -> b
$ String
"Websocket closed while consuming all events: "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnectionException -> String
forall e. Exception e => e -> String
displayException ConnectionException
e
    Just (Right Value
e) -> do
      (Value
e :) ([Value] -> [Value]) -> App [Value] -> App [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventWebSocket -> App [Value]
consumeAllEventsNoAck EventWebSocket
ws

-- | Only considers connections from cannon
waitUntilNoRabbitMqConns :: (HasCallStack) => BackendResource -> App ()
waitUntilNoRabbitMqConns :: HasCallStack => BackendResource -> App ()
waitUntilNoRabbitMqConns BackendResource
backend = do
  AdminAPI (AsClientT App)
rabbitmqAdminClient <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
backend
  RetryPolicyM App -> (RetryStatus -> App ()) -> App ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll
    (Int -> RetryPolicyM App
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
500_000 RetryPolicyM App -> RetryPolicyM App -> RetryPolicyM App
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
10)
    (App () -> RetryStatus -> App ()
forall a b. a -> b -> a
const (AdminAPI (AsClientT App) -> App ()
go AdminAPI (AsClientT App)
rabbitmqAdminClient))
  where
    go :: AdminAPI (AsClientT App) -> App ()
go AdminAPI (AsClientT App)
rabbitmqAdminClient = do
      [Connection]
cannonConnections <- AdminAPI (AsClientT App) -> String -> App [Connection]
getCannonConnections AdminAPI (AsClientT App)
rabbitmqAdminClient BackendResource
backend.berVHost
      [Connection]
cannonConnections [Connection] -> [Connection] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Connection])

-- | Only kills connections from cannon and returns them
killAllRabbitMqConns :: (HasCallStack) => BackendResource -> App [Connection]
killAllRabbitMqConns :: HasCallStack => BackendResource -> App [Connection]
killAllRabbitMqConns BackendResource
backend = do
  AdminAPI (AsClientT App)
rabbitmqAdminClient <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
backend
  [Connection]
cannonConnections <- AdminAPI (AsClientT App) -> String -> App [Connection]
getCannonConnections AdminAPI (AsClientT App)
rabbitmqAdminClient BackendResource
backend.berVHost
  [Connection] -> (Connection -> App NoContent) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Connection]
cannonConnections ((Connection -> App NoContent) -> App ())
-> (Connection -> App NoContent) -> App ()
forall a b. (a -> b) -> a -> b
$ \Connection
connection ->
    AdminAPI (AsClientT App)
rabbitmqAdminClient.deleteConnection Connection
connection.name
  [Connection] -> App [Connection]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Connection]
cannonConnections

getCannonConnections :: AdminAPI (AsClientT App) -> String -> App [Connection]
getCannonConnections :: AdminAPI (AsClientT App) -> String -> App [Connection]
getCannonConnections AdminAPI (AsClientT App)
rabbitmqAdminClient String
vhost = do
  [Connection]
connections <- AdminAPI (AsClientT App)
rabbitmqAdminClient.listConnectionsByVHost (String -> VHost
Text.pack String
vhost)
  [Connection] -> App [Connection]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Connection] -> App [Connection])
-> [Connection] -> App [Connection]
forall a b. (a -> b) -> a -> b
$ (Connection -> Bool) -> [Connection] -> [Connection]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Connection
c -> Bool -> (VHost -> Bool) -> Maybe VHost -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> VHost
forall a. IsString a => String -> a
fromString String
"pool " `Text.isPrefixOf`) Connection
c.userProvidedName) [Connection]
connections

mkRabbitMqAdminClientForResource :: BackendResource -> App (AdminAPI (Servant.AsClientT App))
mkRabbitMqAdminClientForResource :: BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
backend = do
  RabbitMqAdminOpts
opts <- (Env -> RabbitMqAdminOpts) -> App RabbitMqAdminOpts
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.rabbitMQConfig)
  AdminAPI (AsClientT IO)
servantClient <- IO (AdminAPI (AsClientT IO)) -> App (AdminAPI (AsClientT IO))
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AdminAPI (AsClientT IO)) -> App (AdminAPI (AsClientT IO)))
-> IO (AdminAPI (AsClientT IO)) -> App (AdminAPI (AsClientT IO))
forall a b. (a -> b) -> a -> b
$ RabbitMqAdminOpts -> IO (AdminAPI (AsClientT IO))
mkRabbitMqAdminClientEnv RabbitMqAdminOpts
opts {vHost = Text.pack backend.berVHost}
  AdminAPI (AsClientT App) -> App (AdminAPI (AsClientT App))
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AdminAPI (AsClientT App) -> App (AdminAPI (AsClientT App)))
-> ((((VHost -> VHost -> Bool -> Int -> Int -> App (Page Queue))
      :<|> (VHost -> VHost -> App NoContent))
     :<|> ((VHost -> App [Connection]) :<|> (VHost -> App NoContent)))
    -> AdminAPI (AsClientT App))
-> (((VHost -> VHost -> Bool -> Int -> Int -> App (Page Queue))
     :<|> (VHost -> VHost -> App NoContent))
    :<|> ((VHost -> App [Connection]) :<|> (VHost -> App NoContent)))
-> App (AdminAPI (AsClientT App))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((VHost -> VHost -> Bool -> Int -> Int -> App (Page Queue))
  :<|> (VHost -> VHost -> App NoContent))
 :<|> ((VHost -> App [Connection]) :<|> (VHost -> App NoContent)))
-> AdminAPI (AsClientT App)
ToServant AdminAPI (AsClientT App) -> AdminAPI (AsClientT App)
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant ((((VHost -> VHost -> Bool -> Int -> Int -> App (Page Queue))
   :<|> (VHost -> VHost -> App NoContent))
  :<|> ((VHost -> App [Connection]) :<|> (VHost -> App NoContent)))
 -> App (AdminAPI (AsClientT App)))
-> (((VHost -> VHost -> Bool -> Int -> Int -> App (Page Queue))
     :<|> (VHost -> VHost -> App NoContent))
    :<|> ((VHost -> App [Connection]) :<|> (VHost -> App NoContent)))
-> App (AdminAPI (AsClientT App))
forall a b. (a -> b) -> a -> b
$ Proxy
  ((("api"
     :> ("queues"
         :> (Capture "vhost" VHost
             :> (QueryParam' '[Required, Strict] "name" VHost
                 :> (QueryParam' '[Required, Strict] "use_regex" Bool
                     :> (QueryParam' '[Required, Strict] "page_size" Int
                         :> (QueryParam' '[Required, Strict] "page" Int
                             :> Get '[JSON] (Page Queue))))))))
    :<|> ("api"
          :> ("queues"
              :> (Capture "vhost" VHost
                  :> (Capture "queue" VHost :> DeleteNoContent)))))
   :<|> (("api"
          :> ("vhosts"
              :> (Capture "vhost" VHost
                  :> ("connections" :> Get '[JSON] [Connection]))))
         :<|> ("api"
               :> ("connections" :> (Capture "name" VHost :> DeleteNoContent)))))
-> (forall a. IO a -> App a)
-> Client
     IO
     ((("api"
        :> ("queues"
            :> (Capture "vhost" VHost
                :> (QueryParam' '[Required, Strict] "name" VHost
                    :> (QueryParam' '[Required, Strict] "use_regex" Bool
                        :> (QueryParam' '[Required, Strict] "page_size" Int
                            :> (QueryParam' '[Required, Strict] "page" Int
                                :> Get '[JSON] (Page Queue))))))))
       :<|> ("api"
             :> ("queues"
                 :> (Capture "vhost" VHost
                     :> (Capture "queue" VHost :> DeleteNoContent)))))
      :<|> (("api"
             :> ("vhosts"
                 :> (Capture "vhost" VHost
                     :> ("connections" :> Get '[JSON] [Connection]))))
            :<|> ("api"
                  :> ("connections" :> (Capture "name" VHost :> DeleteNoContent)))))
-> Client
     App
     ((("api"
        :> ("queues"
            :> (Capture "vhost" VHost
                :> (QueryParam' '[Required, Strict] "name" VHost
                    :> (QueryParam' '[Required, Strict] "use_regex" Bool
                        :> (QueryParam' '[Required, Strict] "page_size" Int
                            :> (QueryParam' '[Required, Strict] "page" Int
                                :> Get '[JSON] (Page Queue))))))))
       :<|> ("api"
             :> ("queues"
                 :> (Capture "vhost" VHost
                     :> (Capture "queue" VHost :> DeleteNoContent)))))
      :<|> (("api"
             :> ("vhosts"
                 :> (Capture "vhost" VHost
                     :> ("connections" :> Get '[JSON] [Connection]))))
            :<|> ("api"
                  :> ("connections" :> (Capture "name" VHost :> DeleteNoContent)))))
forall api (m :: * -> *) (n :: * -> *).
HasClient ClientM api =>
Proxy api -> (forall a. m a -> n a) -> Client m api -> Client n api
Servant.hoistClient (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ToServant AdminAPI AsApi)) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO @App) (AdminAPI (AsClientT IO) -> ToServant AdminAPI (AsClientT IO)
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant AdminAPI (AsClientT IO)
servantClient)