{-# 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.Notifications where

import API.Brig
import API.Common
import API.Gundeck
import API.GundeckInternal
import Data.Time (UTCTime)
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Notifications
import SetupHelpers
import Testlib.Prelude
import UnliftIO (forConcurrently_)

examplePush :: (MakesValue u) => u -> App Value
examplePush :: forall u. MakesValue u => u -> App Value
examplePush u
u = do
  r <- u -> App Value
forall u. MakesValue u => u -> App Value
recipient u
u
  pure
    $ object
      [ "recipients" .= [r],
        "payload" .= [object ["hello" .= "world"]]
      ]

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

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

  let c :: Maybe String = Just "deadbeef"
  ns <- getNotifications user (def {client = c} :: GetNotifications) >>= getJSON 200

  expected <- replicateM n (push %. "payload")
  allNotifs <- ns %. "notifications" & asList
  actual <- traverse (%. "payload") allNotifs
  actual `shouldMatch` expected

  firstNotif <-
    getNotification
      user
      (def {client = c} :: GetNotification)
      (head allNotifs %. "id")
      >>= getJSON 200
  firstNotif `shouldMatch` head allNotifs

  lastNotif <-
    getLastNotification
      user
      (def {client = c} :: GetNotification)
      >>= getJSON 200
  lastNotif `shouldMatch` last allNotifs

testLastNotification :: App ()
testLastNotification :: App ()
testLastNotification = do
  user <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  userId <- user %. "id" & asString
  let 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]]
          ]

  for_ ["a", "b", "c", "d", "e", "f"] $ \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

  lastNotif <- getLastNotification user def {client = Just "c"} >>= getJSON 200
  lastNotif %. "payload" `shouldMatch` [object ["client" .= "c"]]

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

  -- test uuid v4 as "since"
  do
    notifId <- randomId
    void
      $ getNotifications user def {since = Just notifId}
      >>= getJSON 400

  -- test arbitrary uuid v1 as "since"
  do
    notifId <- randomUUIDv1
    void
      $ getNotifications user def {since = Just notifId}
      >>= getJSON 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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  e <- withWebSocket alice $ \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
    n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserClientAddNotif WebSocket
ws
    nPayload n

  void $ e %. "client.capabilities.capabilities" & asList

testBulkPushSameMessage :: (HasCallStack) => App ()
testBulkPushSameMessage :: HasCallStack => App ()
testBulkPushSameMessage = do
  let numUsers :: Int
numUsers = Int
20
      numClientsPerUser :: Int
numClientsPerUser = Int
8
  quids <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numUsers (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  quidsAndClients <- for quids $ \Value
quid -> (Value
quid,) ([String] -> (Value, [String]))
-> App [String] -> App (Value, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numClientsPerUser App String
randomClientId

  let mkIndividualPayload a
quid a
cid = [Pair] -> Value
object [String
"qualified_id" String -> a -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a
quid, String
"client" String -> a -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a
cid]
  individualPushes <- fmap mconcat $ for quidsAndClients $ \(Value
quid, [String]
cids) -> do
    uid <- Value
quid 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
    fmap mconcat . for cids $ \String
cid ->
      [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        [ [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
uid,
                         String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
cid],
                         String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"
                       ]
                   ],
              String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value -> String -> Value
forall {a} {a}. (ToJSON a, ToJSON a) => a -> a -> Value
mkIndividualPayload Value
quid String
cid]
            ]
        ]

  uidsAndClients <- for quidsAndClients $ \(Value
quid, [String]
cids) -> do
    uid <- Value
quid 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
    pure $ (uid, cids)
  let groupPush =
        [Pair] -> Value
