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

module Test.Cells where

import API.Galley
import qualified API.GalleyInternal as I
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import qualified Control.Exception as E
import Control.Monad.Codensity
import Control.Monad.Reader
import Control.Retry
import qualified Data.Aeson as A
import Data.IORef
import qualified Data.Map as Map
import Network.AMQP
import Network.AMQP.Extended
import Notifications
import SetupHelpers
import System.Timeout
import Testlib.Prelude

testCellsEvent :: (HasCallStack) => App ()
testCellsEvent :: HasCallStack => App ()
testCellsEvent = do
  (Value
alice, String
tid, [Value
bob, Value
chaz, Value
dean, Value
eve]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  QueueConsumer
q <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents (Value -> WatchCellsEvents
forall conv. MakesValue conv => conv -> WatchCellsEvents
convEvents Value
conv)

  Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  Value
chazId <- Value
chaz Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  Value
deanId <- Value
dean Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  Value
eveId <- Value
eve Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"

  Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {role = Just "wire_member", users = [bobId]} 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.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"pending" 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 -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {role = Just "wire_member", users = [chazId]} 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

  do
    Value
event <- QueueConsumer -> App Value
getMessage QueueConsumer
q App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0"
    Value
event 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
"conversation.member-join"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" 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
objId)
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
users <- Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
users App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
chazId

  Value -> Value -> String -> App Response
forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"ready" 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 -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {role = Just "wire_member", users = [deanId]} 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

  do
    Value
event <- QueueConsumer -> App Value
getMessage QueueConsumer
q App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0"
    Value
event 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
"conversation.member-join"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" 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
objId)
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
users <- Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
users App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
deanId

  Value -> Value -> String -> App Response
forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"disabled" 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 -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {role = Just "wire_member", users = [eveId]} 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

  QueueConsumer -> App ()
assertNoMessage QueueConsumer
q

testCellsCreationEvent :: (HasCallStack) => App ()
testCellsCreationEvent :: HasCallStack => App ()
testCellsCreationEvent = do
  -- start watcher before creating conversation
  QueueConsumer
q0 <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents WatchCellsEvents
forall a. Default a => a
def
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid, cells = True} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

  let q :: QueueConsumer
q = QueueConsumer
q0 {filter = isNotifConv conv} :: QueueConsumer

  Value
event <- QueueConsumer -> App Value
getMessage QueueConsumer
q App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0"
  Value
event 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
"conversation.create"
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation.id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")

  QueueConsumer -> App ()
assertNoMessage QueueConsumer
q

testCellsDeletionEvent :: (HasCallStack) => App ()
testCellsDeletionEvent :: HasCallStack => App ()
testCellsDeletionEvent = do
  -- start watcher before creating conversation
  QueueConsumer
q0 <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents WatchCellsEvents
forall a. Default a => a
def
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid, cells = True} 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 () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
tid Value
conv Value
alice 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

  let q :: QueueConsumer
q = QueueConsumer
q0 {filter = isConvDeleteNotif} :: QueueConsumer

  Value
event <- QueueConsumer -> App Value
getMessage QueueConsumer
q App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0"
  Value
event 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
"conversation.delete"
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid

  QueueConsumer -> App ()
assertNoMessage QueueConsumer
q

testCellsCreationEventIsSentOnlyOnce :: (HasCallStack) => App ()
testCellsCreationEventIsSentOnlyOnce :: HasCallStack => App ()
testCellsCreationEventIsSentOnlyOnce = do
  -- start watcher before creating conversation
  QueueConsumer
q0 <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents WatchCellsEvents
forall a. Default a => a
def
  (Value
alice, String
tid, [Value]
members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid, cells = True, qualifiedUsers = members} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

  let q :: QueueConsumer
q = QueueConsumer
q0 {filter = isNotifConv conv} :: QueueConsumer

  Value
event <- QueueConsumer -> App Value
getMessage QueueConsumer
q App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0"
  Value
event 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
"conversation.create"
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation.id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")

  QueueConsumer -> App ()
assertNoMessage QueueConsumer
q

testCellsFeatureCheck :: (HasCallStack) => App ()
testCellsFeatureCheck :: HasCallStack => App ()
testCellsFeatureCheck = do
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Domain -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
I.patchTeamFeatureConfig Domain
OwnDomain String
tid String
"cells" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled"]) 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
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> App Response
forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"ready") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"invalid-op"

