{-# OPTIONS -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

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
  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
  length ps `shouldMatchInt` n

registerUser :: (HasCallStack) => App (Value, String)
registerUser :: HasCallStack => App (Value, String)
registerUser = do
  alice <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  c <- randomClientId
  withWebSocket (alice, "conn", c) $ \WebSocket
_ ->
    Value -> Int -> App ()
forall u. (HasCallStack, MakesValue u) => u -> Int -> App ()
ensurePresent Value
alice Int
1
  pure (alice, 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
  (alice, c) <- App (Value, String)
HasCallStack => App (Value, String)
registerUser
  void $ generateAndPostPushToken alice c def >>= getJSON 201
  do
    t <- getPushTokens alice >>= getJSON 200
    tokens <- t %. "tokens" & asList
    length tokens `shouldMatchInt` 1

  -- push something to alice
  do
    r <- recipient alice
    let 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"]]
            ]
    void $ postPush alice [push] >>= getBody 200

  -- unregister alice
  void $ unregisterUser alice >>= getBody 200

  -- check that the token is deleted
  do
    t <- getPushTokens alice >>= getJSON 200
    t %. "tokens" `shouldMatch` ([] :: [Value])

  -- check that notifications are deleted
  do
    ns <- getNotifications alice def {client = Just c} >>= getJSON 200
    ns %. "notifications" `shouldMatch` ([] :: [Value])
    ns %. "has_more" `shouldMatch` False