From 8872e7d4bb44a601e7c5170805834e74392714b3 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 4 Feb 2025 13:27:26 +0100 Subject: [PATCH 1/8] Fix typos --- libs/wire-subsystems/src/Wire/GundeckAPIAccess.hs | 4 ++-- .../src/Wire/NotificationSubsystem/Interpreter.hs | 2 +- services/gundeck/src/Gundeck/API/Internal.hs | 6 +++--- services/gundeck/src/Gundeck/Push.hs | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/GundeckAPIAccess.hs b/libs/wire-subsystems/src/Wire/GundeckAPIAccess.hs index e402416a21b..31a3d455f07 100644 --- a/libs/wire-subsystems/src/Wire/GundeckAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GundeckAPIAccess.hs @@ -17,7 +17,7 @@ data GundeckAPIAccess m a where UserDeleted :: UserId -> GundeckAPIAccess m () UnregisterPushClient :: UserId -> ClientId -> GundeckAPIAccess m () GetPushTokens :: UserId -> GundeckAPIAccess m [V2.PushToken] - RegisterConsumableNotifcationsClient :: UserId -> ClientId -> GundeckAPIAccess m () + RegisterConsumableNotificationsClient :: UserId -> ClientId -> GundeckAPIAccess m () deriving instance Show (GundeckAPIAccess m a) @@ -53,7 +53,7 @@ runGundeckAPIAccess ep = interpret $ \case . zUser uid . expect2xx responseJsonMaybe rsp & maybe (pure []) (pure . V2.pushTokens) - RegisterConsumableNotifcationsClient uid cid -> do + RegisterConsumableNotificationsClient uid cid -> do void . rpcWithRetries "gundeck" ep $ method POST . paths ["i", "users", toByteString' uid, "clients", toByteString' cid, "consumable-notifications"] diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs index 89d80fcb70c..6a8e24875df 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs @@ -46,7 +46,7 @@ runNotificationSubsystemGundeck cfg = interpret $ \case CleanupUser uid -> GundeckAPIAccess.userDeleted uid UnregisterPushClient uid cid -> GundeckAPIAccess.unregisterPushClient uid cid GetPushTokens uid -> GundeckAPIAccess.getPushTokens uid - SetupConsumableNotifications uid cid -> GundeckAPIAccess.registerConsumableNotifcationsClient uid cid + SetupConsumableNotifications uid cid -> GundeckAPIAccess.registerConsumableNotificationsClient uid cid data NotificationSubsystemConfig = NotificationSubsystemConfig { fanoutLimit :: Range 1 HardTruncationLimit Int32, diff --git a/services/gundeck/src/Gundeck/API/Internal.hs b/services/gundeck/src/Gundeck/API/Internal.hs index d97a0a695dd..c1c1591ab8d 100644 --- a/services/gundeck/src/Gundeck/API/Internal.hs +++ b/services/gundeck/src/Gundeck/API/Internal.hs @@ -50,7 +50,7 @@ servantSitemap = :<|> Named @"i-clients-delete" unregisterClientH :<|> Named @"i-user-delete" removeUserH :<|> Named @"i-push-tokens-get" getPushTokensH - :<|> Named @"i-reg-consumable-notifs" registerConsumableNotifcationsClient + :<|> Named @"i-reg-consumable-notifs" registerConsumableNotificationsClient statusH :: (Applicative m) => m NoContent statusH = pure NoContent @@ -67,8 +67,8 @@ removeUserH uid = NoContent <$ Client.removeUser uid getPushTokensH :: UserId -> Gundeck PushTok.PushTokenList getPushTokensH uid = PushTok.PushTokenList <$> (view PushTok.addrPushToken <$$> PushTok.lookup uid Cassandra.All) -registerConsumableNotifcationsClient :: UserId -> ClientId -> Gundeck NoContent -registerConsumableNotifcationsClient uid cid = do +registerConsumableNotificationsClient :: UserId -> ClientId -> Gundeck NoContent +registerConsumableNotificationsClient uid cid = do chan <- getRabbitMqChan void . liftIO $ setupConsumableNotifications chan uid cid pure NoContent diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index aa31968b22f..c4c43ccf483 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -152,7 +152,7 @@ splitPushes ps = do -- | Split a push into rabbitmq and legacy push. This code exists to help with -- migration. Once it is completed and old APIs are not supported anymore we can --- assume everything is meant for RabbtiMQ and stop splitting. +-- assume everything is meant for RabbitMQ and stop splitting. splitPush :: UserClientsFull -> Push -> From 24483d9e474a0309dc6d5171b23ec3d28e5b6e00 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 4 Feb 2025 15:40:49 +0100 Subject: [PATCH 2/8] WIP --- libs/wire-api/src/Wire/API/Event/Conversation.hs | 10 ++++++++++ services/gundeck/src/Gundeck/Options.hs | 4 +++- services/gundeck/src/Gundeck/Push.hs | 3 +++ 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 74d537136a4..000f0790cc4 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -26,6 +26,7 @@ module Wire.API.Event.Conversation EventType (..), EventData (..), AddCodeResult (..), + isPydioEvent, -- * Event lenses _EdMembersJoin, @@ -224,6 +225,15 @@ eventDataType (EdMLSWelcome _) = MLSWelcome eventDataType EdConvDelete = ConvDelete eventDataType (EdProtocolUpdate _) = ProtocolUpdate +isPydioEvent :: EventType -> Bool +isPydioEvent MemberJoin = True +isPydioEvent MemberLeave = True +isPydioEvent MemberStateUpdate = True +isPydioEvent ConvRename = True +isPydioEvent ConvCreate = True +isPydioEvent ConvDelete = True +isPydioEvent _ = False + -------------------------------------------------------------------------------- -- Event data helpers diff --git a/services/gundeck/src/Gundeck/Options.hs b/services/gundeck/src/Gundeck/Options.hs index f09b6177d19..705d763990f 100644 --- a/services/gundeck/src/Gundeck/Options.hs +++ b/services/gundeck/src/Gundeck/Options.hs @@ -82,7 +82,9 @@ data Settings = Settings -- effect the page size request in the client API. A lower number will -- reduce the amount by which setMaxPayloadLoadSize is exceeded when loading -- notifications from the database if notifications have inlined payloads. - _internalPageSize :: Maybe Int32 + _internalPageSize :: Maybe Int32, + -- | TODO docs + _pydioEventQueue :: !(Maybe Text) } deriving (Show, Generic) diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index c4c43ccf483..17ed2a08e47 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -240,6 +240,7 @@ pushAll pushes = do (rabbitmqPushes, legacyPushes) <- splitPushes pushes pushAllLegacy legacyPushes pushAllViaRabbitMq rabbitmqPushes + pushToPydio pushes -- | Construct and send a single bulk push request to the client. Write the 'Notification's from -- the request to C*. Trigger native pushes for all delivery failures notifications. @@ -323,6 +324,8 @@ pushViaRabbitMq p = do for_ routingKeys $ \routingKey -> mpaPublishToRabbitMq routingKey qMsg +pushToPydio + -- | A new notification to be stored in C* and pushed over websockets data NewNotification = NewNotification { nnPush :: Push, From de6b636a19c3eb5803d20f47de9493ec28d37580 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 4 Feb 2025 16:28:04 +0000 Subject: [PATCH 3/8] add ispydio flag to pushes --- libs/wire-api/src/Wire/API/Push/V2.hs | 8 ++++-- .../Test/Wire/API/Golden/Manual/Push.hs | 6 +++-- .../src/Wire/NotificationSubsystem.hs | 20 ++++++++------- .../NotificationSubsystem/InterpreterSpec.hs | 25 ++++++++++++------- services/brig/src/Brig/IO/Intra.hs | 4 +-- services/galley/src/Galley/API/Action.hs | 2 +- services/galley/src/Galley/API/Create.hs | 6 ++--- services/galley/src/Galley/API/Internal.hs | 2 +- services/galley/src/Galley/API/Push.hs | 2 +- services/galley/src/Galley/API/Teams.hs | 17 +++++++------ .../galley/src/Galley/API/Teams/Features.hs | 2 +- services/galley/src/Galley/API/Update.hs | 4 +-- services/galley/src/Galley/API/Util.hs | 4 +-- services/gundeck/src/Gundeck/Push.hs | 2 +- 14 files changed, 60 insertions(+), 44 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Push/V2.hs b/libs/wire-api/src/Wire/API/Push/V2.hs index 1d24c9099d1..6010d388092 100644 --- a/libs/wire-api/src/Wire/API/Push/V2.hs +++ b/libs/wire-api/src/Wire/API/Push/V2.hs @@ -17,6 +17,7 @@ module Wire.API.Push.V2 pushNativeAps, pushNativePriority, pushPayload, + pushIsPydioEvent, singletonPayload, Recipient (..), RecipientClients (..), @@ -255,7 +256,8 @@ data Push = Push -- | Native push priority. _pushNativePriority :: !Priority, -- | Opaque payload - _pushPayload :: !(List1 Object) + _pushPayload :: !(List1 Object), + _pushIsPydioEvent :: !Bool } deriving (Eq, Show) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema Push) @@ -272,7 +274,8 @@ newPush from to pload = _pushNativeEncrypt = True, _pushNativeAps = Nothing, _pushNativePriority = HighPriority, - _pushPayload = pload + _pushPayload = pload, + _pushIsPydioEvent = False } singletonPayload :: (ToJSONObject a) => a -> List1 Object @@ -298,6 +301,7 @@ instance ToSchema Push where <*> (ifNot (== HighPriority) . _pushNativePriority) .= maybe_ (fromMaybe HighPriority <$> optField "native_priority" schema) <*> _pushPayload .= field "payload" schema + <*> _pushIsPydioEvent .= field "is_pydio_event" schema where ifNot f a = if f a then Nothing else Just a diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Push.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Push.hs index fb91cd9cfc6..9f7b371b692 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Push.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Push.hs @@ -60,7 +60,8 @@ testObject_Push_1 = _pushNativeEncrypt = True, _pushNativeAps = Nothing, _pushNativePriority = HighPriority, - _pushPayload = singleton mempty + _pushPayload = singleton mempty, + _pushIsPydioEvent = False } testObject_Push_2 :: Push @@ -78,5 +79,6 @@ testObject_Push_2 = _pushPayload = list1 (KM.fromList [("foo" :: KM.Key) A..= '3', "bar" A..= True]) - [KM.fromList [], KM.fromList ["growl" A..= ("foooood" :: Text)], KM.fromList ["lunchtime" A..= ("imminent" :: Text)]] + [KM.fromList [], KM.fromList ["growl" A..= ("foooood" :: Text)], KM.fromList ["lunchtime" A..= ("imminent" :: Text)]], + _pushIsPydioEvent = False } diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs index 9274cce698d..8ade4ccd690 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs @@ -27,7 +27,8 @@ data Push = Push pushOrigin :: Maybe UserId, _pushRecipients :: NonEmpty Recipient, pushJson :: Object, - _pushApsData :: Maybe ApsData + _pushApsData :: Maybe ApsData, + pushIsPydioEvent :: Bool } deriving stock (Eq, Generic, Show) deriving (Arbitrary) via GenericUniform Push @@ -53,8 +54,8 @@ data NotificationSubsystem m a where makeSem ''NotificationSubsystem -newPush1 :: Maybe UserId -> Object -> NonEmpty Recipient -> Push -newPush1 from e rr = +newPush1 :: Maybe UserId -> Object -> NonEmpty Recipient -> Bool -> Push +newPush1 from e rr isPydioEvent = Push { _pushConn = Nothing, _pushTransient = False, @@ -63,15 +64,16 @@ newPush1 from e rr = _pushApsData = Nothing, pushJson = e, pushOrigin = from, - _pushRecipients = rr + _pushRecipients = rr, + pushIsPydioEvent = isPydioEvent } -newPush :: Maybe UserId -> Object -> [Recipient] -> Maybe Push -newPush _ _ [] = Nothing -newPush u e (r : rr) = Just $ newPush1 u e (r :| rr) +newPush :: Maybe UserId -> Object -> [Recipient] -> Bool -> Maybe Push +newPush _ _ [] _ = todo +newPush u e (r : rr) isPydioEvent = Just $ newPush1 u e (r :| rr) isPydioEvent -newPushLocal :: UserId -> Object -> [Recipient] -> Maybe Push +newPushLocal :: UserId -> Object -> [Recipient] -> Bool -> Maybe Push newPushLocal uid = newPush (Just uid) -newPushLocal1 :: UserId -> Object -> NonEmpty Recipient -> Push +newPushLocal1 :: UserId -> Object -> NonEmpty Recipient -> Bool -> Push newPushLocal1 uid = newPush1 (Just uid) diff --git a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs index aae5e6710cc..dcf75b35905 100644 --- a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs @@ -56,7 +56,8 @@ spec = describe "NotificationSubsystem.Interpreter" do pushOrigin = Nothing, _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], pushJson = payload1, - _pushApsData = Nothing + _pushApsData = Nothing, + pushIsPydioEvent = False } push2 = Push @@ -69,7 +70,8 @@ spec = describe "NotificationSubsystem.Interpreter" do Recipient user21 V2.RecipientClientsAll :| [Recipient user22 V2.RecipientClientsAll], pushJson = payload2, - _pushApsData = Just apsData + _pushApsData = Just apsData, + pushIsPydioEvent = False } duplicatePush = push2 duplicatePushWithPush1Recipients = push2 {_pushRecipients = _pushRecipients push1} @@ -116,7 +118,8 @@ spec = describe "NotificationSubsystem.Interpreter" do pushOrigin = Nothing, _pushRecipients = lotOfRecipients, pushJson = payload1, - _pushApsData = Nothing + _pushApsData = Nothing, + pushIsPydioEvent = False } pushSmallerThanFanoutLimit = Push @@ -129,7 +132,8 @@ spec = describe "NotificationSubsystem.Interpreter" do Recipient user21 V2.RecipientClientsAll :| [Recipient user22 V2.RecipientClientsAll], pushJson = payload2, - _pushApsData = Just apsData + _pushApsData = Just apsData, + pushIsPydioEvent = False } pushes = [ pushBiggerThanFanoutLimit, @@ -170,7 +174,8 @@ spec = describe "NotificationSubsystem.Interpreter" do pushOrigin = Nothing, _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], pushJson = payload1, - _pushApsData = Nothing + _pushApsData = Nothing, + pushIsPydioEvent = False } push2 = Push @@ -183,7 +188,8 @@ spec = describe "NotificationSubsystem.Interpreter" do Recipient user21 V2.RecipientClientsAll :| [Recipient user22 V2.RecipientClientsAll], pushJson = payload2, - _pushApsData = Nothing + _pushApsData = Nothing, + pushIsPydioEvent = False } pushes = [push1, push2] @@ -226,7 +232,8 @@ spec = describe "NotificationSubsystem.Interpreter" do pushOrigin = Nothing, _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], pushJson = payload1, - _pushApsData = Nothing + _pushApsData = Nothing, + pushIsPydioEvent = False } (_, attemptedPushes, logs) <- runMiniStackAsync mockConfig $ do thread <- pushAsyncImpl push1 @@ -321,7 +328,7 @@ runGundeckAPIAccessFailure pushesRef = GundeckAPIAccess.UserDeleted {} -> unexpectedCall GundeckAPIAccess.UnregisterPushClient {} -> unexpectedCall GundeckAPIAccess.GetPushTokens {} -> unexpectedCall - GundeckAPIAccess.RegisterConsumableNotifcationsClient {} -> unexpectedCall + GundeckAPIAccess.RegisterConsumableNotificationsClient {} -> unexpectedCall data TestException = TestException deriving (Show) @@ -340,7 +347,7 @@ runGundeckAPIAccessIORef pushesRef = GundeckAPIAccess.UserDeleted {} -> unexpectedCall GundeckAPIAccess.UnregisterPushClient {} -> unexpectedCall GundeckAPIAccess.GetPushTokens {} -> unexpectedCall - GundeckAPIAccess.RegisterConsumableNotifcationsClient {} -> unexpectedCall + GundeckAPIAccess.RegisterConsumableNotificationsClient {} -> unexpectedCall waitUntilPushes :: IORef [a] -> Int -> IO [a] waitUntilPushes pushesRef n = do diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 95d49a402b8..9798d9ff74d 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -184,7 +184,7 @@ onClientEvent orig conn e = do let event = ClientEvent e let rcps = Recipient orig V2.RecipientClientsAll :| [] pushNotifications - [ newPush1 (Just orig) (toJSONObject event) rcps + [ newPush1 (Just orig) (toJSONObject event) rcps False & pushConn .~ conn & pushApsData .~ toApsData event ] @@ -356,7 +356,7 @@ notify :: notify event orig route conn recipients = do rs <- (\u -> Recipient u RecipientClientsAll) <$$> recipients let push = - newPush1 (Just orig) (toJSONObject event) rs + newPush1 (Just orig) (toJSONObject event) rs False & pushConn .~ conn & pushRoute .~ route & pushApsData .~ toApsData event diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index e5e7ff6a79d..2c9af1e1425 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -1099,7 +1099,7 @@ pushTypingIndicatorEvents :: Sem r () pushTypingIndicatorEvents qusr tEvent users mcon qcnv ts = do let e = Event qcnv Nothing qusr tEvent (EdTyping ts) - for_ (newPushLocal (qUnqualified qusr) (toJSONObject e) (userRecipient <$> users)) $ \p -> + for_ (newPushLocal (qUnqualified qusr) (toJSONObject e) (userRecipient <$> users) False) $ \p -> pushNotifications [ p & pushConn .~ mcon diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 9ab84a07469..c1ac95a3485 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -551,7 +551,7 @@ createConnectConversation lusr conn j = do now <- input let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConnect j) notifyCreatedConversation lusr conn c - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c)) $ \p -> + for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) (isPydioEvent $ evtType e)) $ \p -> pushNotifications [ p & pushRoute .~ PushV2.RouteDirect @@ -591,7 +591,7 @@ createConnectConversation lusr conn j = do Nothing -> pure $ Data.convName conv t <- input let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) t (EdConnect j) - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers conv)) $ \p -> + for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers conv) (isPydioEvent $ evtType e)) $ \p -> pushNotifications [ p & pushRoute .~ PushV2.RouteDirect @@ -691,7 +691,7 @@ notifyCreatedConversation lusr conn c = do c' <- conversationViewWithCachedOthers remoteOthers localOthers c (qualifyAs lusr (lmId m)) let e = Event (tUntagged lconv) Nothing (tUntagged lusr) t (EdConversation c') pure $ - newPushLocal1 (tUnqualified lusr) (toJSONObject e) (NonEmpty.singleton (localMemberToRecipient m)) + newPushLocal1 (tUnqualified lusr) (toJSONObject e) (NonEmpty.singleton (localMemberToRecipient m)) (isPydioEvent $ evtType e) & pushConn .~ conn & pushRoute .~ route diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 27433530eec..df01f37f96c 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -391,7 +391,7 @@ rmUser lusr conn = do (EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser])) for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c) pure $ - newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) + newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) (isPydioEvent $ evtType e) <&> set pushConn conn . set pushRoute PushV2.RouteDirect | otherwise -> pure Nothing diff --git a/services/galley/src/Galley/API/Push.hs b/services/galley/src/Galley/API/Push.hs index 79a70c56281..0aa6892bae8 100644 --- a/services/galley/src/Galley/API/Push.hs +++ b/services/galley/src/Galley/API/Push.hs @@ -96,7 +96,7 @@ runMessagePush loc mqcnv mp@(MessagePush _ _ _ botMembers event) = do toPush :: MessagePush -> Maybe Push toPush (MessagePush mconn mm rs _ event) = let usr = qUnqualified (evtFrom event) - in newPush (Just usr) (toJSONObject event) rs + in newPush (Just usr) (toJSONObject event) rs False <&> set pushConn mconn . set pushNativePriority (mmNativePriority mm) . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index e51070d5f5a..60891ccf145 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -115,6 +115,7 @@ import Wire.API.Conversation.Role (wireConvRoles) import Wire.API.Conversation.Role qualified as Public import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Event.Conversation (evtType, isPydioEvent) import Wire.API.Event.Conversation qualified as Conv import Wire.API.Event.LeaveReason import Wire.API.Event.Team @@ -241,7 +242,7 @@ createBindingTeam tid zusr body = do now <- input let e = newEvent tid now (EdTeamCreate team) pushNotifications - [newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| [])] + [newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| []) False] pure tid updateTeamStatus :: @@ -303,7 +304,7 @@ updateTeamH zusr zcon tid updateData = do admins <- E.getTeamAdmins tid let e = newEvent tid now (EdTeamUpdate updateData) let r = userRecipient zusr :| map userRecipient (filter (/= zusr) admins) - pushNotifications [newPushLocal1 zusr (toJSONObject e) r & pushConn ?~ zcon & pushTransient .~ True] + pushNotifications [newPushLocal1 zusr (toJSONObject e) r False & pushConn ?~ zcon & pushTransient .~ True] deleteTeam :: forall r. @@ -414,7 +415,7 @@ uncheckedDeleteTeam lusr zcon tid = do [] -> pure () -- push TeamDelete events. Note that despite having a complete list, we are guaranteed in the -- push module to never fan this out to more than the limit - x : xs -> pushNotifications [newPushLocal1 (tUnqualified lusr) (toJSONObject e) (x :| xs) & pushConn .~ zcon] + x : xs -> pushNotifications [newPushLocal1 (tUnqualified lusr) (toJSONObject e) (x :| xs) False & pushConn .~ zcon] -- To avoid DoS on gundeck, send conversation deletion events slowly pushNotificationsSlowly ue createConvDeleteEvents :: @@ -432,7 +433,7 @@ uncheckedDeleteTeam lusr zcon tid = do let mm = nonTeamMembers convMembs teamMembs let e = Conv.Event qconvId Nothing (tUntagged lusr) now Conv.EdConvDelete -- This event always contains all the required recipients - let p = newPushLocal (tUnqualified lusr) (toJSONObject e) (map localMemberToRecipient mm) + let p = newPushLocal (tUnqualified lusr) (toJSONObject e) (map localMemberToRecipient mm) (isPydioEvent $ evtType e) let ee' = map (,e) bots let pp' = maybe pp (\x -> (x & pushConn .~ zcon) : pp) p pure (pp', ee' ++ ee) @@ -661,7 +662,7 @@ uncheckedUpdateTeamMember mlzusr mZcon tid newMember = do now <- input let event = newEvent tid now (EdMemberUpdate targetId (Just targetPermissions)) - let pushPriv = newPush mZusr (toJSONObject event) (map userRecipient admins') + let pushPriv = newPush mZusr (toJSONObject event) (map userRecipient admins') False for_ pushPriv (\p -> pushNotifications [p & pushConn .~ mZcon & pushTransient .~ True]) updateTeamMember :: @@ -876,7 +877,7 @@ uncheckedDeleteTeamMember lusr zcon tid remove (Left admins) = do userRecipient <$> (tUnqualified lusr :| filter (/= (tUnqualified lusr)) admins) pushNotifications - [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r & pushConn .~ zcon & pushTransient .~ True] + [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r False & pushConn .~ zcon & pushTransient .~ True] uncheckedDeleteTeamMember lusr zcon tid remove (Right mems) = do now <- input pushMemberLeaveEventToAll now @@ -893,7 +894,7 @@ uncheckedDeleteTeamMember lusr zcon tid remove (Right mems) = do let r = userRecipient (tUnqualified lusr) :| membersToRecipients (Just (tUnqualified lusr)) (mems ^. teamMembers) when (mems ^. teamMemberListType == ListComplete) $ do pushNotifications - [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r & pushTransient .~ True] + [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r False & pushTransient .~ True] removeFromConvsAndPushConvLeaveEvent :: forall r. @@ -1173,7 +1174,7 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) = do Just o -> userRecipient <$> o :| filter (/= o) ((new ^. userId) : admins') Nothing -> userRecipient <$> new ^. userId :| admins' pushNotifications - [ newPushLocal1 (new ^. userId) (toJSONObject e) rs + [ newPushLocal1 (new ^. userId) (toJSONObject e) rs False & pushConn .~ originConn & pushTransient .~ True ] diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 014990948f4..bc292568da6 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -213,7 +213,7 @@ pushFeatureEvent tid event = do let recipients = membersToRecipients Nothing (memList ^. teamMembers) pushNotifications $ maybeToList $ - (newPush Nothing (toJSONObject event) recipients) + (newPush Nothing (toJSONObject event) recipients False) guardLockStatus :: forall r. diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 6c4280eb441..c092bda1c24 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -1571,7 +1571,7 @@ addBot lusr zcon b = do ] ) ) - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users)) $ \p -> + for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users) (isPydioEvent $ evtType e)) $ \p -> pushNotifications [p & pushConn ?~ zcon] E.deliverAsync (map (,e) (bm : bots)) pure e @@ -1624,7 +1624,7 @@ rmBot lusr zcon b = do do let evd = EdMembersLeaveRemoved (QualifiedUserIdList [tUntagged (qualifyAs lusr (botUserId (b ^. rmBotId)))]) let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) t evd - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users)) $ \p -> + for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users) (isPydioEvent (evtType e))) $ \p -> pushNotifications [p & pushConn .~ zcon] E.deleteMembers (Data.convId c) (UserList [botUserId (b ^. rmBotId)] []) E.deleteClients (botUserId (b ^. rmBotId)) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 617c7c231cc..4c19e6eeee6 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -341,7 +341,7 @@ acceptOne2One lusr conv conn = do let e = memberJoinEvent lusr (tUntagged lcid) now mm [] conv' <- if isJust (find ((tUnqualified lusr /=) . lmId) mems) then promote else pure conv let mems' = mems <> toList mm - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> mems')) $ \p -> + for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> mems') False) $ \p -> pushNotifications [p & pushConn .~ conn & pushRoute .~ PushV2.RouteDirect] pure conv' {Data.convLocalMembers = mems'} _ -> throwS @'InvalidOperation @@ -649,7 +649,7 @@ pushConversationEvent conn e lusers bots = do newConversationEventPush :: Event -> Local [UserId] -> Maybe Push newConversationEventPush e users = let musr = guard (tDomain users == qDomain (evtFrom e)) $> qUnqualified (evtFrom e) - in newPush musr (toJSONObject e) (map userRecipient (tUnqualified users)) + in newPush musr (toJSONObject e) (map userRecipient (tUnqualified users)) (isPydioEvent $ evtType e) verifyReusableCode :: ( Member CodeStore r, diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index 17ed2a08e47..afb42695e25 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -324,7 +324,7 @@ pushViaRabbitMq p = do for_ routingKeys $ \routingKey -> mpaPublishToRabbitMq routingKey qMsg -pushToPydio +pushToPydio = todo -- | A new notification to be stored in C* and pushed over websockets data NewNotification = NewNotification From 9822793dc6430bc47b270da985d381ecfff479d0 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Feb 2025 09:58:35 +0100 Subject: [PATCH 4/8] fixup! add ispydio flag to pushes --- libs/wire-subsystems/src/Wire/NotificationSubsystem.hs | 2 ++ services/gundeck/src/Gundeck/Push.hs | 3 --- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs index 8ade4ccd690..ead57636d4d 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs @@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -Wwarn #-} + module Wire.NotificationSubsystem where import Control.Concurrent.Async (Async) diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index afb42695e25..c4c43ccf483 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -240,7 +240,6 @@ pushAll pushes = do (rabbitmqPushes, legacyPushes) <- splitPushes pushes pushAllLegacy legacyPushes pushAllViaRabbitMq rabbitmqPushes - pushToPydio pushes -- | Construct and send a single bulk push request to the client. Write the 'Notification's from -- the request to C*. Trigger native pushes for all delivery failures notifications. @@ -324,8 +323,6 @@ pushViaRabbitMq p = do for_ routingKeys $ \routingKey -> mpaPublishToRabbitMq routingKey qMsg -pushToPydio = todo - -- | A new notification to be stored in C* and pushed over websockets data NewNotification = NewNotification { nnPush :: Push, From 50a11d7669542ceec14f80af703e836bbf1d247a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Feb 2025 09:52:36 +0100 Subject: [PATCH 5/8] Allow empty recipient list --- libs/wire-api/src/Wire/API/Push/V2.hs | 4 +- .../src/Wire/NotificationSubsystem.hs | 18 ++------- .../Wire/NotificationSubsystem/Interpreter.hs | 3 +- .../NotificationSubsystem/InterpreterSpec.hs | 26 +++++++------ services/brig/src/Brig/IO/Intra.hs | 6 +-- services/galley/src/Galley/API/Action.hs | 13 +++---- services/galley/src/Galley/API/Create.hs | 25 ++++++------ services/galley/src/Galley/API/Internal.hs | 4 +- services/galley/src/Galley/API/Push.hs | 12 +++--- services/galley/src/Galley/API/Teams.hs | 38 +++++++++++-------- .../galley/src/Galley/API/Teams/Features.hs | 5 +-- services/galley/src/Galley/API/Update.hs | 20 ++++++++-- services/galley/src/Galley/API/Util.hs | 12 +++--- services/gundeck/src/Gundeck/Push.hs | 14 +++---- services/gundeck/test/integration/API.hs | 2 +- services/gundeck/test/unit/MockGundeck.hs | 4 +- 16 files changed, 106 insertions(+), 100 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Push/V2.hs b/libs/wire-api/src/Wire/API/Push/V2.hs index 6010d388092..f69dc229c57 100644 --- a/libs/wire-api/src/Wire/API/Push/V2.hs +++ b/libs/wire-api/src/Wire/API/Push/V2.hs @@ -227,7 +227,7 @@ data Push = Push -- assumption that no 'ConnId' is used by two 'Recipient's. This is *probably* correct, but -- not in any contract. (Changing this may require a new version module, since we need to -- support both the old and the new data type simultaneously during upgrade.) - _pushRecipients :: Range 1 1024 (Set Recipient), + _pushRecipients :: Range 0 1024 (Set Recipient), -- | Originating user -- -- 'Nothing' here means that the originating user is on another backend. @@ -262,7 +262,7 @@ data Push = Push deriving (Eq, Show) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema Push) -newPush :: Maybe UserId -> Range 1 1024 (Set Recipient) -> List1 Object -> Push +newPush :: Maybe UserId -> Range 0 1024 (Set Recipient) -> List1 Object -> Push newPush from to pload = Push { _pushRecipients = to, diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs index ead57636d4d..84c2de5a0f5 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs @@ -1,14 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS -Wwarn #-} - module Wire.NotificationSubsystem where import Control.Concurrent.Async (Async) import Control.Lens (makeLenses) import Data.Aeson import Data.Id -import Data.List.NonEmpty (NonEmpty ((:|))) import Imports import Polysemy import Wire.API.Push.V2 hiding (Push (..), Recipient, newPush) @@ -27,7 +24,7 @@ data Push = Push _pushRoute :: Route, _pushNativePriority :: Maybe Priority, pushOrigin :: Maybe UserId, - _pushRecipients :: NonEmpty Recipient, + _pushRecipients :: [Recipient], pushJson :: Object, _pushApsData :: Maybe ApsData, pushIsPydioEvent :: Bool @@ -56,8 +53,8 @@ data NotificationSubsystem m a where makeSem ''NotificationSubsystem -newPush1 :: Maybe UserId -> Object -> NonEmpty Recipient -> Bool -> Push -newPush1 from e rr isPydioEvent = +newPush :: Maybe UserId -> Object -> [Recipient] -> Bool -> Push +newPush from e rr isPydioEvent = Push { _pushConn = Nothing, _pushTransient = False, @@ -70,12 +67,5 @@ newPush1 from e rr isPydioEvent = pushIsPydioEvent = isPydioEvent } -newPush :: Maybe UserId -> Object -> [Recipient] -> Bool -> Maybe Push -newPush _ _ [] _ = todo -newPush u e (r : rr) isPydioEvent = Just $ newPush1 u e (r :| rr) isPydioEvent - -newPushLocal :: UserId -> Object -> [Recipient] -> Bool -> Maybe Push +newPushLocal :: UserId -> Object -> [Recipient] -> Bool -> Push newPushLocal uid = newPush (Just uid) - -newPushLocal1 :: UserId -> Object -> NonEmpty Recipient -> Bool -> Push -newPushLocal1 uid = newPush1 (Just uid) diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs index 6a8e24875df..f23828987e3 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs @@ -4,7 +4,6 @@ import Bilge (RequestId) import Control.Concurrent.Async (Async) import Control.Lens (set, (.~)) import Data.Aeson -import Data.List.NonEmpty (nonEmpty) import Data.List1 (List1) import Data.List1 qualified as List1 import Data.Proxy @@ -155,7 +154,7 @@ chunkPushes maxRecipients splitPush :: Natural -> Push -> (Push, Push) splitPush n p = let (r1, r2) = splitAt (fromIntegral n) (toList p._pushRecipients) - in (p {_pushRecipients = fromJust $ nonEmpty r1}, p {_pushRecipients = fromJust $ nonEmpty r2}) + in (p {_pushRecipients = r1}, p {_pushRecipients = r2}) pushSlowlyImpl :: ( Member Delay r, diff --git a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs index dcf75b35905..73f990bed25 100644 --- a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs @@ -4,7 +4,6 @@ import Control.Concurrent.Async (async, wait) import Control.Exception (throwIO) import Data.Data (Proxy (Proxy)) import Data.Id -import Data.List.NonEmpty (NonEmpty ((:|)), fromList) import Data.List1 qualified as List1 import Data.Range (fromRange, toRange) import Data.Set qualified as Set @@ -54,7 +53,7 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushRoute = V2.RouteDirect, _pushNativePriority = Nothing, pushOrigin = Nothing, - _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], + _pushRecipients = [Recipient user1 (V2.RecipientClientsSome clients1)], pushJson = payload1, _pushApsData = Nothing, pushIsPydioEvent = False @@ -67,8 +66,9 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushNativePriority = Just V2.LowPriority, pushOrigin = Just origin2, _pushRecipients = - Recipient user21 V2.RecipientClientsAll - :| [Recipient user22 V2.RecipientClientsAll], + [ Recipient user21 V2.RecipientClientsAll, + Recipient user22 V2.RecipientClientsAll + ], pushJson = payload2, _pushApsData = Just apsData, pushIsPydioEvent = False @@ -107,7 +107,7 @@ spec = describe "NotificationSubsystem.Interpreter" do origin2 <- generate arbitrary (user21, user22) <- generate arbitrary (payload1, payload2) <- generate $ resize 1 arbitrary - lotOfRecipients <- fromList <$> replicateM 31 (generate arbitrary) + lotOfRecipients <- replicateM 31 (generate arbitrary) apsData <- generate arbitrary let pushBiggerThanFanoutLimit = Push @@ -129,8 +129,9 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushNativePriority = Just V2.LowPriority, pushOrigin = Just origin2, _pushRecipients = - Recipient user21 V2.RecipientClientsAll - :| [Recipient user22 V2.RecipientClientsAll], + [ Recipient user21 V2.RecipientClientsAll, + Recipient user22 V2.RecipientClientsAll + ], pushJson = payload2, _pushApsData = Just apsData, pushIsPydioEvent = False @@ -172,7 +173,7 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushRoute = V2.RouteDirect, _pushNativePriority = Nothing, pushOrigin = Nothing, - _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], + _pushRecipients = [Recipient user1 (V2.RecipientClientsSome clients1)], pushJson = payload1, _pushApsData = Nothing, pushIsPydioEvent = False @@ -185,8 +186,9 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushNativePriority = Just V2.LowPriority, pushOrigin = Just origin2, _pushRecipients = - Recipient user21 V2.RecipientClientsAll - :| [Recipient user22 V2.RecipientClientsAll], + [ Recipient user21 V2.RecipientClientsAll, + Recipient user22 V2.RecipientClientsAll + ], pushJson = payload2, _pushApsData = Nothing, pushIsPydioEvent = False @@ -230,7 +232,7 @@ spec = describe "NotificationSubsystem.Interpreter" do _pushRoute = V2.RouteDirect, _pushNativePriority = Nothing, pushOrigin = Nothing, - _pushRecipients = Recipient user1 (V2.RecipientClientsSome clients1) :| [], + _pushRecipients = [Recipient user1 (V2.RecipientClientsSome clients1)], pushJson = payload1, _pushApsData = Nothing, pushIsPydioEvent = False @@ -361,7 +363,7 @@ waitUntilPushes pushesRef n = do normalisePush :: Push -> [Push] normalisePush p = map - (\r -> p {_pushRecipients = r :| []}) + (\r -> p {_pushRecipients = [r]}) (toList (_pushRecipients p)) sizeOfChunks :: [Push] -> Natural diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 9798d9ff74d..6015d655d47 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -182,9 +182,9 @@ onClientEvent :: Sem r () onClientEvent orig conn e = do let event = ClientEvent e - let rcps = Recipient orig V2.RecipientClientsAll :| [] + let rcpt = Recipient orig V2.RecipientClientsAll pushNotifications - [ newPush1 (Just orig) (toJSONObject event) rcps False + [ newPush (Just orig) (toJSONObject event) [rcpt] False & pushConn .~ conn & pushApsData .~ toApsData event ] @@ -356,7 +356,7 @@ notify :: notify event orig route conn recipients = do rs <- (\u -> Recipient u RecipientClientsAll) <$$> recipients let push = - newPush1 (Just orig) (toJSONObject event) rs False + newPush (Just orig) (toJSONObject event) (toList rs) False & pushConn .~ conn & pushRoute .~ route & pushApsData .~ toApsData event diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 2c9af1e1425..a3cc397bcd0 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -1099,10 +1099,9 @@ pushTypingIndicatorEvents :: Sem r () pushTypingIndicatorEvents qusr tEvent users mcon qcnv ts = do let e = Event qcnv Nothing qusr tEvent (EdTyping ts) - for_ (newPushLocal (qUnqualified qusr) (toJSONObject e) (userRecipient <$> users) False) $ \p -> - pushNotifications - [ p - & pushConn .~ mcon - & pushRoute .~ PushV2.RouteDirect - & pushTransient .~ True - ] + pushNotifications + [ newPushLocal (qUnqualified qusr) (toJSONObject e) (userRecipient <$> users) False + & pushConn .~ mcon + & pushRoute .~ PushV2.RouteDirect + & pushTransient .~ True + ] diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index c1ac95a3485..976afa29596 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -35,7 +35,6 @@ import Control.Error (headMay) import Control.Lens hiding ((??)) import Data.Id import Data.Json.Util -import Data.List.NonEmpty qualified as NonEmpty import Data.Misc (FutureWork (FutureWork)) import Data.Qualified import Data.Range @@ -551,12 +550,11 @@ createConnectConversation lusr conn j = do now <- input let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConnect j) notifyCreatedConversation lusr conn c - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) (isPydioEvent $ evtType e)) $ \p -> - pushNotifications - [ p - & pushRoute .~ PushV2.RouteDirect - & pushConn .~ conn - ] + pushNotifications + [ newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) (isPydioEvent $ evtType e) + & pushRoute .~ PushV2.RouteDirect + & pushConn .~ conn + ] conversationCreated lusr c update n conv = do let mems = Data.convLocalMembers conv @@ -591,12 +589,11 @@ createConnectConversation lusr conn j = do Nothing -> pure $ Data.convName conv t <- input let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) t (EdConnect j) - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers conv) (isPydioEvent $ evtType e)) $ \p -> - pushNotifications - [ p - & pushRoute .~ PushV2.RouteDirect - & pushConn .~ conn - ] + pushNotifications + [ newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers conv) (isPydioEvent $ evtType e) + & pushRoute .~ PushV2.RouteDirect + & pushConn .~ conn + ] pure $ Data.convSetName n' conv | otherwise = pure conv @@ -691,7 +688,7 @@ notifyCreatedConversation lusr conn c = do c' <- conversationViewWithCachedOthers remoteOthers localOthers c (qualifyAs lusr (lmId m)) let e = Event (tUntagged lconv) Nothing (tUntagged lusr) t (EdConversation c') pure $ - newPushLocal1 (tUnqualified lusr) (toJSONObject e) (NonEmpty.singleton (localMemberToRecipient m)) (isPydioEvent $ evtType e) + newPushLocal (tUnqualified lusr) (toJSONObject e) [localMemberToRecipient m] (isPydioEvent $ evtType e) & pushConn .~ conn & pushRoute .~ route diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index df01f37f96c..ab227f5bdeb 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -390,9 +390,9 @@ rmUser lusr conn = do now (EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser])) for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c) - pure $ + pure . Just $ newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> Data.convLocalMembers c) (isPydioEvent $ evtType e) - <&> set pushConn conn + & set pushConn conn . set pushRoute PushV2.RouteDirect | otherwise -> pure Nothing diff --git a/services/galley/src/Galley/API/Push.hs b/services/galley/src/Galley/API/Push.hs index 0aa6892bae8..bd6e539bf2c 100644 --- a/services/galley/src/Galley/API/Push.hs +++ b/services/galley/src/Galley/API/Push.hs @@ -86,18 +86,18 @@ runMessagePush :: MessagePush -> Sem r () runMessagePush loc mqcnv mp@(MessagePush _ _ _ botMembers event) = do - pushNotifications $ maybeToList $ toPush mp + pushNotifications [toPush mp] for_ mqcnv $ \qcnv -> if tDomain loc /= qDomain qcnv then unless (null botMembers) $ do warn $ Log.msg ("Ignoring messages for local bots in a remote conversation" :: ByteString) . Log.field "conversation" (show qcnv) else deliverAndDeleteAsync (qUnqualified qcnv) (map (,event) botMembers) -toPush :: MessagePush -> Maybe Push +toPush :: MessagePush -> Push toPush (MessagePush mconn mm rs _ event) = let usr = qUnqualified (evtFrom event) in newPush (Just usr) (toJSONObject event) rs False - <&> set pushConn mconn - . set pushNativePriority (mmNativePriority mm) - . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) - . set pushTransient (mmTransient mm) + & set pushConn mconn + . set pushNativePriority (mmNativePriority mm) + . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) + . set pushTransient (mmTransient mm) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 60891ccf145..8aa5ffcc3d4 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -67,7 +67,6 @@ import Data.Id import Data.Json.Util import Data.LegalHold qualified as LH import Data.List.Extra qualified as List -import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 (list1) import Data.Map qualified as Map import Data.Proxy @@ -242,7 +241,7 @@ createBindingTeam tid zusr body = do now <- input let e = newEvent tid now (EdTeamCreate team) pushNotifications - [newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| []) False] + [newPushLocal zusr (toJSONObject e) [userRecipient zusr] False] pure tid updateTeamStatus :: @@ -303,8 +302,16 @@ updateTeamH zusr zcon tid updateData = do now <- input admins <- E.getTeamAdmins tid let e = newEvent tid now (EdTeamUpdate updateData) - let r = userRecipient zusr :| map userRecipient (filter (/= zusr) admins) - pushNotifications [newPushLocal1 zusr (toJSONObject e) r False & pushConn ?~ zcon & pushTransient .~ True] + let r = userRecipient zusr : map userRecipient (filter (/= zusr) admins) + pushNotifications + [ newPushLocal + zusr + (toJSONObject e) + r + False + & pushConn ?~ zcon + & pushTransient .~ True + ] deleteTeam :: forall r. @@ -411,11 +418,10 @@ uncheckedDeleteTeam lusr zcon tid = do -- To avoid DoS on gundeck, send team deletion events in chunks let chunkSize = fromMaybe defConcurrentDeletionEvents (o ^. concurrentDeletionEvents) let chunks = List.chunksOf chunkSize (toList r) - forM_ chunks $ \case - [] -> pure () + forM_ chunks $ \chunk -> -- push TeamDelete events. Note that despite having a complete list, we are guaranteed in the -- push module to never fan this out to more than the limit - x : xs -> pushNotifications [newPushLocal1 (tUnqualified lusr) (toJSONObject e) (x :| xs) False & pushConn .~ zcon] + pushNotifications [newPushLocal (tUnqualified lusr) (toJSONObject e) chunk False & pushConn .~ zcon] -- To avoid DoS on gundeck, send conversation deletion events slowly pushNotificationsSlowly ue createConvDeleteEvents :: @@ -435,7 +441,7 @@ uncheckedDeleteTeam lusr zcon tid = do -- This event always contains all the required recipients let p = newPushLocal (tUnqualified lusr) (toJSONObject e) (map localMemberToRecipient mm) (isPydioEvent $ evtType e) let ee' = map (,e) bots - let pp' = maybe pp (\x -> (x & pushConn .~ zcon) : pp) p + let pp' = (p & pushConn .~ zcon) : pp pure (pp', ee' ++ ee) getTeamConversationRoles :: @@ -663,7 +669,7 @@ uncheckedUpdateTeamMember mlzusr mZcon tid newMember = do now <- input let event = newEvent tid now (EdMemberUpdate targetId (Just targetPermissions)) let pushPriv = newPush mZusr (toJSONObject event) (map userRecipient admins') False - for_ pushPriv (\p -> pushNotifications [p & pushConn .~ mZcon & pushTransient .~ True]) + pushNotifications [pushPriv & pushConn .~ mZcon & pushTransient .~ True] updateTeamMember :: forall r. @@ -875,9 +881,9 @@ uncheckedDeleteTeamMember lusr zcon tid remove (Left admins) = do let e = newEvent tid now (EdMemberLeave remove) let r = userRecipient - <$> (tUnqualified lusr :| filter (/= (tUnqualified lusr)) admins) + <$> (tUnqualified lusr : filter (/= (tUnqualified lusr)) admins) pushNotifications - [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r False & pushConn .~ zcon & pushTransient .~ True] + [newPushLocal (tUnqualified lusr) (toJSONObject e) r False & pushConn .~ zcon & pushTransient .~ True] uncheckedDeleteTeamMember lusr zcon tid remove (Right mems) = do now <- input pushMemberLeaveEventToAll now @@ -891,10 +897,10 @@ uncheckedDeleteTeamMember lusr zcon tid remove (Right mems) = do pushMemberLeaveEventToAll :: UTCTime -> Sem r () pushMemberLeaveEventToAll now = do let e = newEvent tid now (EdMemberLeave remove) - let r = userRecipient (tUnqualified lusr) :| membersToRecipients (Just (tUnqualified lusr)) (mems ^. teamMembers) + let r = userRecipient (tUnqualified lusr) : membersToRecipients (Just (tUnqualified lusr)) (mems ^. teamMembers) when (mems ^. teamMemberListType == ListComplete) $ do pushNotifications - [newPushLocal1 (tUnqualified lusr) (toJSONObject e) r False & pushTransient .~ True] + [newPushLocal (tUnqualified lusr) (toJSONObject e) r False & pushTransient .~ True] removeFromConvsAndPushConvLeaveEvent :: forall r. @@ -1171,10 +1177,10 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) = do now <- input let e = newEvent tid now (EdMemberJoin (new ^. userId)) let rs = case origin of - Just o -> userRecipient <$> o :| filter (/= o) ((new ^. userId) : admins') - Nothing -> userRecipient <$> new ^. userId :| admins' + Just o -> userRecipient <$> o : filter (/= o) ((new ^. userId) : admins') + Nothing -> userRecipient <$> new ^. userId : admins' pushNotifications - [ newPushLocal1 (new ^. userId) (toJSONObject e) rs False + [ newPushLocal (new ^. userId) (toJSONObject e) rs False & pushConn .~ originConn & pushTransient .~ True ] diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index bc292568da6..0694d264796 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -211,9 +211,8 @@ pushFeatureEvent tid event = do . Log.msg @Text "Fanout limit exceeded. Events will not be sent." else do let recipients = membersToRecipients Nothing (memList ^. teamMembers) - pushNotifications $ - maybeToList $ - (newPush Nothing (toJSONObject event) recipients False) + pushNotifications + [newPush Nothing (toJSONObject event) recipients False] guardLockStatus :: forall r. diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index c092bda1c24..0c93992c222 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -1571,8 +1571,14 @@ addBot lusr zcon b = do ] ) ) - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users) (isPydioEvent $ evtType e)) $ \p -> - pushNotifications [p & pushConn ?~ zcon] + pushNotifications + [ newPushLocal + (tUnqualified lusr) + (toJSONObject e) + (localMemberToRecipient <$> users) + (isPydioEvent $ evtType e) + & pushConn ?~ zcon + ] E.deliverAsync (map (,e) (bm : bots)) pure e where @@ -1624,8 +1630,14 @@ rmBot lusr zcon b = do do let evd = EdMembersLeaveRemoved (QualifiedUserIdList [tUntagged (qualifyAs lusr (botUserId (b ^. rmBotId)))]) let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) t evd - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> users) (isPydioEvent (evtType e))) $ \p -> - pushNotifications [p & pushConn .~ zcon] + pushNotifications + [ newPushLocal + (tUnqualified lusr) + (toJSONObject e) + (localMemberToRecipient <$> users) + (isPydioEvent (evtType e)) + & pushConn .~ zcon + ] E.deleteMembers (Data.convId c) (UserList [botUserId (b ^. rmBotId)] []) E.deleteClients (botUserId (b ^. rmBotId)) E.deliverAsync (map (,e) bots) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 4c19e6eeee6..fa38d5daa80 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -341,8 +341,8 @@ acceptOne2One lusr conv conn = do let e = memberJoinEvent lusr (tUntagged lcid) now mm [] conv' <- if isJust (find ((tUnqualified lusr /=) . lmId) mems) then promote else pure conv let mems' = mems <> toList mm - for_ (newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> mems') False) $ \p -> - pushNotifications [p & pushConn .~ conn & pushRoute .~ PushV2.RouteDirect] + p = newPushLocal (tUnqualified lusr) (toJSONObject e) (localMemberToRecipient <$> mems') False + pushNotifications [p & pushConn .~ conn & pushRoute .~ PushV2.RouteDirect] pure conv' {Data.convLocalMembers = mems'} _ -> throwS @'InvalidOperation where @@ -642,11 +642,13 @@ pushConversationEvent :: f BotMember -> Sem r () pushConversationEvent conn e lusers bots = do - for_ (newConversationEventPush e (fmap toList lusers)) $ \p -> - pushNotifications [p & set pushConn conn] + pushNotifications + [ newConversationEventPush e (fmap toList lusers) + & set pushConn conn + ] deliverAsync (map (,e) (toList bots)) -newConversationEventPush :: Event -> Local [UserId] -> Maybe Push +newConversationEventPush :: Event -> Local [UserId] -> Push newConversationEventPush e users = let musr = guard (tDomain users == qDomain (evtFrom e)) $> qUnqualified (evtFrom e) in newPush musr (toJSONObject e) (map userRecipient (tUnqualified users)) (isPydioEvent $ evtType e) diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index c4c43ccf483..423a1936f99 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -161,13 +161,13 @@ splitPush clientsFull p = do let (rabbitmqRecipients, legacyRecipients) = partitionHereThereRange . rcast @_ @_ @1024 $ mapRange splitRecipient (rangeSetToList $ p._pushRecipients) - case (runcons rabbitmqRecipients, runcons legacyRecipients) of - (Nothing, _) -> (That p) - (_, Nothing) -> (This p) - (Just (rabbit0, rabbits), Just (legacy0, legacies)) -> + case (null (fromRange rabbitmqRecipients), null (fromRange legacyRecipients)) of + (True, _) -> (That p) + (_, True) -> (This p) + (False, False) -> These - p {_pushRecipients = rangeListToSet $ rcons rabbit0 rabbits} - p {_pushRecipients = rangeListToSet $ rcons legacy0 legacies} + p {_pushRecipients = rangeListToSet rabbitmqRecipients} + p {_pushRecipients = rangeListToSet legacyRecipients} where splitRecipient :: Recipient -> These Recipient Recipient splitRecipient rcpt = do @@ -339,7 +339,7 @@ mkNewNotification psh = NewNotification psh <$> mkNotif <*> rcps pure $ Notification notifId (psh ^. pushTransient) (psh ^. pushPayload) rcps :: m (List1 Recipient) - rcps = assertList1 . toList . fromRange $ (psh ^. pushRecipients :: Range 1 1024 (Set Recipient)) + rcps = assertList1 . toList . fromRange $ (psh ^. pushRecipients :: Range 0 1024 (Set Recipient)) -- Shouldn't fail as we just extracted this from `Range 1 1024` assertList1 :: [a] -> m (List1 a) diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index 5db3cbb086c..b73b563f176 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -1166,7 +1166,7 @@ randomUser = do uid <- nextRandom pure $ loc <> "+" <> UUID.toText uid <> "@" <> dom -toRecipients :: [UserId] -> Range 1 1024 (Set Recipient) +toRecipients :: [UserId] -> Range 0 1024 (Set Recipient) toRecipients = unsafeRange . Set.fromList . map (`recipient` RouteAny) randomConnId :: (MonadIO m) => m ConnId diff --git a/services/gundeck/test/unit/MockGundeck.hs b/services/gundeck/test/unit/MockGundeck.hs index a747a6570a3..ea695994d52 100644 --- a/services/gundeck/test/unit/MockGundeck.hs +++ b/services/gundeck/test/unit/MockGundeck.hs @@ -317,7 +317,7 @@ genPush :: (HasCallStack) => MockEnv -> Gen Push genPush env = do let alluids = allUsers env sender <- QC.elements alluids - rcps :: Range 1 1024 (Set Recipient) <- do + rcps :: Range 0 1024 (Set Recipient) <- do numrcp <- choose (1, min 1024 (length alluids)) rcps <- genRecipients numrcp env unsafeRange . Set.fromList <$> dropSomeDevices `mapM` rcps @@ -377,7 +377,7 @@ shrinkPushes = shrinkList shrinkPush where shrinkPush :: Push -> [Push] shrinkPush psh = (\rcps -> psh & pushRecipients .~ rcps) <$> shrinkRecipients (psh ^. pushRecipients) - shrinkRecipients :: Range 1 1024 (Set Recipient) -> [Range 1 1024 (Set Recipient)] + shrinkRecipients :: Range 0 1024 (Set Recipient) -> [Range 0 1024 (Set Recipient)] shrinkRecipients = fmap unsafeRange . map Set.fromList . filter (not . null) . shrinkList shrinkRecipient . Set.toList . fromRange shrinkRecipient :: Recipient -> [Recipient] shrinkRecipient _ = [] From a78eceddd0a5100eb6b22a2b9a90a78a9927d035 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Feb 2025 10:19:43 +0100 Subject: [PATCH 6/8] Add pydio_state field to conversation table --- services/galley/galley.cabal | 1 + services/galley/src/Galley/Schema/Run.hs | 4 ++- .../Galley/Schema/V95_PydioConversation.hs | 33 +++++++++++++++++++ 3 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 services/galley/src/Galley/Schema/V95_PydioConversation.hs diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index c04af28f356..e3fb856c3b0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -280,6 +280,7 @@ library Galley.Schema.V92_MlsE2EIdConfig Galley.Schema.V93_ConferenceCallingSftForOneToOne Galley.Schema.V94_DomainRegistrationConfig + Galley.Schema.V95_PydioConversation Galley.Types.Clients Galley.Types.ToUserRole Galley.Types.UserList diff --git a/services/galley/src/Galley/Schema/Run.hs b/services/galley/src/Galley/Schema/Run.hs index 0019e0f7de1..0f46de26314 100644 --- a/services/galley/src/Galley/Schema/Run.hs +++ b/services/galley/src/Galley/Schema/Run.hs @@ -95,6 +95,7 @@ import Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout qualified as V91_Te import Galley.Schema.V92_MlsE2EIdConfig qualified as V92_MlsE2EIdConfig import Galley.Schema.V93_ConferenceCallingSftForOneToOne qualified as V93_ConferenceCallingSftForOneToOne import Galley.Schema.V94_DomainRegistrationConfig qualified as V94_DomainRegistrationConfig +import Galley.Schema.V95_PydioConversation qualified as V95_PydioConversation import Imports import Options.Applicative import System.Logger.Extended qualified as Log @@ -190,7 +191,8 @@ migrations = V91_TeamMemberDeletedLimitedEventFanout.migration, V92_MlsE2EIdConfig.migration, V93_ConferenceCallingSftForOneToOne.migration, - V94_DomainRegistrationConfig.migration + V94_DomainRegistrationConfig.migration, + V95_PydioConversation.migration -- FUTUREWORK: once #1726 has made its way to master/production, -- the 'message' field in connections table can be dropped. -- See also https://github.com/wireapp/wire-server/pull/1747/files diff --git a/services/galley/src/Galley/Schema/V95_PydioConversation.hs b/services/galley/src/Galley/Schema/V95_PydioConversation.hs new file mode 100644 index 00000000000..b0e0bb555e5 --- /dev/null +++ b/services/galley/src/Galley/Schema/V95_PydioConversation.hs @@ -0,0 +1,33 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- 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 . +module Galley.Schema.V95_PydioConversation + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 95 "Add pydio state to conversations" $ + schema' + [r| ALTER TABLE conversation ADD ( + pydio_state int + ) + |] From 675c66d6df4115338de74a7bb99b385bd4ceb82c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Feb 2025 10:58:24 +0100 Subject: [PATCH 7/8] Add Pydio state to conversations --- .../src/Wire/API/Federation/API/Galley.hs | 4 +- .../Federation/Golden/ConversationCreated.hs | 7 ++- .../Golden/GetOne2OneConversationResponse.hs | 7 ++- libs/wire-api/src/Wire/API/Conversation.hs | 9 ++- .../src/Wire/API/Conversation/PydioState.hs | 63 +++++++++++++++++++ .../ConversationList_20Conversation_user.hs | 4 +- .../API/Golden/Generated/Conversation_user.hs | 16 +++-- .../Wire/API/Golden/Generated/Event_user.hs | 4 +- libs/wire-api/wire-api.cabal | 1 + services/galley/src/Galley/API/Create.hs | 4 +- services/galley/src/Galley/API/Util.hs | 7 ++- .../src/Galley/Cassandra/Conversation.hs | 39 ++++++------ .../galley/src/Galley/Cassandra/Queries.hs | 46 +++++++------- .../src/Galley/Effects/ConversationStore.hs | 3 + services/galley/test/integration/API.hs | 2 + services/galley/test/integration/API/Util.hs | 4 +- .../galley/test/unit/Test/Galley/Mapping.hs | 1 + 17 files changed, 161 insertions(+), 60 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/Conversation/PydioState.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 7002ac22090..13926b96099 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -37,6 +37,7 @@ import Servant.OpenApi (HasOpenApi (toOpenApi)) import Wire.API.Conversation import Wire.API.Conversation.Action import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role (RoleName) import Wire.API.Conversation.Typing import Wire.API.Error.Galley @@ -350,7 +351,8 @@ data ConversationCreated conv = ConversationCreated nonCreatorMembers :: Set OtherMember, messageTimer :: Maybe Milliseconds, receiptMode :: Maybe ReceiptMode, - protocol :: Protocol + protocol :: Protocol, + pydioState :: Maybe PydioState -- TODO: remove Maybe } deriving stock (Eq, Show, Generic, Functor) deriving (ToJSON, FromJSON) via (CustomEncoded (ConversationCreated conv)) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs index 61a98694401..d48ea3cba72 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs @@ -28,6 +28,7 @@ import Data.UUID qualified as UUID import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role import Wire.API.Federation.API.Galley import Wire.API.MLS.CipherSuite @@ -70,7 +71,8 @@ testObject_ConversationCreated1 = ], messageTimer = Just (Ms 1000), receiptMode = Just (ReceiptMode 42), - protocol = ProtocolProteus + protocol = ProtocolProteus, + pydioState = Nothing } testObject_ConversationCreated2 :: ConversationCreated ConvId @@ -97,5 +99,6 @@ testObject_ConversationCreated2 = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 ) ) - ) + ), + pydioState = Just PydioPending } diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs index 9ea43d45966..234f270d706 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs @@ -9,6 +9,7 @@ import Data.UUID qualified as UUID import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role import Wire.API.Federation.API.Galley import Wire.API.MLS.Keys @@ -68,7 +69,8 @@ remoteConversation = cnvmName = Just " 0", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), cnvmMessageTimer = Nothing, - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}), + cnvmPydioState = PydioDisabled }, members = RemoteConvMembers @@ -105,7 +107,8 @@ remoteConversationV2 = cnvmName = Just " 0", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), cnvmMessageTimer = Nothing, - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}), + cnvmPydioState = PydioPending }, members = RemoteConvMembers diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index fb851d4be9c..e3515953d7c 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -90,6 +90,7 @@ import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Aeson qualified as A import Data.ByteString.Lazy qualified as LBS +import Data.Default import Data.Domain import Data.Id import Data.List.Extra (disjointOrd) @@ -111,6 +112,7 @@ import Imports import System.Random (randomRIO) import Wire.API.Conversation.Member import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) import Wire.API.Event.LeaveReason import Wire.API.MLS.Group @@ -136,7 +138,8 @@ data ConversationMetadata = ConversationMetadata -- federation. cnvmTeam :: Maybe TeamId, cnvmMessageTimer :: Maybe Milliseconds, - cnvmReceiptMode :: Maybe ReceiptMode + cnvmReceiptMode :: Maybe ReceiptMode, + cnvmPydioState :: PydioState } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationMetadata) @@ -152,7 +155,8 @@ defConversationMetadata mCreator = cnvmName = Nothing, cnvmTeam = Nothing, cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing + cnvmReceiptMode = Nothing, + cnvmPydioState = def } accessRolesVersionedSchema :: Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole) @@ -212,6 +216,7 @@ conversationMetadataObjectSchema sch = (description ?~ "Per-conversation message timer (can be null)") (maybeWithDefault A.Null schema) <*> cnvmReceiptMode .= optField "receipt_mode" (maybeWithDefault A.Null schema) + <*> cnvmPydioState .= (fromMaybe def <$> optField "pydio_state" schema) instance ToSchema ConversationMetadata where schema = object "ConversationMetadata" (conversationMetadataObjectSchema accessRolesSchema) diff --git a/libs/wire-api/src/Wire/API/Conversation/PydioState.hs b/libs/wire-api/src/Wire/API/Conversation/PydioState.hs new file mode 100644 index 00000000000..f9873c1a168 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Conversation/PydioState.hs @@ -0,0 +1,63 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- 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 . + +module Wire.API.Conversation.PydioState where + +import Cassandra.CQL +import Data.Aeson (FromJSON, ToJSON) +import Data.Default +import Data.OpenApi qualified as S +import Data.Schema +import Imports +import Wire.Arbitrary + +data PydioState + = -- | Pydio is not enabled + PydioDisabled + | -- | Pydio is being initialised + PydioPending + | -- | Pydio is ready + PydioReady + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform PydioState) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema PydioState + +instance Default PydioState where + def = PydioDisabled + +instance ToSchema PydioState where + schema = + enum @Text "PydioState" $ + mconcat + [ element "disabled" PydioDisabled, + element "pending" PydioPending, + element "ready" PydioReady + ] + +instance Cql PydioState where + ctype = Tagged IntColumn + + toCql PydioDisabled = CqlInt 0 + toCql PydioPending = CqlInt 1 + toCql PydioReady = CqlInt 2 + + fromCql (CqlInt i) = case i of + 0 -> pure PydioDisabled + 1 -> pure PydioPending + 2 -> pure PydioReady + n -> Left $ "unexpected pydio_state: " ++ show n + fromCql _ = Left "pydio_state: int expected" diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs index c5e394080d7..2ae467ef5c1 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs @@ -28,6 +28,7 @@ import Data.UUID qualified as UUID (fromString) import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role (parseRoleName) domain :: Domain @@ -48,7 +49,8 @@ testObject_ConversationList_20Conversation_user_1 = cnvmName = Just "", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), cnvmMessageTimer = Just (Ms {ms = 4760386328981119}), - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 0}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 0}), + cnvmPydioState = PydioReady }, cnvProtocol = ProtocolProteus, cnvMembers = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Conversation_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Conversation_user.hs index daf78e839bb..e6dde206d61 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Conversation_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Conversation_user.hs @@ -37,6 +37,7 @@ import Data.UUID qualified as UUID (fromString) import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role (parseRoleName) import Wire.API.MLS.CipherSuite import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) @@ -57,7 +58,8 @@ testObject_Conversation_user_1 = cnvmName = Just " 0", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), cnvmMessageTimer = Nothing, - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}), + cnvmPydioState = PydioReady }, cnvProtocol = ProtocolProteus, cnvMembers = @@ -104,7 +106,8 @@ testObject_Conversation_user_2 = cnvmName = Just "", cnvmTeam = Nothing, cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvmReceiptMode = Nothing + cnvmReceiptMode = Nothing, + cnvmPydioState = PydioPending }, cnvProtocol = ProtocolProteus, cnvMembers = @@ -170,7 +173,8 @@ testObject_Conversation_user_3 = cnvmName = Just "", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}), + cnvmPydioState = PydioDisabled }, cnvMembers = ConvMembers @@ -232,7 +236,8 @@ testObject_Conversation_user_4 = cnvmName = Just "", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}), + cnvmPydioState = PydioDisabled }, cnvMembers = ConvMembers @@ -272,7 +277,8 @@ testObject_Conversation_user_5 = cnvmName = Just " 0", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), cnvmMessageTimer = Nothing, - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}), + cnvmPydioState = PydioDisabled }, cnvMembers = ConvMembers diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs index edb0ec1dc75..b28ab206bee 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs @@ -31,6 +31,7 @@ import Imports import Wire.API.Conversation import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role (parseRoleName) import Wire.API.Conversation.Typing import Wire.API.Event.Conversation @@ -156,7 +157,8 @@ testObject_Event_user_8 = cnvmName = Just "\a\SO\r", cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), cnvmMessageTimer = Just (Ms {ms = 283898987885780}), - cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -1}) + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -1}), + cnvmPydioState = PydioDisabled }, cnvProtocol = ProtocolProteus, cnvMembers = diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 974dd9c4987..a3fa1739591 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -84,6 +84,7 @@ library Wire.API.Conversation.Code Wire.API.Conversation.Member Wire.API.Conversation.Protocol + Wire.API.Conversation.PydioState Wire.API.Conversation.Role Wire.API.Conversation.Typing Wire.API.CustomBackend diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 976afa29596..4480d65f836 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -33,6 +33,7 @@ where import Control.Error (headMay) import Control.Lens hiding ((??)) +import Data.Default import Data.Id import Data.Json.Util import Data.Misc (FutureWork (FutureWork)) @@ -628,7 +629,8 @@ newRegularConversation lusr newConv = do cnvmName = fmap fromRange (newConvName newConv), cnvmMessageTimer = newConvMessageTimer newConv, cnvmReceiptMode = newConvReceiptMode newConv, - cnvmTeam = fmap cnvTeamId (newConvTeam newConv) + cnvmTeam = fmap cnvTeamId (newConvTeam newConv), + cnvmPydioState = def }, ncUsers = ulAddLocal (toUserRole (tUnqualified lusr)) (fmap (,newConvUsersRole newConv) (fromConvSize users)), ncProtocol = newConvProtocol newConv diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index fa38d5daa80..b138abef947 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -23,6 +23,7 @@ import Control.Lens (set, to, view, (.~), (^.)) import Control.Monad.Extra (allM, anyM) import Data.Bifunctor import Data.Code qualified as Code +import Data.Default import Data.Domain (Domain) import Data.Id as Id import Data.Json.Util @@ -745,7 +746,8 @@ toConversationCreated now lusr Data.Conversation {convMetadata = ConversationMet nonCreatorMembers = Set.empty, messageTimer = cnvmMessageTimer, receiptMode = cnvmReceiptMode, - protocol = convProtocol + protocol = convProtocol, + pydioState = Just cnvmPydioState } -- | The function converts a 'ConversationCreated' value to a @@ -805,7 +807,8 @@ fromConversationCreated loc rc@ConversationCreated {..} = -- domain. cnvmTeam = Nothing, cnvmMessageTimer = messageTimer, - cnvmReceiptMode = receiptMode + cnvmReceiptMode = receiptMode, + cnvmPydioState = fromMaybe def pydioState } (ConvMembers this others) ProtocolProteus diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 5bc1fdc7ebe..539f7eb01df 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -28,6 +28,7 @@ import Cassandra.Util import Control.Error.Util import Control.Monad.Trans.Maybe import Data.ByteString.Conversion +import Data.Default import Data.Id import Data.Map qualified as Map import Data.Misc @@ -56,6 +57,7 @@ import System.Logger qualified as Log import UnliftIO qualified import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.MLS.CipherSuite import Wire.API.MLS.Group.Serialisation import Wire.API.MLS.GroupInfo @@ -171,10 +173,10 @@ conversationMeta conv = (toConvMeta =<<) <$> retry x1 (query1 Cql.selectConv (params LocalQuorum (Identity conv))) where - toConvMeta (t, mc, a, r, r', n, i, _, mt, rm, _, _, _, _, _) = do + toConvMeta (t, mc, a, r, r', n, i, _, mt, rm, _, _, _, _, _, mps) = do let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> r' accessRoles = maybeRole t $ parseAccessRoles r mbAccessRolesV2 - pure $ ConversationMetadata t mc (defAccess t a) accessRoles n i mt rm + pure $ ConversationMetadata t mc (defAccess t a) accessRoles n i mt rm (fromMaybe def mps) getGroupInfo :: ConvId -> Client (Maybe GroupInfoData) getGroupInfo cid = do @@ -231,6 +233,13 @@ updateConvCipherSuite cid cs = Cql.updateConvCipherSuite (params LocalQuorum (cs, cid)) +updateConvPydioState :: ConvId -> PydioState -> Client () +updateConvPydioState cid ps = + retry x5 $ + write + Cql.updateConvPydioState + (params LocalQuorum (ps, cid)) + setGroupInfo :: ConvId -> GroupInfoData -> Client () setGroupInfo conv gid = write Cql.updateGroupInfo (params LocalQuorum (gid, conv)) @@ -345,26 +354,10 @@ toConv :: ConvId -> [LocalMember] -> [RemoteMember] -> - Maybe - ( ConvType, - Maybe UserId, - Maybe (Cql.Set Access), - Maybe AccessRoleLegacy, - Maybe (Cql.Set AccessRole), - Maybe Text, - Maybe TeamId, - Maybe Bool, - Maybe Milliseconds, - Maybe ReceiptMode, - Maybe ProtocolTag, - Maybe GroupId, - Maybe Epoch, - Maybe (Writetime Epoch), - Maybe CipherSuiteTag - ) -> + Maybe Cql.ConvRow -> Maybe Conversation toConv cid ms remoteMems mconv = do - (cty, muid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mts, mcs) <- mconv + (cty, muid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mts, mcs, mps) <- mconv let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> roleV2 accessRoles = maybeRole cty $ parseAccessRoles role mbAccessRolesV2 proto <- toProtocol ptag mgid mep (writetimeToUTC <$> mts) mcs @@ -384,7 +377,8 @@ toConv cid ms remoteMems mconv = do cnvmName = nme, cnvmTeam = ti, cnvmMessageTimer = timer, - cnvmReceiptMode = rm + cnvmReceiptMode = rm, + cnvmPydioState = fromMaybe def mps } } @@ -482,6 +476,9 @@ interpretConversationStoreToCassandra = interpret $ \case SetConversationCipherSuite cid cs -> do logEffect "ConversationStore.SetConversationCipherSuite" embedClient $ updateConvCipherSuite cid cs + SetConversationPydioState cid ps -> do + logEffect "ConversationStore.SetConversationPydioState" + embedClient $ updateConvPydioState cid ps DeleteConversation cid -> do logEffect "ConversationStore.DeleteConversation" embedClient $ deleteConversation cid diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 309996486b6..568d09504c6 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -32,6 +32,7 @@ import Text.RawString.QQ import Wire.API.Conversation import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.Conversation.Role import Wire.API.MLS.CipherSuite import Wire.API.MLS.GroupInfo @@ -212,27 +213,27 @@ updateTeamSplashScreen = {- `IF EXISTS`, but that requires benchmarking -} "upda -- Conversations ------------------------------------------------------------ -selectConv :: - PrepQuery - R - (Identity ConvId) - ( ConvType, - Maybe UserId, - Maybe (C.Set Access), - Maybe AccessRoleLegacy, - Maybe (C.Set AccessRole), - Maybe Text, - Maybe TeamId, - Maybe Bool, - Maybe Milliseconds, - Maybe ReceiptMode, - Maybe ProtocolTag, - Maybe GroupId, - Maybe Epoch, - Maybe (Writetime Epoch), - Maybe CipherSuiteTag - ) -selectConv = "select type, creator, access, access_role, access_roles_v2, name, team, deleted, message_timer, receipt_mode, protocol, group_id, epoch, WRITETIME(epoch), cipher_suite from conversation where conv = ?" +type ConvRow = + ( ConvType, + Maybe UserId, + Maybe (C.Set Access), + Maybe AccessRoleLegacy, + Maybe (C.Set AccessRole), + Maybe Text, + Maybe TeamId, + Maybe Bool, + Maybe Milliseconds, + Maybe ReceiptMode, + Maybe ProtocolTag, + Maybe GroupId, + Maybe Epoch, + Maybe (Writetime Epoch), + Maybe CipherSuiteTag, + Maybe PydioState + ) + +selectConv :: PrepQuery R (Identity ConvId) ConvRow +selectConv = "select type, creator, access, access_role, access_roles_v2, name, team, deleted, message_timer, receipt_mode, protocol, group_id, epoch, WRITETIME(epoch), cipher_suite, pydio_state from conversation where conv = ?" isConvDeleted :: PrepQuery R (Identity ConvId) (Identity (Maybe Bool)) isConvDeleted = "select deleted from conversation where conv = ?" @@ -295,6 +296,9 @@ updateConvEpoch = {- `IF EXISTS`, but that requires benchmarking -} "update conv updateConvCipherSuite :: PrepQuery W (CipherSuiteTag, ConvId) () updateConvCipherSuite = "update conversation set cipher_suite = ? where conv = ?" +updateConvPydioState :: PrepQuery W (PydioState, ConvId) () +updateConvPydioState = "update conversation set pydio_state = ? where conv = ?" + deleteConv :: PrepQuery W (Identity ConvId) () deleteConv = "delete from conversation using timestamp 32503680000000000 where conv = ?" diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index d85d2258e85..93b9e804bc7 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -44,6 +44,7 @@ module Galley.Effects.ConversationStore setConversationMessageTimer, setConversationEpoch, setConversationCipherSuite, + setConversationPydioState, acceptConnectConversation, setGroupInfo, updateToMixedProtocol, @@ -70,6 +71,7 @@ import Imports import Polysemy import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Protocol +import Wire.API.Conversation.PydioState import Wire.API.MLS.CipherSuite (CipherSuiteTag) import Wire.API.MLS.GroupInfo @@ -98,6 +100,7 @@ data ConversationStore m a where SetConversationMessageTimer :: ConvId -> Maybe Milliseconds -> ConversationStore m () SetConversationEpoch :: ConvId -> Epoch -> ConversationStore m () SetConversationCipherSuite :: ConvId -> CipherSuiteTag -> ConversationStore m () + SetConversationPydioState :: ConvId -> PydioState -> ConversationStore m () SetGroupInfo :: ConvId -> GroupInfoData -> ConversationStore m () AcquireCommitLock :: GroupId -> Epoch -> NominalDiffTime -> ConversationStore m LockAcquired ReleaseCommitLock :: GroupId -> Epoch -> ConversationStore m () diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 4a0fbfec952..e8c5c778724 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -49,6 +49,7 @@ import Data.Aeson hiding (json) import Data.ByteString qualified as BS import Data.ByteString.Conversion import Data.Code qualified as Code +import Data.Default import Data.Domain import Data.Id import Data.Json.Util (toBase64Text, toUTCTimeMillis) @@ -2197,6 +2198,7 @@ accessConvMeta = do Nothing Nothing Nothing + def get (g . paths ["i/conversations", toByteString' conv, "meta"] . zUser alice) !!! do const 200 === statusCode const (Just meta) === (decode <=< responseBody) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 83a63582ec1..ac552a7e565 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1499,7 +1499,8 @@ registerRemoteConv convId originUser name othMembers = do nonCreatorMembers = othMembers, messageTimer = Nothing, receiptMode = Nothing, - protocol = ProtocolProteus + protocol = ProtocolProteus, + pydioState = Nothing } ------------------------------------------------------------------------------- @@ -2296,6 +2297,7 @@ mkProteusConv cnvId creator selfRole otherMembers = Nothing Nothing Nothing + def ) (RemoteConvMembers selfRole otherMembers) ProtocolProteus diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index b52bf67fd92..7ce1dbec429 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -140,6 +140,7 @@ genConversationMetadata = <*> pure Nothing <*> pure Nothing <*> pure Nothing + <*> arbitrary newtype RandomConversation = RandomConversation {unRandomConversation :: Data.Conversation} From 56efaf3fedba6eec7ae6abcdff20c790f2326618 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Feb 2025 11:05:28 +0100 Subject: [PATCH 8/8] Update golden tests --- .../testObject_ConversationList_20Conversation_v2_user_1.json | 1 + libs/wire-api/test/golden/testObject_Conversation_user_1.json | 1 + libs/wire-api/test/golden/testObject_Conversation_user_2.json | 1 + libs/wire-api/test/golden/testObject_Conversation_user_3.json | 1 + libs/wire-api/test/golden/testObject_Conversation_user_4.json | 1 + libs/wire-api/test/golden/testObject_Conversation_user_5.json | 1 + .../wire-api/test/golden/testObject_Conversation_v2_user_1.json | 1 + .../wire-api/test/golden/testObject_Conversation_v2_user_2.json | 1 + .../wire-api/test/golden/testObject_Conversation_v2_user_3.json | 1 + .../wire-api/test/golden/testObject_Conversation_v2_user_4.json | 1 + .../wire-api/test/golden/testObject_Conversation_v2_user_5.json | 1 + .../wire-api/test/golden/testObject_Conversation_v5_user_1.json | 1 + .../wire-api/test/golden/testObject_Conversation_v5_user_2.json | 1 + .../wire-api/test/golden/testObject_Conversation_v5_user_3.json | 1 + .../wire-api/test/golden/testObject_Conversation_v5_user_4.json | 1 + .../wire-api/test/golden/testObject_Conversation_v5_user_5.json | 1 + .../test/golden/testObject_ConversationsResponse_1.json | 2 ++ .../test/golden/testObject_ConversationsResponse_v2_1.json | 2 ++ .../test/golden/testObject_ConversationsResponse_v5_1.json | 2 ++ .../test/golden/testObject_CreateGroupConversation_1.json | 1 + .../test/golden/testObject_CreateGroupConversation_2.json | 1 + .../test/golden/testObject_CreateGroupConversation_3.json | 1 + libs/wire-api/test/golden/testObject_Event_user_8.json | 1 + libs/wire-api/test/golden/testObject_Push_1.json | 1 + libs/wire-api/test/golden/testObject_Push_2.json | 1 + 25 files changed, 28 insertions(+) diff --git a/libs/wire-api/test/golden/testObject_ConversationList_20Conversation_v2_user_1.json b/libs/wire-api/test/golden/testObject_ConversationList_20Conversation_v2_user_1.json index 2f211606717..7a24d3aea29 100644 --- a/libs/wire-api/test/golden/testObject_ConversationList_20Conversation_v2_user_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationList_20Conversation_v2_user_1.json @@ -32,6 +32,7 @@ "message_timer": 4760386328981119, "name": "", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_user_1.json b/libs/wire-api/test/golden/testObject_Conversation_user_1.json index e9c08330a13..d2d9c0b0482 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_user_1.json +++ b/libs/wire-api/test/golden/testObject_Conversation_user_1.json @@ -29,6 +29,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_user_2.json b/libs/wire-api/test/golden/testObject_Conversation_user_2.json index bc75e888889..ef06bc1dcea 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_user_2.json +++ b/libs/wire-api/test/golden/testObject_Conversation_user_2.json @@ -60,6 +60,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "proteus", + "pydio_state": "pending", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_user_3.json b/libs/wire-api/test/golden/testObject_Conversation_user_3.json index bdc0413d26a..b122d88f029 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_user_3.json +++ b/libs/wire-api/test/golden/testObject_Conversation_user_3.json @@ -50,6 +50,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_user_4.json b/libs/wire-api/test/golden/testObject_Conversation_user_4.json index 3d6616cf602..fa7496cd603 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_user_4.json +++ b/libs/wire-api/test/golden/testObject_Conversation_user_4.json @@ -48,6 +48,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_user_5.json b/libs/wire-api/test/golden/testObject_Conversation_user_5.json index e9c08330a13..dea90c1aa8c 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_user_5.json +++ b/libs/wire-api/test/golden/testObject_Conversation_user_5.json @@ -29,6 +29,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v2_user_1.json b/libs/wire-api/test/golden/testObject_Conversation_v2_user_1.json index 90e837c0700..8e3eba666a2 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v2_user_1.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v2_user_1.json @@ -30,6 +30,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v2_user_2.json b/libs/wire-api/test/golden/testObject_Conversation_v2_user_2.json index ffc1f3da5cd..7c085c82878 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v2_user_2.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v2_user_2.json @@ -61,6 +61,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "proteus", + "pydio_state": "pending", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v2_user_3.json b/libs/wire-api/test/golden/testObject_Conversation_v2_user_3.json index 7f4502a0adb..405ed728665 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v2_user_3.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v2_user_3.json @@ -51,6 +51,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v2_user_4.json b/libs/wire-api/test/golden/testObject_Conversation_v2_user_4.json index cda477d4510..897727ff2d1 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v2_user_4.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v2_user_4.json @@ -51,6 +51,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v2_user_5.json b/libs/wire-api/test/golden/testObject_Conversation_v2_user_5.json index 90e837c0700..37b0a02a3be 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v2_user_5.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v2_user_5.json @@ -30,6 +30,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v5_user_1.json b/libs/wire-api/test/golden/testObject_Conversation_v5_user_1.json index e9c08330a13..d2d9c0b0482 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v5_user_1.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v5_user_1.json @@ -29,6 +29,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v5_user_2.json b/libs/wire-api/test/golden/testObject_Conversation_v5_user_2.json index bc75e888889..ef06bc1dcea 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v5_user_2.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v5_user_2.json @@ -60,6 +60,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "proteus", + "pydio_state": "pending", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v5_user_3.json b/libs/wire-api/test/golden/testObject_Conversation_v5_user_3.json index bdc0413d26a..b122d88f029 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v5_user_3.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v5_user_3.json @@ -50,6 +50,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v5_user_4.json b/libs/wire-api/test/golden/testObject_Conversation_v5_user_4.json index e7351a003ce..fd2355261ef 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v5_user_4.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v5_user_4.json @@ -50,6 +50,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_Conversation_v5_user_5.json b/libs/wire-api/test/golden/testObject_Conversation_v5_user_5.json index e9c08330a13..dea90c1aa8c 100644 --- a/libs/wire-api/test/golden/testObject_Conversation_v5_user_5.json +++ b/libs/wire-api/test/golden/testObject_Conversation_v5_user_5.json @@ -29,6 +29,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json b/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json index 1156816764e..be35604cf63 100644 --- a/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json @@ -41,6 +41,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" @@ -101,6 +102,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json b/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json index cf0cc2893b9..ad1dc14889e 100644 --- a/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json @@ -42,6 +42,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" @@ -103,6 +104,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_ConversationsResponse_v5_1.json b/libs/wire-api/test/golden/testObject_ConversationsResponse_v5_1.json index 1156816764e..be35604cf63 100644 --- a/libs/wire-api/test/golden/testObject_ConversationsResponse_v5_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationsResponse_v5_1.json @@ -41,6 +41,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" @@ -101,6 +102,7 @@ "message_timer": 1319272593797015, "name": "", "protocol": "mls", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000000000002" diff --git a/libs/wire-api/test/golden/testObject_CreateGroupConversation_1.json b/libs/wire-api/test/golden/testObject_CreateGroupConversation_1.json index 44959d7f605..e54da0683af 100644 --- a/libs/wire-api/test/golden/testObject_CreateGroupConversation_1.json +++ b/libs/wire-api/test/golden/testObject_CreateGroupConversation_1.json @@ -30,6 +30,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_CreateGroupConversation_2.json b/libs/wire-api/test/golden/testObject_CreateGroupConversation_2.json index 433aeb494a7..23588ee9273 100644 --- a/libs/wire-api/test/golden/testObject_CreateGroupConversation_2.json +++ b/libs/wire-api/test/golden/testObject_CreateGroupConversation_2.json @@ -39,6 +39,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_CreateGroupConversation_3.json b/libs/wire-api/test/golden/testObject_CreateGroupConversation_3.json index 45834b8c6eb..b0eb675e08d 100644 --- a/libs/wire-api/test/golden/testObject_CreateGroupConversation_3.json +++ b/libs/wire-api/test/golden/testObject_CreateGroupConversation_3.json @@ -39,6 +39,7 @@ "message_timer": null, "name": " 0", "protocol": "proteus", + "pydio_state": "ready", "qualified_id": { "domain": "golden.example.com", "id": "00000001-0000-0000-0000-000000000000" diff --git a/libs/wire-api/test/golden/testObject_Event_user_8.json b/libs/wire-api/test/golden/testObject_Event_user_8.json index 8906b271471..100469a83cc 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_8.json +++ b/libs/wire-api/test/golden/testObject_Event_user_8.json @@ -57,6 +57,7 @@ "message_timer": 283898987885780, "name": "\u0007\u000e\r", "protocol": "proteus", + "pydio_state": "disabled", "qualified_id": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000100000001" diff --git a/libs/wire-api/test/golden/testObject_Push_1.json b/libs/wire-api/test/golden/testObject_Push_1.json index 9680be52df8..82200ebb915 100644 --- a/libs/wire-api/test/golden/testObject_Push_1.json +++ b/libs/wire-api/test/golden/testObject_Push_1.json @@ -1,4 +1,5 @@ { + "is_pydio_event": false, "native_include_origin": false, "payload": [ {} diff --git a/libs/wire-api/test/golden/testObject_Push_2.json b/libs/wire-api/test/golden/testObject_Push_2.json index cc5e168b15e..b23de286b86 100644 --- a/libs/wire-api/test/golden/testObject_Push_2.json +++ b/libs/wire-api/test/golden/testObject_Push_2.json @@ -4,6 +4,7 @@ "sdf", "wire-client" ], + "is_pydio_event": false, "native_aps": { "badge": true, "loc_args": [