object
          [ String
"recipients"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ( [[Value]] -> [Value]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Value]] -> [Value])
-> (((String, [String]) -> [Value]) -> [[Value]])
-> ((String, [String]) -> [Value])
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [String])]
-> ((String, [String]) -> [Value]) -> [[Value]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(String, [String])]
uidsAndClients (((String, [String]) -> [Value]) -> [Value])
-> ((String, [String]) -> [Value]) -> [Value]
forall a b. (a -> b) -> a -> b
$ \(String
uid, [String]
cids) ->
                     [[Pair] -> Value
object [String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid, String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String]
cids, String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any"]]
                 ),
            String
"payload" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"message" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"hello everyone"]]
          ]

  quidsConnsAndClients <- fmap mconcat . for quidsAndClients $ \(Value
quid, [String]
cids) ->
    [String]
-> (String -> App (Value, String, String))
-> App [(Value, String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
cids ((String -> App (Value, String, String))
 -> App [(Value, String, String)])
-> (String -> App (Value, String, String))
-> App [(Value, String, String)]
forall a b. (a -> b) -> a -> b
$ \String
cid -> (Value
quid,,String
cid) (String -> (Value, String, String))
-> App String -> App (Value, String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App String
HasCallStack => App String
randomConnId
  withWebSockets quidsConnsAndClients $ \[WebSocket]
websockets -> do
    pusher <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
    postPush pusher individualPushes >>= assertSuccess
    forConcurrently_ websockets $ \WebSocket
ws -> do
      event <- String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"Expected an event, got Nothing" (Maybe Value -> App Value) -> App (Maybe Value) -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
1 WebSocket
ws
      event %. "payload.0.qualified_id.id" `shouldMatch` ws.wsConnect.user
      event %. "payload.0.qualified_id.domain" `shouldMatch` ws.wsConnect.domain
      event %. "payload.0.client" `shouldMatch` ws.wsConnect.client
      assertNoEvent 1 ws

    postPush pusher [groupPush] >>= assertSuccess
    forConcurrently_ websockets $ \WebSocket
ws -> do
      event <- String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"Expected an event, got Nothing" (Maybe Value -> App Value) -> App (Maybe Value) -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
1 WebSocket
ws
      event %. "payload.0.message" `shouldMatch` "hello everyone"
      assertNoEvent 1 ws

testGetServerTime :: (HasCallStack) => App ()
testGetServerTime :: HasCallStack => App ()
testGetServerTime = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  formattedTimestampStr <-
    getServerTime user `bindResponse` \Response
r -> do
      Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
r.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"time" 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
  void $ assertJust ("expected ISO 8601 format, but got: " <> formattedTimestampStr) $ iso8601ParseM @Maybe @UTCTime formattedTimestampStr

testTargetClientPush :: (HasCallStack) => App ()
testTargetClientPush :: HasCallStack => App ()
testTargetClientPush = do
  user <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
randomUserId Domain
OwnDomain
  userId <- user %. "id" & asString
  cid1 <- randomClientId
  connId1 <- randomConnId
  cid2 <- randomClientId
  connId2 <- randomConnId
  let 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]]
          ]
  withWebSockets [(user, connId1, cid1), (user, connId2, cid2)] $ \[WebSocket
ws1, WebSocket
ws2] -> do
    Value -> [Value] -> App Response
forall user a.
(HasCallStack, MakesValue user, MakesValue a) =>
user -> [a] -> App Response
postPush Value
user [String -> Value
push String
cid1, String -> Value
push String
cid2] 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, WebSocket)] -> ((String, WebSocket) -> App ()) -> App ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
f a -> (a -> m b) -> m ()
forConcurrently_ [(String
cid1, WebSocket
ws1), (String
cid2, WebSocket
ws2)] (((String, WebSocket) -> App ()) -> App ())
-> ((String, WebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
cid, WebSocket
ws) -> do
      ev <- Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
2 WebSocket
ws
      ev %. "payload" `shouldMatch` [object ["client" .= cid]]
      assertNoEvent 2 ws
      -- Also check the notification stream
      lastNotif <- getLastNotification user def {client = Just cid} >>= getJSON 200
      lastNotif %. "payload" `shouldMatch` [object ["client" .= cid]]