module Test.Events where

import API.Brig
import API.BrigCommon
import API.Common
import API.Galley
import API.Gundeck
import qualified Control.Concurrent.Timeout as Timeout
import Control.Monad.Codensity
import Control.Monad.RWS (asks)
import Control.Monad.Trans.Class
import Control.Retry
import Data.ByteString.Conversion (toByteString')
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 SetupHelpers
import Testlib.Prelude hiding (assertNoEvent)
import Testlib.ResourcePool (acquireResources)
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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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"

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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
aliceClientId
    EventWebSocket
bobWS <- Value -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
bob 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
newClientId) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws ->
      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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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

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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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
"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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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 <- 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

  -- 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

  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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
clientId) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    EventWebSocket -> App ()
consumeAllEvents EventWebSocket
ws
    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
    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.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 -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
selfConvId
      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

  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

  Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus Value
alice Value
selfConvId 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
alice 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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
clientId) ((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 -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice 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
        EventWebSocket
ws <- Value -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
client0
        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

testChannelKilled :: (HasCallStack) => App ()
testChannelKilled :: HasCallStack => App ()
testChannelKilled = 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
  ResourcePool BackendResource
pool <- App (ResourcePool BackendResource)
-> Codensity App (ResourcePool BackendResource)
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 (ResourcePool BackendResource)
 -> Codensity App (ResourcePool BackendResource))
-> App (ResourcePool BackendResource)
-> Codensity App (ResourcePool BackendResource)
forall a b. (a -> b) -> a -> b
$ (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  [BackendResource
backend] <- 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
  String
domain <- HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend ServiceOverrides
forall a. Monoid a => a
mempty
  Value
alice <- 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
$ 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] <-
    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
$ 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

  EventWebSocket
ws <- Value -> String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice String
c1
  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 -> (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
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

      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 (HasCallStack => BackendResource -> App ()
BackendResource -> App ()
killConnection BackendResource
backend))

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

----------------------------------------------------------------------
-- helpers

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

createEventsWebSocket ::
  (HasCallStack, MakesValue uid) =>
  uid ->
  String ->
  Codensity App EventWebSocket
createEventsWebSocket :: forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> Codensity App EventWebSocket
createEventsWebSocket uid
user String
cid = 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
=<< uid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain uid
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
$ uid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain uid
user
  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)

  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
=<< uid -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject uid
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?client=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cid
      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 =
        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 () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
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 -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendClose Connection
conn (String -> Text
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
$ \Async () -> App b
k -> do
    App () -> (Async () -> App b) -> App b
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync
      ( 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
      )
      Async () -> App b
k

  (forall b. (EventWebSocket -> App b) -> App b)
-> Codensity App EventWebSocket
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (EventWebSocket -> App b) -> App b)
 -> Codensity App EventWebSocket)
-> (forall b. (EventWebSocket -> App b) -> App b)
-> Codensity App EventWebSocket
forall a b. (a -> b) -> a -> b
$ \EventWebSocket -> App b
k ->
    EventWebSocket -> App b
k (Chan (Either ConnectionException Value)
-> MVar (Maybe Value) -> EventWebSocket
EventWebSocket Chan (Either ConnectionException Value)
eventsChan MVar (Maybe Value)
ackChan) 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
            ]
      ]

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
-> App (Either ConnectionException Value)
-> App (Maybe (Either ConnectionException Value))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
10_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
"No event received for 1s"
    Just (Left ConnectionException
_) -> 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

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"

assertNoEvent :: (HasCallStack) => EventWebSocket -> App NoEvent
assertNoEvent :: HasCallStack => EventWebSocket -> App NoEvent
assertNoEvent 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 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

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
assertNoEvent

consumeAllEvents :: EventWebSocket -> App ()
consumeAllEvents :: EventWebSocket -> App ()
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 ()) -> 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
    Maybe (Either ConnectionException Value)
Nothing -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (Left ConnectionException
e) ->
      String -> App ()
forall a. HasCallStack => String -> App a
assertFailure
        (String -> App ()) -> String -> App ()
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
      EventWebSocket -> App ()
consumeAllEvents EventWebSocket
ws

killConnection :: (HasCallStack) => BackendResource -> App ()
killConnection :: HasCallStack => BackendResource -> App ()
killConnection BackendResource
backend = do
  RabbitMQConfig
rc <- (Env -> RabbitMQConfig) -> App RabbitMQConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.rabbitMQConfig)
  let opts :: RabbitMqAdminOpts
opts =
        RabbitMqAdminOpts
          { $sel:host:RabbitMqAdminOpts :: String
host = RabbitMQConfig
rc.host,
            $sel:port:RabbitMqAdminOpts :: Int
port = Int
0,
            $sel:adminPort:RabbitMqAdminOpts :: Int
adminPort = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RabbitMQConfig
rc.adminPort,
            $sel:vHost:RabbitMqAdminOpts :: Text
vHost = String -> Text
Text.pack BackendResource
backend.berVHost,
            $sel:tls:RabbitMqAdminOpts :: Maybe RabbitMqTlsOpts
tls = RabbitMqTlsOpts -> Maybe RabbitMqTlsOpts
forall a. a -> Maybe a
Just (RabbitMqTlsOpts -> Maybe RabbitMqTlsOpts)
-> RabbitMqTlsOpts -> Maybe RabbitMqTlsOpts
forall a b. (a -> b) -> a -> b
$ Maybe String -> Bool -> RabbitMqTlsOpts
RabbitMqTlsOpts Maybe String
forall a. Maybe a
Nothing Bool
True
          }
  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
  Text
name <- do
    [Connection]
connections <- IO [Connection] -> App [Connection]
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Connection] -> App [Connection])
-> IO [Connection] -> App [Connection]
forall a b. (a -> b) -> a -> b
$ AdminAPI (AsClientT IO)
-> AsClientT IO
   :- ("api"
       :> ("vhosts"
           :> (Capture "vhost" Text
               :> ("connections" :> Get '[JSON] [Connection]))))
forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("vhosts"
           :> (Capture "vhost" Text
               :> ("connections" :> Get '[JSON] [Connection]))))
listConnectionsByVHost AdminAPI (AsClientT IO)
servantClient RabbitMqAdminOpts
opts.vHost
    Connection
connection <-
      [Connection] -> App Connection
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
        [ Connection
c | Connection
c <- [Connection]
connections, Connection
c.userProvidedName Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Text.pack String
"pool 0")
        ]
    Text -> App Text
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
connection.name

  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
$ IO NoContent -> App NoContent
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NoContent -> App NoContent) -> IO NoContent -> App NoContent
forall a b. (a -> b) -> a -> b
$ AdminAPI (AsClientT IO)
-> AsClientT IO
   :- ("api"
       :> ("connections" :> (Capture "name" Text :> DeleteNoContent)))
forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("connections" :> (Capture "name" Text :> DeleteNoContent)))
deleteConnection AdminAPI (AsClientT IO)
servantClient Text
name