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 Data.Proxy (Proxy (..))
import qualified Data.Text as Text
import Data.Timeout
import MLS.Util
import Network.AMQP.Extended
import Network.RabbitMqAdmin
import qualified Network.WebSockets as WS
import Notifications
import Servant.API (AsApi, ToServant, toServant)
import Servant.API.Generic (fromServant)
import qualified Servant.Client as Servant
import SetupHelpers
import Testlib.Prelude hiding (assertNoEvent)
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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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"

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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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

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

  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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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

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

testTemporaryQueuesAreDeletedAfterUse :: (HasCallStack) => App ()
testTemporaryQueuesAreDeletedAfterUse :: HasCallStack => App ()
testTemporaryQueuesAreDeletedAfterUse = do
  [ServiceOverrides] -> ([BackendResource] -> App ()) -> App ()
forall a.
[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
    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
    let deadNotifsQueue :: Queue
deadNotifsQueue = Queue {$sel:name:Queue :: VHost
name = String -> VHost
forall a. IsString a => String -> a
fromString String
"dead-user-notifications", $sel:vhost:Queue :: VHost
vhost = String -> VHost
forall a. IsString a => String -> a
fromString BackendResource
beResource.berVHost}
    Page Queue
queuesBeforeWS.items [Queue] -> [Queue] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Queue
deadNotifsQueue]

    [Value
alice, Value
bob] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain]

    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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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
2

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

    -- Use let binding here so 'shouldMatchEventually' retries the whole request
    let queuesAfterWSM :: App (Page Queue)
queuesAfterWSM = 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 -> [Queue]) -> App (Page Queue) -> App [Queue]
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.items) App (Page Queue)
queuesAfterWSM App [Queue] -> [Queue] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldEventuallyMatch` ([Queue
deadNotifsQueue])

testMLSTempEvents :: (HasCallStack) => App ()
testMLSTempEvents :: HasCallStack => App ()
testMLSTempEvents = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  clients :: [ClientIdentity]
clients@[ClientIdentity
alice1, ClientIdentity
_, ClientIdentity
_] <-
    (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
      ( Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient
          Ciphersuite
forall a. Default a => a
def
          InitMLSClient
forall a. Default a => a
def
            { clientArgs =
                def
                  { acapabilities = Just ["consumable-notifications"]
                  }
            }
      )
      [Value
alice, Value
bob, Value
bob]

  (ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity]
clients
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  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 uid.
(HasCallStack, MakesValue uid) =>
uid -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
bob Maybe String
forall a. Maybe a
Nothing) ((EventWebSocket -> App ()) -> App ())
-> (EventWebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \EventWebSocket
ws -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
commit.sender (MessagePackage -> ByteString
mkBundle MessagePackage
commit) 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

    -- FUTUREWORK: we should not rely on events arriving in this particular order

    -- 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
"conversation.member-join"
      Value
user <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.event.payload.0.data.users" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList)
      Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" 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
ws Value
e

    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
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
"conversation.mls-welcome"
      HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent EventWebSocket
ws Value
e

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

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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 ->
      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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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

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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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
"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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 <- 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 -> Maybe String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> 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 -> 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 -> Maybe String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> 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
    [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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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
        EventWebSocket
ws <- Value -> Maybe String -> Codensity App EventWebSocket
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just 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 = [ServiceOverrides] -> ([BackendResource] -> App ()) -> App ()
forall a.
[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
backend] -> 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 uid.
(HasCallStack, MakesValue uid) =>
uid -> 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
    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 ->
  Maybe String ->
  Codensity App EventWebSocket
createEventsWebSocket :: forall uid.
(HasCallStack, MakesValue uid) =>
uid -> Maybe String -> Codensity App EventWebSocket
createEventsWebSocket uid
user Maybe 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" 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
      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 -> 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
$ \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
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
_) -> 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 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
_) -> 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
=<< Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
ev String
"data.event.payload.0.type"
              HasCallStack => EventWebSocket -> Value -> App ()
EventWebSocket -> Value -> App ()
ackEvent 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"

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
  AdminAPI (AsClientT App)
rabbitmqAdminClient <- BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource BackendResource
backend
  [Connection]
connections <- AdminAPI (AsClientT App)
rabbitmqAdminClient.listConnectionsByVHost (String -> VHost
Text.pack BackendResource
backend.berVHost)
  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 VHost -> Maybe VHost -> Bool
forall a. Eq a => a -> a -> Bool
== VHost -> Maybe VHost
forall a. a -> Maybe a
Just (String -> VHost
Text.pack String
"pool 0")
      ]
  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.deleteConnection Connection
connection.name

mkRabbitMqAdminClientForResource :: BackendResource -> App (AdminAPI (Servant.AsClientT App))
mkRabbitMqAdminClientForResource :: BackendResource -> App (AdminAPI (AsClientT App))
mkRabbitMqAdminClientForResource 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 :: VHost
vHost = String -> VHost
Text.pack BackendResource
backend.berVHost,
            $sel:tls:RabbitMqAdminOpts :: Maybe RabbitMqTlsOpts
tls =
              if RabbitMQConfig
rc.tls
                then 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
                else Maybe RabbitMqTlsOpts
forall a. Maybe a
Nothing
          }
  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
  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)