{-# OPTIONS -Wno-ambiguous-fields #-}
module Test.Notifications where

import API.Brig
import API.Common
import API.Gundeck
import API.GundeckInternal
import Notifications
import SetupHelpers
import Testlib.Prelude

examplePush :: (MakesValue u) => u -> App Value
examplePush :: forall u. MakesValue u => u -> App Value
examplePush u
u = do
  Value
r <- u -> App Value
forall u. MakesValue u => u -> App Value
recipient u
u
  Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
      [ String
"recipients" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value
r],
        String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"hello" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"world"]]
      ]

testFetchAllNotifications :: App ()
testFetchAllNotifications :: App ()
testFetchAllNotifications = do
  Value
user <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  Value
push <- Value -> App Value
forall u. MakesValue u => u -> App Value
examplePush Value
user

  let n :: Int
n = Int
10
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n
    (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
postPush Value
user [Value
push])
    ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res ->
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  let Maybe String
c :: Maybe String = String -> Maybe String
forall a. a -> Maybe a
Just String
"deadbeef"
  Value
ns <- Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
user (GetNotifications
forall a. Default a => a
def {client = c} :: GetNotifications) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

  [Value]
expected <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Value
push Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload")
  [Value]
allNotifs <- Value
ns Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications" 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]
actual <- (Value -> App Value) -> [Value] -> App [Value]
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 (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload") [Value]
allNotifs
  [Value]
actual [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value]
expected

  Value
firstNotif <-
    Value -> GetNotification -> App Value -> App Response
forall user nid.
(HasCallStack, MakesValue user, MakesValue nid) =>
user -> GetNotification -> nid -> App Response
getNotification
      Value
user
      (GetNotification
forall a. Default a => a
def {client = c} :: GetNotification)
      ([Value] -> Value
forall a. HasCallStack => [a] -> a
head [Value]
allNotifs Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  Value
firstNotif Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value] -> Value
forall a. HasCallStack => [a] -> a
head [Value]
allNotifs

  Value
lastNotif <-
    Value -> GetNotification -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotification -> App Response
getLastNotification
      Value
user
      (GetNotification
forall a. Default a => a
def {client = c} :: GetNotification)
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  Value
lastNotif Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value] -> Value
forall a. HasCallStack => [a] -> a
last [Value]
allNotifs

testLastNotification :: App ()
testLastNotification :: App ()
testLastNotification = do
  Value
user <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  String
userId <- Value
user 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
  let push :: String -> Value
push String
c =
        [Pair] -> Value
object
          [ String
"recipients"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object
                     [ String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId,
                       String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any",
                       String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
c]
                     ]
                 ],
            String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"client" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
c]]
          ]

  [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String
"a", String
"b", String
"c", String
"d", String
"e", String
"f"] ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
c ->
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
postPush Value
user [String -> Value
push String
c]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res ->
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  Value
lastNotif <- Value -> GetNotification -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotification -> App Response
getLastNotification Value
user GetNotification
forall a. Default a => a
def {client = Just "c"} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  Value
lastNotif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"client" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"c"]]

testInvalidNotification :: (HasCallStack) => App ()
testInvalidNotification :: HasCallStack => App ()
testInvalidNotification = do
  Value
user <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain

  -- test uuid v4 as "since"
  do
    String
notifId <- App String
HasCallStack => App String
randomId
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
user GetNotifications
forall a. Default a => a
def {since = Just notifId}
      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
400

  -- test arbitrary uuid v1 as "since"
  do
    String
notifId <- App String
HasCallStack => App String
randomUUIDv1
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
user GetNotifications
forall a. Default a => a
def {since = Just notifId}
      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
404

-- | Check that client-add notifications use the V6 format:
-- @
--   "capabilities": { "capabilities": [..] }
-- @
--
-- Migration plan: clients must be able to parse both old and new schema starting from V7.  Once V6 is deprecated, the backend can start sending notifications in the new form.
testAddClientNotification :: (HasCallStack) => App ()
testAddClientNotification :: HasCallStack => App ()
testAddClientNotification = 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
e <- Value -> (WebSocket -> App Value) -> App Value
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App Value) -> App Value)
-> (WebSocket -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
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
    Value
n <- 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
ws
    Value -> App Value
forall u. MakesValue u => u -> App Value
nPayload Value
n

  App [Value] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Value] -> App ()) -> App [Value] -> App ()
forall a b. (a -> b) -> a -> b
$ Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client.capabilities.capabilities" 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