testCellsEventOnFeatureToggle :: (HasCallStack) => App ()
testCellsEventOnFeatureToggle :: HasCallStack => App ()
testCellsEventOnFeatureToggle = do
  QueueConsumer
q0 <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents WatchCellsEvents
forall a. Default a => a
def
  (Value
_, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Domain -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
I.patchTeamFeatureConfig Domain
OwnDomain String
tid String
"cells" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled"]) 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
  QueueConsumer -> App Value
getMessage QueueConsumer
q0 App Value -> (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
>>= \Value
event -> do
    Value
event 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
"feature-config.update"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"cells"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString String
tid)
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
  Domain -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
I.patchTeamFeatureConfig Domain
OwnDomain String
tid String
"cells" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"]) 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
  QueueConsumer -> App Value
getMessage QueueConsumer
q0 App Value -> (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
>>= \Value
event -> do
    Value
event 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
"feature-config.update"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"cells"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString String
tid)
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

testCellsTeamConversationCheck :: (HasCallStack) => App ()
testCellsTeamConversationCheck :: HasCallStack => App ()
testCellsTeamConversationCheck = 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
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus 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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> App Response
forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"ready") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"invalid-op"

testCellsIgnoredEvents :: (HasCallStack) => App ()
testCellsIgnoredEvents :: HasCallStack => App ()
testCellsIgnoredEvents = do
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  Value -> Value -> String -> App Response
forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
I.setCellsState Value
alice Value
conv String
"ready" 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
  QueueConsumer
q <- WatchCellsEvents -> App QueueConsumer
watchCellsEvents (Value -> WatchCellsEvents
forall conv. MakesValue conv => conv -> WatchCellsEvents
convEvents Value
conv)
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> LongLongInt -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> LongLongInt -> App Response
updateMessageTimer Value
alice Value
conv LongLongInt
1000 App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
  QueueConsumer -> App ()
assertNoMessage QueueConsumer
q

--------------------------------------------------------------------------------
-- Utilities

connectToCellsQueue :: ServiceMap -> TChan Message -> Codensity App ()
connectToCellsQueue :: ServiceMap -> TChan Message -> Codensity App ()
connectToCellsQueue ServiceMap
sm TChan Message
messages = do
  String
queueName <- 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
$ (Env -> String) -> App String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.cellsEventQueue)

  Env
env <- App Env -> Codensity App Env
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 Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: AmqpEndpoint
opts = (RabbitMqAdminOpts -> AmqpEndpoint
demoteOpts Env
env.rabbitMQConfig :: AmqpEndpoint) {vHost = sm.rabbitMqVHost}
  let createConnection :: IO Connection
      createConnection :: IO Connection
createConnection =
        RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO Connection)
-> IO Connection
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering
          (Int -> RetryPolicy
limitRetries Int
5)
          [RetryStatus -> Handler IO Bool]
forall (m :: * -> *). MonadIO m => [RetryStatus -> Handler m Bool]
skipAsyncExceptions
          ( IO Connection -> RetryStatus -> IO Connection
forall a b. a -> b -> a
const (IO Connection -> RetryStatus -> IO Connection)
-> IO Connection -> RetryStatus -> IO Connection
forall a b. (a -> b) -> a -> b
$ do
              ConnectionOpts
connOpts <-
                AmqpEndpoint -> Maybe Text -> IO ConnectionOpts
forall (m :: * -> *).
MonadIO m =>
AmqpEndpoint -> Maybe Text -> m ConnectionOpts
mkConnectionOpts AmqpEndpoint
opts Maybe Text
forall k1. Maybe k1
Nothing
              IO Connection -> IO Connection
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ ConnectionOpts -> IO Connection
openConnection'' ConnectionOpts
connOpts
          )
  Connection
conn <-
    Codensity IO Connection -> Codensity App Connection
forall a. Codensity IO a -> Codensity App a
hoistCodensity
      (Codensity IO Connection -> Codensity App Connection)
-> Codensity IO Connection -> Codensity App Connection
forall a b. (a -> b) -> a -> b
$ (forall b. (Connection -> IO b) -> IO b) -> Codensity IO Connection
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity
      ((forall b. (Connection -> IO b) -> IO b)
 -> Codensity IO Connection)
