Avoid empty pushes from galley

changelog.d/5-internal/empty-push

@@ -0,0 +1 @@
+Avoid empty pushes when chunking pushes in galley

libs/gundeck-types/src/Gundeck/Types/Push/V2.hs

@@ -86,6 +86,7 @@ import Data.Set qualified as Set
 import Imports hiding (cs)
 import Wire.API.Message (Priority (..))
 import Wire.API.Push.V2.Token
+import Wire.Arbitrary
 
 -----------------------------------------------------------------------------
 -- Route
@@ -97,7 +98,8 @@ data Route
     RouteAny
   | -- | Avoids causing push notification for mobile clients.
     RouteDirect
-  deriving (Eq, Ord, Enum, Bounded, Show)
+  deriving (Eq, Ord, Enum, Bounded, Show, Generic)
+  deriving (Arbitrary) via GenericUniform Route
 
 instance FromJSON Route where
   parseJSON (String "any") = pure RouteAny
@@ -116,14 +118,15 @@ data Recipient = Recipient
     _recipientRoute :: !Route,
     _recipientClients :: !RecipientClients
   }
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic)
 
 data RecipientClients
   = -- | All clients of some user
     RecipientClientsAll
   | -- | An explicit list of clients
     RecipientClientsSome (List1 ClientId)
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show, Ord, Generic)
+  deriving (Arbitrary) via GenericUniform RecipientClients
 
 makeLenses ''Recipient
 

libs/types-common/src/Data/Id.hs

@@ -66,6 +66,7 @@ import Data.Attoparsec.ByteString.Char8 qualified as Atto
 import Data.Bifunctor (first)
 import Data.Binary
 import Data.ByteString.Builder (byteString)
+import Data.ByteString.Char8 qualified as B8
 import Data.ByteString.Conversion
 import Data.ByteString.Lazy qualified as L
 import Data.Char qualified as Char
@@ -298,6 +299,9 @@ instance S.ToParamSchema ConnId where
 instance FromHttpApiData ConnId where
   parseUrlPiece = Right . ConnId . encodeUtf8
 
+instance Arbitrary ConnId where
+  arbitrary = ConnId . B8.pack <$> resize 10 (listOf arbitraryPrintableChar)
+
 -- ClientId --------------------------------------------------------------------
 
 -- | Handle for a device.  Corresponds to the device fingerprints exposed in the UI.  It is unique

services/cannon/cannon.cabal

@@ -249,7 +249,6 @@ test-suite cannon-tests
     , tasty             >=0.8
     , tasty-hunit       >=0.8
     , tasty-quickcheck  >=0.8
-    , types-common
     , uuid
     , wire-api
 

services/cannon/default.nix

@@ -109,7 +109,6 @@ mkDerivation {
     tasty
     tasty-hunit
     tasty-quickcheck
-    types-common
     uuid
     wire-api
   ];

services/cannon/test/Test/Cannon/Dict.hs

@@ -24,7 +24,6 @@ import Cannon.Dict qualified as D
 import Cannon.WS (Key, mkKey)
 import Control.Concurrent.Async
 import Data.ByteString.Lazy qualified as Lazy
-import Data.Id
 import Data.List qualified as List
 import Data.UUID hiding (fromString)
 import Data.UUID.V4
@@ -122,6 +121,3 @@ runProp = monadicIO . forAllM arbitrary
 
 instance Arbitrary Key where
   arbitrary = mkKey <$> arbitrary <*> arbitrary
-
-instance Arbitrary ConnId where
-  arbitrary = ConnId <$> arbitrary

services/galley/galley.cabal

@@ -628,6 +628,7 @@ test-suite galley-tests
     Test.Galley.API.Action
     Test.Galley.API.Message
     Test.Galley.API.One2One
+    Test.Galley.Intra.Push
     Test.Galley.Intra.User
     Test.Galley.Mapping
 

services/galley/src/Galley/Intra/Push/Internal.hs

@@ -43,6 +43,7 @@ import Wire.API.Event.FeatureConfig qualified as FeatureConfig
 import Wire.API.Event.Federation qualified as Federation
 import Wire.API.Event.Team qualified as Teams
 import Wire.API.Team.Member
+import Wire.Arbitrary
 
 data PushEvent
   = ConvEvent Event
@@ -60,7 +61,8 @@ data RecipientBy user = Recipient
   { _recipientUserId :: user,
     _recipientClients :: RecipientClients
   }
-  deriving stock (Functor, Foldable, Traversable, Show, Ord, Eq)
+  deriving stock (Functor, Foldable, Traversable, Show, Ord, Eq, Generic)
+  deriving (Arbitrary) via GenericUniform (RecipientBy user)
 
 makeLenses ''RecipientBy
 
@@ -77,7 +79,8 @@ data PushTo user = Push
     pushJson :: Object,
     pushRecipientListType :: ListType
   }
-  deriving stock (Functor, Foldable, Traversable, Show)
+  deriving stock (Eq, Generic, Functor, Foldable, Traversable, Show)
+  deriving (Arbitrary) via GenericUniform (PushTo user)
 
 makeLenses ''PushTo
 
@@ -93,41 +96,45 @@ push ps = do
       nonEmpty (toList (_pushRecipients p)) <&> \nonEmptyRecipients ->
         p {_pushRecipients = List1 nonEmptyRecipients}
 
