Merge branch 'origin/develop' into mls

integration/test/API/Gundeck.hs

@@ -5,54 +5,58 @@ import Testlib.Prelude
 
 data GetNotifications = GetNotifications
   { since :: Maybe String,
-    size :: Maybe Int
+    size :: Maybe Int,
+    client :: Maybe String
   }
 
 instance Default GetNotifications where
-  def = GetNotifications {since = Nothing, size = Nothing}
+  def = GetNotifications {since = Nothing, size = Nothing, client = Nothing}
 
 getNotifications ::
-  (HasCallStack, MakesValue user, MakesValue client) =>
+  (HasCallStack, MakesValue user) =>
   user ->
-  client ->
   GetNotifications ->
   App Response
-getNotifications user client r = do
-  c <- client & asString
+getNotifications user r = do
   req <- baseRequest user Gundeck Versioned "/notifications"
   let req' =
         req
           & addQueryParams
             ( [("since", since) | since <- toList r.since]
-                <> [("client", c)]
+                <> [("client", c) | c <- toList r.client]
                 <> [("size", show size) | size <- toList r.size]
             )
   submit "GET" req'
 
+data GetNotification = GetNotification
+  { client :: Maybe String
+  }
+
+instance Default GetNotification where
+  def = GetNotification Nothing
+
 getNotification ::
-  (HasCallStack, MakesValue user, MakesValue client, MakesValue nid) =>
+  (HasCallStack, MakesValue user, MakesValue nid) =>
   user ->
-  client ->
+  GetNotification ->
   nid ->
   App Response
-getNotification user client nid = do
-  c <- client & asString
+getNotification user opts nid = do
   n <- nid & asString
   req <-
     baseRequest user Gundeck Versioned $
       joinHttpPath ["notifications", n]
-  submit "GET" $ req & addQueryParams [("client", c)]
+  submit "GET" $ req & addQueryParams [("client", c) | c <- toList opts.client]
 
 getLastNotification ::
-  (HasCallStack, MakesValue user, MakesValue client) =>
+  (HasCallStack, MakesValue user) =>
   user ->
-  client ->
+  GetNotification ->
   App Response
-getLastNotification user client = do
-  c <- client & asString
+getLastNotification user opts = do
   req <-
     baseRequest user Gundeck Versioned "/notifications/last"
-  submit "GET" $ req & addQueryParams [("client", c)]
+  submit "GET" $ req & addQueryParams [("client", c) | c <- toList opts.client]
 
 data PostPushToken = PostPushToken
   { transport :: String,

integration/test/Notifications.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
 module Notifications where
 
 import API.Gundeck
@@ -22,7 +23,13 @@ awaitNotifications user client since0 tSecs n selector =
   where
     go 0 _ res = pure res
     go timeRemaining since res0 = do
-      notifs <- bindResponse (getNotifications user client (GetNotifications since Nothing)) $ \resp -> asList (resp.json %. "notifications")
+      c <- make client & asString
+      notifs <- bindResponse
+        ( getNotifications
+            user
+            def {since = since, client = Just c}
+        )
+        $ \resp -> asList (resp.json %. "notifications")
       lastNotifId <- case notifs of
         [] -> pure since
         _ -> Just <$> objId (last notifs)

integration/test/Test/Client.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-ambiguous-fields -Wno-incomplete-uni-patterns #-}
 
 module Test.Client where
 
@@ -21,7 +21,7 @@ testClientLastActive :: HasCallStack => App ()
 testClientLastActive = do
   alice <- randomUser OwnDomain def
   c0 <- addClient alice def >>= getJSON 201
-  cid <- c0 %. "id"
+  cid <- c0 %. "id" & asString
 
   -- newly created clients should not have a last_active value
   tm0 <- fromMaybe Null <$> lookupField c0 "last_active"
@@ -30,7 +30,7 @@ testClientLastActive = do
   now <- systemSeconds <$> liftIO getSystemTime
 
   -- fetching notifications updates last_active
-  void $ getNotifications alice cid def
+  void $ getNotifications alice def {client = Just cid}
 
   c1 <- getClient alice cid >>= getJSON 200
   tm1 <- c1 %. "last_active" & asString

integration/test/Test/Notifications.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
 module Test.Notifications where
 
 import API.Common
@@ -25,18 +26,27 @@ testFetchAllNotifications = do
     bindResponse (postPush user [push]) $ \res ->
       res.status `shouldMatchInt` 200
 
-  let client = "deadbeeef"
-  ns <- getNotifications user client def >>= getJSON 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 client (head allNotifs %. "id") >>= getJSON 200
+  firstNotif <-
+    getNotification
+      user
+      (def {client = c} :: GetNotification)
+      (head allNotifs %. "id")
+      >>= getJSON 200
   firstNotif `shouldMatch` head allNotifs
 
-  lastNotif <- getLastNotification user client >>= getJSON 200
+  lastNotif <-
+    getLastNotification
+      user
+      (def {client = c} :: GetNotification)
+      >>= getJSON 200
   lastNotif `shouldMatch` last allNotifs
 
 testLastNotification :: App ()
@@ -59,24 +69,23 @@ testLastNotification = do
     bindResponse (postPush user [push c]) $ \res ->
       res.status `shouldMatchInt` 200
 
-  lastNotif <- getLastNotification user "c" >>= getJSON 200
+  lastNotif <- getLastNotification user def {client = Just "c"} >>= getJSON 200
   lastNotif %. "payload" `shouldMatch` [object ["client" .= "c"]]
 
 testInvalidNotification :: HasCallStack => App ()
 testInvalidNotification = do
   user <- randomUserId OwnDomain
-  let client = "deadbeef"
 
   -- test uuid v4 as "since"
   do
     notifId <- randomId
     void $
-      getNotifications user client def {since = Just notifId}
+      getNotifications user def {since = Just notifId}
         >>= getJSON 400
 
   -- test arbitrary uuid v1 as "since"
   do
     notifId <- randomUUIDv1
     void $
-      getNotifications user client def {since = Just notifId}
+      getNotifications user def {since = Just notifId}
         >>= getJSON 404

integration/test/Test/Presence.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
 module Test.Presence where
 
 import API.Common
@@ -52,6 +53,6 @@ testRemoveUser = do
 
   -- check that notifications are deleted
   do
-    ns <- getNotifications alice c def >>= getJSON 200
+    ns <- getNotifications alice def {client = Just c} >>= getJSON 200
     ns %. "notifications" `shouldMatch` ([] :: [Value])
     ns %. "has_more" `shouldMatch` False