-> (forall b. (Connection -> IO b) -> IO b)
-> Codensity IO Connection
forall a b. (a -> b) -> a -> b
$ IO Connection
-> (Connection -> IO ()) -> (Connection -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO Connection
createConnection Connection -> IO ()
closeConnection

  Channel
chan <-
    Codensity IO Channel -> Codensity App Channel
forall a. Codensity IO a -> Codensity App a
hoistCodensity
      (Codensity IO Channel -> Codensity App Channel)
-> Codensity IO Channel -> Codensity App Channel
forall a b. (a -> b) -> a -> b
$ (forall b. (Channel -> IO b) -> IO b) -> Codensity IO Channel
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity
      ((forall b. (Channel -> IO b) -> IO b) -> Codensity IO Channel)
-> (forall b. (Channel -> IO b) -> IO b) -> Codensity IO Channel
forall a b. (a -> b) -> a -> b
$ IO Channel -> (Channel -> IO ()) -> (Channel -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Connection -> IO Channel
openChannel Connection
conn) Channel -> IO ()
closeChannel

  (Message, Envelope) -> IO ()
handler <- App ((Message, Envelope) -> IO ())
-> Codensity App ((Message, Envelope) -> IO ())
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 ((Message, Envelope) -> IO ())
 -> Codensity App ((Message, Envelope) -> IO ()))
-> App ((Message, Envelope) -> IO ())
-> Codensity App ((Message, Envelope) -> IO ())
forall a b. (a -> b) -> a -> b
$ ((Message, Envelope) -> App ())
-> App ((Message, Envelope) -> IO ())
forall a b. (a -> App b) -> App (a -> IO b)
appToIOKleisli (((Message, Envelope) -> App ())
 -> App ((Message, Envelope) -> IO ()))
-> ((Message, Envelope) -> App ())
-> App ((Message, Envelope) -> IO ())
forall a b. (a -> b) -> a -> b
$ \(Message
m, Envelope
e) -> do
    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
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Message -> Message -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Message
messages Message
m
    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
$ Channel -> LongLongInt -> Bool -> IO ()
ackMsg Channel
chan Envelope
e.envDeliveryTag Bool
False

  Codensity App Text -> Codensity App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (Codensity App Text -> Codensity App ())
-> (Codensity IO Text -> Codensity App Text)
-> Codensity IO Text
-> Codensity App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codensity IO Text -> Codensity App Text
forall a. Codensity IO a -> Codensity App a
hoistCodensity
    (Codensity IO Text -> Codensity App ())
-> Codensity IO Text -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ (forall b. (Text -> IO b) -> IO b) -> Codensity IO Text
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity
    ((forall b. (Text -> IO b) -> IO b) -> Codensity IO Text)
-> (forall b. (Text -> IO b) -> IO b) -> Codensity IO Text
forall a b. (a -> b) -> a -> b
$ IO Text -> (Text -> IO ()) -> (Text -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
      (Channel -> Text -> Ack -> ((Message, Envelope) -> IO ()) -> IO Text
consumeMsgs Channel
chan (String -> Text
forall a. IsString a => String -> a
fromString String
queueName) Ack
Ack (Message, Envelope) -> IO ()
handler)
      (Channel -> Text -> IO ()
cancelConsumer Channel
chan)

getNextMessage :: QueueConsumer -> App Value
getNextMessage :: QueueConsumer -> App Value
getNextMessage QueueConsumer
q = do
  Message
m <- IO Message -> App Message
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> App Message) -> IO Message -> App Message
forall a b. (a -> b) -> a -> b
$ STM Message -> IO Message
forall a. STM a -> IO a
atomically (STM Message -> IO Message) -> STM Message -> IO Message
forall a b. (a -> b) -> a -> b
$ TChan Message -> STM Message
forall a. TChan a -> STM a
readTChan QueueConsumer
q.chan
  Value
v <- (String -> App Value)
-> (Value -> App Value) -> Either String Value -> App Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> App Value
forall a. HasCallStack => String -> App a
assertFailure Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> App Value)
-> Either String Value -> App Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode Message
m.msgBody
  Bool
ok <- QueueConsumer
q.filter Value
v
  if Bool
ok
    then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
    else QueueConsumer -> App Value
getNextMessage QueueConsumer
q

getMessageMaybe :: QueueConsumer -> App (Maybe Value)
getMessageMaybe :: QueueConsumer -> App (Maybe Value)
getMessageMaybe QueueConsumer
q = do
  Int
