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

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

ensurePresent :: (HasCallStack, MakesValue u) => u -> Int -> App ()
ensurePresent :: forall u. (HasCallStack, MakesValue u) => u -> Int -> App ()
ensurePresent u
u Int
n = App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  [Value]
ps <- u -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getPresence u
u 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 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 -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
  [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ps Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
n

registerUser :: (HasCallStack) => App (Value, String)
registerUser :: HasCallStack => App (Value, String)
registerUser = do
  Value
alice <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  String
c <- App String
randomClientId
  (Value, String, String) -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket (Value
alice, String
"conn", String
c) ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
_ ->
    Value -> Int -> App ()
forall u. (HasCallStack, MakesValue u) => u -> Int -> App ()
ensurePresent Value
alice Int
1
  (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
alice, String
c)

testAddUser :: (HasCallStack) => App ()
testAddUser :: HasCallStack => App ()
testAddUser = App (Value, String) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void App (Value, String)
HasCallStack => App (Value, String)
registerUser

testRemoveUser :: (HasCallStack) => App ()
testRemoveUser :: HasCallStack => App ()
testRemoveUser = do
  -- register alice and add a push token
  (Value
alice, String
c) <- App (Value, String)
HasCallStack => App (Value, String)
registerUser
  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 -> String -> GeneratePushToken -> App Response
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> GeneratePushToken -> App Response
generateAndPostPushToken Value
alice String
c GeneratePushToken
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  do
    Value
t <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getPushTokens Value
alice 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]
tokens <- Value
t Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"tokens" 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] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
tokens Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  -- push something to alice
  do
    Value
r <- Value -> App Value
forall u. MakesValue u => u -> App Value
recipient Value
alice
    let push :: Value
push =
          [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
"foo" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"bar"]]
            ]
    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] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
postPush Value
alice [Value
push] 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

  -- unregister alice
  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 -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
unregisterUser Value
alice 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

  -- check that the token is deleted
  do
    Value
t <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getPushTokens Value
alice 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
t Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"tokens" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])

  -- check that notifications are deleted
  do
    Value
ns <- Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
alice GetNotifications
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
ns Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    Value
ns Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"has_more" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False