--- | Asynchronously send multiple pushes, aggregating them into as
--- few requests as possible, such that no single request targets
--- more than 128 recipients.
-pushLocal :: NonEmpty (PushTo UserId) -> App ()
-pushLocal ps = do
-  opts <- view options
-  let limit = currentFanoutLimit opts
-  -- Do not fan out for very large teams
-  let (asyncs, syncs) = partition _pushAsync (removeIfLargeFanout limit $ toList ps)
-  traverse_ (asyncCall Gundeck <=< jsonChunkedIO) (pushes asyncs)
-  mapConcurrently_ (call Gundeck <=< jsonChunkedIO) (pushes syncs)
+-- | Split a list of pushes into chunks with the given maximum number of
+-- recipients. maxRecipients must be strictly positive. Note that the order of
+-- pushes within a chunk is reversed compared to the order of the input list.
+chunkPushes :: Int -> [PushTo a] -> [[PushTo a]]
+chunkPushes maxRecipients | maxRecipients <= 0 = error "maxRecipients must be positive"
+chunkPushes maxRecipients = go 0 []
   where
-    pushes :: [PushTo UserId] -> [[Gundeck.Push]]
-    pushes = map (map (\p -> toPush p (recipientList p))) . chunk 0 []
-
-    chunk :: Int -> [PushTo a] -> [PushTo a] -> [[PushTo a]]
-    chunk _ acc [] = [acc]
-    chunk n acc (y : ys)
-      | n >= maxRecipients = acc : chunk 0 [] (y : ys)
+    go _ [] [] = []
+    go _ acc [] = [acc]
+    go n acc (y : ys)
+      | n >= maxRecipients = acc : go 0 [] (y : ys)
       | otherwise =
           let totalLength = (n + length (_pushRecipients y))
            in if totalLength > maxRecipients
                 then
                   let (y1, y2) = splitPush (maxRecipients - n) y
-                   in chunk maxRecipients (y1 : acc) (y2 : ys)
-                else chunk totalLength (y : acc) ys
+                   in go maxRecipients (y1 : acc) (y2 : ys)
+                else go totalLength (y : acc) ys
 
     -- n must be strictly > 0 and < length (_pushRecipients p)
     splitPush :: Int -> PushTo a -> (PushTo a, PushTo a)
     splitPush n p =
       let (r1, r2) = splitAt n (toList (_pushRecipients p))
        in (p {_pushRecipients = fromJust $ maybeList1 r1}, p {_pushRecipients = fromJust $ maybeList1 r2})
 
-    maxRecipients :: Int
-    maxRecipients = 128
+-- | Asynchronously send multiple pushes, aggregating them into as
+-- few requests as possible, such that no single request targets
+-- more than 128 recipients.
+pushLocal :: NonEmpty (PushTo UserId) -> App ()
+pushLocal ps = do
+  opts <- view options
+  let limit = currentFanoutLimit opts
+  -- Do not fan out for very large teams
+  let (asyncs, syncs) = partition _pushAsync (removeIfLargeFanout limit $ toList ps)
+  traverse_ (asyncCall Gundeck <=< jsonChunkedIO) (pushes asyncs)
+  mapConcurrently_ (call Gundeck <=< jsonChunkedIO) (pushes syncs)
+  where
+    pushes :: [PushTo UserId] -> [[Gundeck.Push]]
+    pushes = map (map (\p -> toPush p (recipientList p))) . chunkPushes 128
 
     recipientList :: PushTo UserId -> [Gundeck.Recipient]
     recipientList p = map (toRecipient p) . toList $ _pushRecipients p

services/galley/test/unit/Run.hs

@@ -24,6 +24,7 @@ import Imports
 import Test.Galley.API.Action qualified
 import Test.Galley.API.Message qualified
 import Test.Galley.API.One2One qualified
+import Test.Galley.Intra.Push qualified
 import Test.Galley.Intra.User qualified
 import Test.Galley.Mapping qualified
 import Test.Tasty
@@ -36,6 +37,7 @@ main =
       [ Test.Galley.API.Message.tests,
         Test.Galley.API.One2One.tests,
         Test.Galley.Intra.User.tests,
+        Test.Galley.Intra.Push.tests,
         Test.Galley.Mapping.tests,
         Test.Galley.API.Action.tests
       ]

services/galley/test/unit/Test/Galley/Intra/Push.hs

@@ -0,0 +1,50 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2023 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.Galley.Intra.Push where
+
+import Data.List1 qualified as List1
+import Data.Monoid
+import Galley.Intra.Push.Internal
+import Imports
+import Test.QuickCheck
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+normalisePush :: PushTo a -> [PushTo a]
+normalisePush p =
+  map
+    (\r -> p {_pushRecipients = List1.singleton r})
+    (toList (_pushRecipients p))
+
+chunkSize :: [PushTo a] -> Int
+chunkSize = getSum . foldMap (Sum . length . _pushRecipients)
+
+tests :: TestTree
+tests =
+  testGroup
+    "chunkPushes"
+    [ testProperty "empty push" $ \(Positive limit) ->
+        chunkPushes limit [] === ([] :: [[PushTo ()]]),
+      testProperty "no empty chunk" $ \(Positive limit) (pushes :: [PushTo Int]) ->
+        not (any null (chunkPushes limit pushes)),
+      testProperty "concatenation" $ \(Positive limit) (pushes :: [PushTo Int]) ->
+        (chunkPushes limit pushes >>= reverse >>= normalisePush)
+          === (pushes >>= normalisePush),
+      testProperty "small chunks" $ \(Positive limit) (pushes :: [PushTo Int]) ->
+        all ((<= limit) . chunkSize) (chunkPushes limit pushes)
+    ]