timeOutSeconds <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.timeOutSeconds)
  IO Value
next <- App Value -> App (IO Value)
forall a. App a -> App (IO a)
appToIO (QueueConsumer -> App Value
getNextMessage QueueConsumer
q)
  IO (Maybe Value) -> App (Maybe Value)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Value) -> App (Maybe Value))
-> IO (Maybe Value) -> App (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Int -> IO Value -> IO (Maybe Value)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
timeOutSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) IO Value
next

getMessage :: QueueConsumer -> App Value
getMessage :: QueueConsumer -> App Value
getMessage QueueConsumer
q = QueueConsumer -> App (Maybe Value)
getMessageMaybe QueueConsumer
q App (Maybe Value) -> (Maybe 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
>>= String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"Cells queue timeout"

assertNoMessage :: QueueConsumer -> App ()
assertNoMessage :: QueueConsumer -> App ()
assertNoMessage QueueConsumer
f =
  QueueConsumer -> App (Maybe Value)
getMessageMaybe QueueConsumer
f App (Maybe Value) -> (Maybe 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 Value
Nothing -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Value
m -> do
      String
j <- Value -> App String
forall a. MakesValue a => a -> App String
prettyJSON Value
m
      String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected no message, got:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
j

--------------------------------------------------------------------------------
-- Queue watcher

data QueueConsumer = QueueConsumer
  { QueueConsumer -> TChan Message
chan :: TChan Message,
    QueueConsumer -> Value -> App Bool
filter :: Value -> App Bool
  }

startQueueWatcher :: ServiceMap -> App QueueWatcher
startQueueWatcher :: ServiceMap -> App QueueWatcher
startQueueWatcher ServiceMap
sm = do
  TChan Message
broadcast <- IO (TChan Message) -> App (TChan Message)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TChan Message)
forall a. IO (TChan a)
newBroadcastTChanIO
  MVar ()
readyVar <- IO (MVar ()) -> App (MVar ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> App (MVar ())) -> IO (MVar ()) -> App (MVar ())
forall a b. (a -> b) -> a -> b
$ IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
doneVar <- IO (MVar ()) -> App (MVar ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> App (MVar ())) -> IO (MVar ()) -> App (MVar ())
forall a b. (a -> b) -> a -> b
$ IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  IO ()
startIO <- App () -> App (IO ())
forall a. App a -> App (IO a)
appToIO (App () -> App (IO ())) -> App () -> App (IO ())
forall a b. (a -> b) -> a -> b
$ 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
    Codensity App () -> Codensity App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Codensity App () -> Codensity App ())
-> Codensity App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceMap -> TChan Message -> Codensity App ()
connectToCellsQueue ServiceMap
sm TChan Message
broadcast
    IO () -> Codensity App ()
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Codensity App ()) -> IO () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
readyVar ()
    IO () -> Codensity App ()
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Codensity App ()) -> IO () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
doneVar

  App (Async ()) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Async ()) -> App ()) -> App (Async ()) -> App ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> App (Async ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> App (Async ()))
-> IO (Async ()) -> App (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
startIO
  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
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
readyVar

  QueueWatcher -> App QueueWatcher
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueWatcher {MVar ()
doneVar :: MVar ()
doneVar :: MVar ()
doneVar, TChan Message
broadcast :: TChan Message
broadcast :: TChan Message
broadcast}

ensureWatcher :: String -> App QueueWatcher
ensureWatcher :: String -> App QueueWatcher
ensureWatcher String
domain = do
  MVar ()
watchersLock <- (Env -> MVar ()) -> App (MVar ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.cellsEventWatchersLock)
  IORef (Map String QueueWatcher)
watchersRef <- (Env -> IORef (Map String QueueWatcher))
-> App (IORef (Map String QueueWatcher))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.cellsEventWatchers)
  Map String ServiceMap
serviceMaps <- (Env -> Map String ServiceMap) -> App (Map String ServiceMap)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.serviceMap)
  ServiceMap
sm <- Maybe ServiceMap -> App ServiceMap
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (Maybe ServiceMap -> App ServiceMap)
-> Maybe ServiceMap -> App ServiceMap
forall a b. (a -> b) -> a -> b
$ String -> Map String ServiceMap -> Maybe ServiceMap
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
domain Map String ServiceMap
serviceMaps

  IO QueueWatcher
start <- App QueueWatcher -> App (IO QueueWatcher)
forall a. App a -> App (IO a)
appToIO (ServiceMap -> App QueueWatcher
startQueueWatcher ServiceMap
sm)

  IO QueueWatcher -> App QueueWatcher
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO QueueWatcher -> App QueueWatcher)
-> IO QueueWatcher -> App QueueWatcher
forall a b. (a -> b) -> a -> b
$ IO ()
-> (() -> IO (Maybe ()))
-> (() -> IO QueueWatcher)
-> IO QueueWatcher
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
      (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
watchersLock ())
      (\()
_ -> MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
watchersLock)
    ((() -> IO QueueWatcher) -> IO QueueWatcher)
-> (() -> IO QueueWatcher) -> IO QueueWatcher
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
      Map String QueueWatcher
watchers <- IO (Map String QueueWatcher) -> IO (Map String QueueWatcher)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map String QueueWatcher) -> IO (Map String QueueWatcher))
-> IO (Map String QueueWatcher) -> IO (Map String QueueWatcher)
forall a b. (a -> b) -> a -> b
$ IORef (Map String QueueWatcher) -> IO (Map String QueueWatcher)
forall a. IORef a -> IO a
readIORef IORef (Map String QueueWatcher)
watchersRef
      case String -> Map String QueueWatcher -> Maybe QueueWatcher
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
domain Map String QueueWatcher
watchers of
        Maybe QueueWatcher
Nothing -> do
          QueueWatcher
watcher <- IO QueueWatcher
start
          let watchers' :: Map String QueueWatcher
watchers' = String
-> QueueWatcher
-> Map String QueueWatcher
-> Map String QueueWatcher
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
domain QueueWatcher
watcher Map String QueueWatcher
watchers
          IORef (Map String QueueWatcher) -> Map String QueueWatcher -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map String QueueWatcher)
watchersRef Map String QueueWatcher
watchers'
          QueueWatcher -> IO QueueWatcher
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueWatcher
watcher
        Just QueueWatcher
watcher -> QueueWatcher -> IO QueueWatcher
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueWatcher
watcher

data WatchCellsEvents = WatchCellsEvents
  { WatchCellsEvents -> Either Domain String
domain :: Either Domain String,
    WatchCellsEvents -> Value -> App Bool
filter :: Value -> App Bool
  }

instance Default WatchCellsEvents where
  def :: WatchCellsEvents
def =
    WatchCellsEvents
      { domain :: Either Domain String
domain = Domain -> Either Domain String
forall a b. a -> Either a b
Left Domain
OwnDomain,
        filter :: Value -> App Bool
filter = App Bool -> Value -> App Bool
forall a b. a -> b -> a
const (Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
      }

convEvents :: (MakesValue conv) => conv -> WatchCellsEvents
convEvents :: forall conv. MakesValue conv => conv -> WatchCellsEvents
convEvents conv
conv = WatchCellsEvents
forall a. Default a => a
def {filter = isNotifConv conv}

watchCellsEvents :: WatchCellsEvents -> App QueueConsumer
watchCellsEvents :: WatchCellsEvents -> App QueueConsumer
watchCellsEvents WatchCellsEvents
opts = do
  String
domain <- (Domain -> App String)
-> (String -> App String) -> Either Domain String -> App String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String)
-> (Domain -> App Value) -> Domain -> App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make) String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WatchCellsEvents
opts.domain
  QueueWatcher
watcher <- String -> App QueueWatcher
ensureWatcher String
domain
  TChan Message
chan <- IO (TChan Message) -> App (TChan Message)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan Message) -> App (TChan Message))
-> IO (TChan Message) -> App (TChan Message)
forall a b. (a -> b) -> a -> b
$ STM (TChan Message) -> IO (TChan Message)
forall a. STM a -> IO a
atomically (STM (TChan Message) -> IO (TChan Message))
-> STM (TChan Message) -> IO (TChan Message)
forall a b. (a -> b) -> a -> b
$ TChan Message -> STM (TChan Message)
forall a. TChan a -> STM (TChan a)
dupTChan QueueWatcher
watcher.broadcast
  QueueConsumer -> App QueueConsumer
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueConsumer {filter :: Value -> App Bool
filter = WatchCellsEvents
opts.filter, TChan Message
chan :: TChan Message
chan :: TChan Message
chan}