diff --git a/changelog.d/5-internal/event-cleanup b/changelog.d/5-internal/event-cleanup new file mode 100644 index 0000000000..f9f726d043 --- /dev/null +++ b/changelog.d/5-internal/event-cleanup @@ -0,0 +1 @@ +The `Event` record type does not contain a `type` field anymore diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Event.hs b/libs/wire-api-federation/src/Wire/API/Federation/Event.hs deleted file mode 100644 index 2e62292524..0000000000 --- a/libs/wire-api-federation/src/Wire/API/Federation/Event.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StrictData #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 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.Federation.Event - ( AnyEvent (..), - ConversationEvent (..), - - -- * MemberJoin - MemberJoin (..), - SimpleMember (..), - ConversationRole (..), - ) -where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Id -import Data.Qualified (Qualified) -import Data.Time -import Imports -import Test.QuickCheck (Arbitrary (arbitrary)) -import qualified Test.QuickCheck as QC -import Wire.API.Util.Aeson (CustomEncoded (CustomEncoded)) - -data AnyEvent - = EventMemberJoin (ConversationEvent MemberJoin) - deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded AnyEvent) - --- | Similar to 'Wire.API.Event.ConversationEvent', but all IDs are qualified to allow --- this representation to be sent across backends. --- --- Also, instead of having a sum type in 'eventData', it allows specifying which type --- of event it is, e.g. @ConversationEvent MemberJoin@. --- To represent possiblity of multiple different event types, use a sum type around it. -data ConversationEvent a = ConversationEvent - { eventConversation :: Qualified ConvId, - eventFrom :: Qualified UserId, - eventTime :: UTCTime, - eventData :: a - } - deriving stock (Eq, Show, Generic, Foldable, Functor, Traversable) - deriving (ToJSON, FromJSON) via (CustomEncoded (ConversationEvent a)) - -newtype MemberJoin = MemberJoin - { smUsers :: [SimpleMember] - } - deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded MemberJoin) - -data SimpleMember = SimpleMember - { smId :: Qualified UserId, - smConversationRole :: ConversationRole - } - deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded SimpleMember) - -data ConversationRole - = ConversationRoleAdmin - | ConversationRoleMember - deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded ConversationRole) - --- Arbitrary - -instance Arbitrary AnyEvent where - arbitrary = - QC.oneof - [ EventMemberJoin <$> arbitrary - ] - -instance Arbitrary a => Arbitrary (ConversationEvent a) where - arbitrary = ConversationEvent <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary MemberJoin where - arbitrary = MemberJoin <$> arbitrary - -instance Arbitrary SimpleMember where - arbitrary = SimpleMember <$> arbitrary <*> arbitrary - -instance Arbitrary ConversationRole where - arbitrary = QC.elements [ConversationRoleAdmin, ConversationRoleMember] diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 0c2cc1db7f..20d673c962 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -28,7 +28,6 @@ library Wire.API.Federation.Domain Wire.API.Federation.Endpoint Wire.API.Federation.Error - Wire.API.Federation.Event other-modules: Paths_wire_api_federation hs-source-dirs: diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index cb8b5890cd..c89fb2db27 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -55,24 +55,24 @@ conversationActionToEvent :: ConversationAction -> Event conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers role) = - Event MemberJoin qcnv quid now $ + Event qcnv quid now $ EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers)) conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removedMembers) = - Event MemberLeave qcnv quid now $ + Event qcnv quid now $ EdMembersLeave (QualifiedUserIdList (toList removedMembers)) conversationActionToEvent now quid qcnv (ConversationActionRename rename) = - Event ConvRename qcnv quid now (EdConvRename rename) + Event qcnv quid now (EdConvRename rename) conversationActionToEvent now quid qcnv (ConversationActionMessageTimerUpdate update) = - Event ConvMessageTimerUpdate qcnv quid now (EdConvMessageTimerUpdate update) + Event qcnv quid now (EdConvMessageTimerUpdate update) conversationActionToEvent now quid qcnv (ConversationActionReceiptModeUpdate update) = - Event ConvReceiptModeUpdate qcnv quid now (EdConvReceiptModeUpdate update) + Event qcnv quid now (EdConvReceiptModeUpdate update) conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate target (OtherMemberUpdate role)) = let update = MemberUpdateData target Nothing Nothing Nothing Nothing Nothing Nothing role - in Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) + in Event qcnv quid now (EdMemberUpdate update) conversationActionToEvent now quid qcnv (ConversationActionAccessUpdate update) = - Event ConvAccessUpdate qcnv quid now (EdConvAccessUpdate update) + Event qcnv quid now (EdConvAccessUpdate update) conversationActionToEvent now quid qcnv ConversationActionDelete = - Event ConvDelete qcnv quid now EdConvDelete + Event qcnv quid now EdConvDelete conversationActionTag :: Qualified UserId -> ConversationAction -> Action conversationActionTag _ (ConversationActionAddMembers _ _) = AddConversationMember diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 66a1b7e946..b39ea7ed9d 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -21,6 +21,7 @@ module Wire.API.Event.Conversation ( -- * Event Event (..), + evtType, EventType (..), EventData (..), AddCodeResult (..), @@ -107,14 +108,16 @@ import Wire.API.User (QualifiedUserIdList (..)) -- Event data Event = Event - { evtType :: EventType, - evtConv :: Qualified ConvId, + { evtConv :: Qualified ConvId, evtFrom :: Qualified UserId, evtTime :: UTCTime, evtData :: EventData } deriving stock (Eq, Show, Generic) +evtType :: Event -> EventType +evtType = eventDataType . evtData + modelEvent :: Doc.Model modelEvent = Doc.defineModel "Event" $ do Doc.description "Event data" @@ -146,7 +149,7 @@ modelEvent = Doc.defineModel "Event" $ do instance Arbitrary Event where arbitrary = do typ <- arbitrary - Event typ + Event <$> arbitrary <*> arbitrary <*> (milli <$> arbitrary) @@ -302,6 +305,22 @@ genEventData = \case OtrMessageAdd -> EdOtrMessage <$> arbitrary ConvDelete -> pure EdConvDelete +eventDataType :: EventData -> EventType +eventDataType (EdMembersJoin _) = MemberJoin +eventDataType (EdMembersLeave _) = MemberLeave +eventDataType (EdMemberUpdate _) = MemberStateUpdate +eventDataType (EdConvRename _) = ConvRename +eventDataType (EdConvAccessUpdate _) = ConvAccessUpdate +eventDataType (EdConvMessageTimerUpdate _) = ConvMessageTimerUpdate +eventDataType (EdConvCodeUpdate _) = ConvCodeUpdate +eventDataType EdConvCodeDelete = ConvCodeDelete +eventDataType (EdConnect _) = ConvConnect +eventDataType (EdConversation _) = ConvCreate +eventDataType (EdConvReceiptModeUpdate _) = ConvReceiptModeUpdate +eventDataType (EdTyping _) = Typing +eventDataType (EdOtrMessage _) = OtrMessageAdd +eventDataType EdConvDelete = ConvDelete + -------------------------------------------------------------------------------- -- Event data helpers @@ -547,7 +566,7 @@ eventObjectSchema = <*> evtFrom .= field "qualified_from" schema <*> (toUTCTimeMillis . evtTime) .= field "time" (fromUTCTimeMillis <$> schema) where - mk (ty, d) cid uid tm = Event ty cid uid tm d + mk (_, d) cid uid tm = Event cid uid tm d instance ToJSONObject Event where toJSONObject = diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index e18cde53a0..94c692703c 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -62,15 +62,17 @@ import Wire.API.Team.Permission (Permissions) -- Event data Event = Event - { _eventType :: EventType, - _eventTeam :: TeamId, + { _eventTeam :: TeamId, _eventTime :: UTCTime, - _eventData :: Maybe EventData + _eventData :: EventData } deriving stock (Eq, Show, Generic) -newEvent :: EventType -> TeamId -> UTCTime -> Event -newEvent typ tid tme = Event typ tid tme Nothing +eventType :: Event -> EventType +eventType = eventDataType . _eventData + +newEvent :: TeamId -> UTCTime -> EventData -> Event +newEvent = Event modelEvent :: Doc.Model modelEvent = Doc.defineModel "TeamEvent" $ do @@ -123,7 +125,7 @@ instance ToJSON Event where instance ToJSONObject Event where toJSONObject e = KeyMap.fromList - [ "type" .= _eventType e, + [ "type" .= eventType e, "team" .= _eventTeam e, "time" .= _eventTime e, "data" .= _eventData e @@ -133,7 +135,7 @@ instance FromJSON Event where parseJSON = withObject "event" $ \o -> do ty <- o .: "type" dt <- o .:? "data" - Event ty + Event <$> o .: "team" <*> o .: "time" <*> parseEventData ty dt @@ -141,7 +143,7 @@ instance FromJSON Event where instance Arbitrary Event where arbitrary = do typ <- arbitrary - Event typ + Event <$> arbitrary <*> arbitrary <*> genEventData typ @@ -200,6 +202,7 @@ instance FromJSON EventType where data EventData = EdTeamCreate Team + | EdTeamDelete | EdTeamUpdate TeamUpdateData | EdMemberJoin UserId | EdMemberLeave UserId @@ -210,6 +213,7 @@ data EventData instance ToJSON EventData where toJSON (EdTeamCreate tem) = toJSON tem + toJSON EdTeamDelete = Null toJSON (EdMemberJoin usr) = object ["user" .= usr] toJSON (EdMemberUpdate usr mPerm) = object $ @@ -221,43 +225,53 @@ instance ToJSON EventData where toJSON (EdConvDelete cnv) = object ["conv" .= cnv] toJSON (EdTeamUpdate upd) = toJSON upd -parseEventData :: EventType -> Maybe Value -> Parser (Maybe EventData) +eventDataType :: EventData -> EventType +eventDataType (EdTeamCreate _) = TeamCreate +eventDataType EdTeamDelete = TeamDelete +eventDataType (EdTeamUpdate _) = TeamUpdate +eventDataType (EdMemberJoin _) = MemberJoin +eventDataType (EdMemberLeave _) = MemberLeave +eventDataType (EdMemberUpdate _ _) = MemberUpdate +eventDataType (EdConvCreate _) = ConvCreate +eventDataType (EdConvDelete _) = ConvDelete + +parseEventData :: EventType -> Maybe Value -> Parser (EventData) parseEventData MemberJoin Nothing = fail "missing event data for type 'team.member-join'" parseEventData MemberJoin (Just j) = do - let f o = Just . EdMemberJoin <$> o .: "user" + let f o = EdMemberJoin <$> o .: "user" withObject "member join data" f j parseEventData MemberUpdate Nothing = fail "missing event data for type 'team.member-update" parseEventData MemberUpdate (Just j) = do - let f o = Just <$> (EdMemberUpdate <$> o .: "user" <*> o .:? "permissions") + let f o = EdMemberUpdate <$> o .: "user" <*> o .:? "permissions" withObject "member update data" f j parseEventData MemberLeave Nothing = fail "missing event data for type 'team.member-leave'" parseEventData MemberLeave (Just j) = do - let f o = Just . EdMemberLeave <$> o .: "user" + let f o = EdMemberLeave <$> o .: "user" withObject "member leave data" f j parseEventData ConvCreate Nothing = fail "missing event data for type 'team.conversation-create" parseEventData ConvCreate (Just j) = do - let f o = Just . EdConvCreate <$> o .: "conv" + let f o = EdConvCreate <$> o .: "conv" withObject "conversation create data" f j parseEventData ConvDelete Nothing = fail "missing event data for type 'team.conversation-delete" parseEventData ConvDelete (Just j) = do - let f o = Just . EdConvDelete <$> o .: "conv" + let f o = EdConvDelete <$> o .: "conv" withObject "conversation delete data" f j parseEventData TeamCreate Nothing = fail "missing event data for type 'team.create'" -parseEventData TeamCreate (Just j) = Just . EdTeamCreate <$> parseJSON j +parseEventData TeamCreate (Just j) = EdTeamCreate <$> parseJSON j parseEventData TeamUpdate Nothing = fail "missing event data for type 'team.update'" -parseEventData TeamUpdate (Just j) = Just . EdTeamUpdate <$> parseJSON j -parseEventData _ Nothing = pure Nothing +parseEventData TeamUpdate (Just j) = EdTeamUpdate <$> parseJSON j +parseEventData _ Nothing = pure EdTeamDelete parseEventData t (Just _) = fail $ "unexpected event data for type " <> show t -genEventData :: EventType -> QC.Gen (Maybe EventData) +genEventData :: EventType -> QC.Gen (EventData) genEventData = \case - TeamCreate -> Just . EdTeamCreate <$> arbitrary - TeamDelete -> pure Nothing - TeamUpdate -> Just . EdTeamUpdate <$> arbitrary - MemberJoin -> Just . EdMemberJoin <$> arbitrary - MemberLeave -> Just . EdMemberLeave <$> arbitrary - MemberUpdate -> Just <$> (EdMemberUpdate <$> arbitrary <*> arbitrary) - ConvCreate -> Just . EdConvCreate <$> arbitrary - ConvDelete -> Just . EdConvDelete <$> arbitrary + TeamCreate -> EdTeamCreate <$> arbitrary + TeamDelete -> pure EdTeamDelete + TeamUpdate -> EdTeamUpdate <$> arbitrary + MemberJoin -> EdMemberJoin <$> arbitrary + MemberLeave -> EdMemberLeave <$> arbitrary + MemberUpdate -> EdMemberUpdate <$> arbitrary <*> arbitrary + ConvCreate -> EdConvCreate <$> arbitrary + ConvDelete -> EdConvDelete <$> arbitrary makeLenses ''Event diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs index 380efedc0b..93f6f0ade0 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs @@ -25,24 +25,10 @@ import Data.Qualified import qualified Data.UUID as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust, read, (.)) import Wire.API.Conversation - ( ConversationRename (ConversationRename, cupName), - ) -import Wire.API.Conversation.Bot (AddBotResponse (..)) -import Wire.API.Conversation.Typing (TypingData (TypingData, tdStatus), TypingStatus (StartedTyping)) +import Wire.API.Conversation.Bot +import Wire.API.Conversation.Typing import Wire.API.Event.Conversation - ( Event (Event), - EventData (..), - EventType - ( ConvRename, - Typing - ), - ) import Wire.API.User - ( Asset (ImageAsset), - AssetSize (AssetPreview), - ColourId (ColourId, fromColourId), - Name (Name, fromName), - ) testObject_AddBotResponse_user_1 :: AddBotResponse testObject_AddBotResponse_user_1 = @@ -58,7 +44,6 @@ testObject_AddBotResponse_user_1 = rsAddBotAssets = [ImageAsset "7" Nothing, ImageAsset "" (Just AssetPreview)], rsAddBotEvent = Event - ConvRename (Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000003"))) (Domain "faraway.example.com")) (Qualified (Id (fromJust (UUID.fromString "00000004-0000-0004-0000-000400000004"))) (Domain "faraway.example.com")) (read "1864-05-12 19:20:22.286 UTC") @@ -79,7 +64,6 @@ testObject_AddBotResponse_user_2 = rsAddBotAssets = [], rsAddBotEvent = Event - Typing (Qualified (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000300000001"))) (Domain "faraway.example.com")) (Qualified (Id (fromJust (UUID.fromString "00000004-0000-0000-0000-000300000001"))) (Domain "faraway.example.com")) (read "1864-05-08 19:02:58.6 UTC") diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_team.hs index e9a1ca0ec3..bf4a0e92ac 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_team.hs @@ -27,376 +27,285 @@ import qualified Data.UUID as UUID (fromString) import GHC.Exts (IsList (fromList)) import Imports (Maybe (Just, Nothing), fromJust, read, (&)) import Wire.API.Event.Team - ( Event, - EventData - ( EdConvCreate, - EdConvDelete, - EdMemberJoin, - EdMemberLeave, - EdMemberUpdate, - EdTeamCreate, - EdTeamUpdate - ), - EventType - ( ConvCreate, - ConvDelete, - MemberJoin, - MemberLeave, - MemberUpdate, - TeamCreate, - TeamDelete, - TeamUpdate - ), - eventData, - newEvent, - ) import Wire.API.Team - ( TeamBinding (Binding, NonBinding), - TeamUpdateData - ( TeamUpdateData, - _iconKeyUpdate, - _iconUpdate, - _nameUpdate - ), - newTeam, - teamIconKey, - ) import Wire.API.Team.Permission - ( Perm - ( AddTeamMember, - CreateConversation, - DeleteTeam, - DoNotUseDeprecatedAddRemoveConvMember, - DoNotUseDeprecatedDeleteConversation, - DoNotUseDeprecatedModifyConvName, - GetBilling, - GetMemberPermissions, - GetTeamConversations, - RemoveTeamMember, - SetBilling, - SetMemberPermissions, - SetTeamData - ), - Permissions (Permissions, _copy, _self), - ) testObject_Event_team_1 :: Event testObject_Event_team_1 = ( newEvent - (TeamCreate) ((Id (fromJust (UUID.fromString "0000103e-0000-62d6-0000-7840000079b9")))) (read ("1864-05-15 23:16:24.423381912958 UTC")) - & eventData - .~ ( Just - ( EdTeamCreate - ( newTeam - ((Id (fromJust (UUID.fromString "00000003-0000-0004-0000-000000000001")))) - ((Id (fromJust (UUID.fromString "00000003-0000-0001-0000-000300000002")))) - ("\EOTX\996492h") - ("#\93847\21278(\997485") - (Binding) - & teamIconKey .~ (Nothing) - ) - ) - ) + ( EdTeamCreate + ( newTeam + ((Id (fromJust (UUID.fromString "00000003-0000-0004-0000-000000000001")))) + ((Id (fromJust (UUID.fromString "00000003-0000-0001-0000-000300000002")))) + ("\EOTX\996492h") + ("#\93847\21278(\997485") + (Binding) + & teamIconKey .~ (Nothing) + ) + ) ) testObject_Event_team_2 :: Event testObject_Event_team_2 = ( newEvent - (TeamUpdate) ((Id (fromJust (UUID.fromString "000019fb-0000-03a5-0000-009c00006067")))) (read ("1864-05-06 06:03:20.68447167825 UTC")) - & eventData - .~ ( Just - ( EdTeamUpdate - ( TeamUpdateData - { _nameUpdate = - Just - ( unsafeRange - ("i5\EOT\1002575\1097973\1066101\&1u\1105430\&1\41840U*/*\999102\1001662\DC3\994167d\1096830\&4uG\173887\fUh09\\\1028574\vPy\t\171003\SI\GS0bV\CAN]\17049\96404\15202\RS\SYNX\ESC3[\CANf\NAK") - ), - _iconUpdate = fromByteString' "3-1-f595b8ed-6dcf-41f2-8a2f-f662a9c0fce4", - _iconKeyUpdate = - Just (unsafeRange ("\131355Pp\1067299\987603\ENQS\22773S\ACK\NAKmM\19084\&0\19257\31361$rL,XvJ")) - } - ) - ) - ) + ( EdTeamUpdate + ( TeamUpdateData + { _nameUpdate = + Just + ( unsafeRange + ("i5\EOT\1002575\1097973\1066101\&1u\1105430\&1\41840U*/*\999102\1001662\DC3\994167d\1096830\&4uG\173887\fUh09\\\1028574\vPy\t\171003\SI\GS0bV\CAN]\17049\96404\15202\RS\SYNX\ESC3[\CANf\NAK") + ), + _iconUpdate = fromByteString' "3-1-f595b8ed-6dcf-41f2-8a2f-f662a9c0fce4", + _iconKeyUpdate = + Just (unsafeRange ("\131355Pp\1067299\987603\ENQS\22773S\ACK\NAKmM\19084\&0\19257\31361$rL,XvJ")) + } + ) + ) ) testObject_Event_team_3 :: Event testObject_Event_team_3 = ( newEvent - (MemberJoin) ((Id (fromJust (UUID.fromString "00000bfa-0000-53cd-0000-2f8e00004e38")))) (read ("1864-04-20 19:30:43.065358805164 UTC")) - & eventData .~ (Just (EdMemberJoin (Id (fromJust (UUID.fromString "000030c1-0000-1c28-0000-71af000036f3"))))) + (EdMemberJoin (Id (fromJust (UUID.fromString "000030c1-0000-1c28-0000-71af000036f3")))) ) testObject_Event_team_4 :: Event testObject_Event_team_4 = ( newEvent - (TeamUpdate) ((Id (fromJust (UUID.fromString "000060cd-0000-2fae-0000-3620000011d4")))) (read ("1864-06-07 17:44:20.841616476784 UTC")) - & eventData - .~ ( Just - ( EdTeamUpdate - ( TeamUpdateData - { _nameUpdate = - Just - ( unsafeRange - ("d\SI\172132@o\988798s&na\136232\1090952\149487|\83503\1016948/\989099v\NAKu\DC2f\1093640\1011936KC\47338\1066997\1059386\&9_\v_^\1045398K\155463\SO Y*T\CAN\1086598<\1056774>\171907\4929\rt\1038163\1072126w2E\127366hS>\ACK_PQN,Vk\SYN\1083970=90\EM2e\984550\USVA!\EM\FS\EOTe;\189780\&1\171907\4929\rt\1038163\1072126w2E\127366hS>\ACK_PQN,Vk\SYN\1083970=90\EM2e\984550\USVA!\EM\FS\EOTe;\189780\&1 Config -> Manager -> DB.ClientState -> Brig -> Cannon -> Galley -> IO TestTree tests dom conf p db b c g = do diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 68562d43fe..75a2c5f2a7 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -377,7 +377,7 @@ createConnectConversation lusr conn j = do c <- E.createConnectConversation x y n now <- input let lcid = qualifyAs lusr (Data.convId c) - e = Event ConvConnect (qUntagged lcid) (qUntagged lusr) now (EdConnect j) + e = Event (qUntagged lcid) (qUntagged lusr) now (EdConnect j) notifyCreatedConversation Nothing lusr conn c for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> Data.convLocalMembers c)) $ \p -> E.push1 $ @@ -418,7 +418,7 @@ createConnectConversation lusr conn j = do return . Just $ fromRange x Nothing -> return $ Data.convName conv t <- input - let e = Event ConvConnect (qUntagged lcnv) (qUntagged lusr) t (EdConnect j) + let e = Event (qUntagged lcnv) (qUntagged lusr) t (EdConnect j) for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> Data.convLocalMembers conv)) $ \p -> E.push1 $ p @@ -468,7 +468,7 @@ notifyCreatedConversation dtime lusr conn c = do toPush t m = do let lconv = qualifyAs lusr (Data.convId c) c' <- conversationView (qualifyAs lusr (lmId m)) c - let e = Event ConvCreate (qUntagged lconv) (qUntagged lusr) t (EdConversation c') + let e = Event (qUntagged lconv) (qUntagged lusr) t (EdConversation c') return $ newPushLocal1 ListComplete (tUnqualified lusr) (ConvEvent e) (list1 (recipient m) []) & pushConn .~ conn diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 2c86e342fe..66dcc5f776 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -111,7 +111,6 @@ onConversationCreated domain rc = do forM_ (fromNewRemoteConversation loc qrcConnected) $ \(mem, c) -> do let event = Event - ConvCreate (qUntagged (F.rcCnvId qrcConnected)) (qUntagged (F.rcRemoteOrigUserId qrcConnected)) (F.rcTime qrcConnected) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 16909bcc4b..a40c161c43 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -528,7 +528,6 @@ rmUser lusr conn = do deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) let e = Event - MemberLeave (qUntagged (qualifyAs lusr (Data.convId c))) (qUntagged lusr) now diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index f8fb535398..9d99a37a73 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -639,7 +639,7 @@ newMessageEvent :: Event newMessageEvent mconvId sender senderClient dat time (receiver, receiverClient) cipherText = let convId = fromMaybe (qUntagged (fmap selfConv receiver)) mconvId - in Event OtrMessageAdd convId sender time . EdOtrMessage $ + in Event convId sender time . EdOtrMessage $ OtrMessage { otrSender = senderClient, otrRecipient = receiverClient, diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index bac8563893..fb50dca8ac 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -356,7 +356,7 @@ updateTeamH zusr zcon tid updateData = do E.setTeamData tid updateData now <- input memList <- getTeamMembersForFanout tid - let e = newEvent TeamUpdate tid now & eventData .~ Just (EdTeamUpdate updateData) + let e = newEvent tid now (EdTeamUpdate updateData) let r = list1 (userRecipient zusr) (membersToRecipients (Just zusr) (memList ^. teamMembers)) E.push1 $ newPushLocal1 (memList ^. teamMemberListType) zusr (TeamEvent e) r & pushConn .~ Just zcon @@ -444,7 +444,7 @@ uncheckedDeleteTeam lusr zcon tid = do -- done asynchronously membs <- E.getTeamMembers tid (ue, be) <- foldrM (createConvDeleteEvents now membs) ([], []) convs - let e = newEvent TeamDelete tid now + let e = newEvent tid now EdTeamDelete pushDeleteEvents membs e ue E.deliverAsync be -- TODO: we don't delete bots here, but we should do that, since @@ -483,7 +483,7 @@ uncheckedDeleteTeam lusr zcon tid = do -- all team users are deleted immediately after these events are sent -- and will thus never be able to see these events in practice. let mm = nonTeamMembers convMembs teamMembs - let e = Conv.Event Conv.ConvDelete qconvId (qUntagged lusr) now Conv.EdConvDelete + let e = Conv.Event qconvId (qUntagged lusr) now Conv.EdConvDelete -- This event always contains all the required recipients let p = newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (map recipient mm) let ee' = bots `zip` repeat e @@ -948,7 +948,7 @@ updateTeamMember zusr zcon tid targetMember = do privilegedUpdate = mkUpdate $ Just targetPermissions privilegedRecipients = membersToRecipients Nothing privileged now <- input - let ePriv = newEvent MemberUpdate tid now & eventData ?~ privilegedUpdate + let ePriv = newEvent tid now privilegedUpdate -- push to all members (user is privileged) let pushPriv = newPushLocal (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients for_ pushPriv $ \p -> E.push1 $ p & pushConn .~ Just zcon @@ -1071,7 +1071,7 @@ uncheckedDeleteTeamMember lusr zcon tid remove mems = do -- notify all team members. pushMemberLeaveEvent :: UTCTime -> Sem r () pushMemberLeaveEvent now = do - let e = newEvent MemberLeave tid now & eventData ?~ EdMemberLeave remove + let e = newEvent tid now (EdMemberLeave remove) let r = list1 (userRecipient (tUnqualified lusr)) @@ -1099,7 +1099,7 @@ uncheckedDeleteTeamMember lusr zcon tid remove mems = do let qconvId = qUntagged $ qualifyAs lusr (Data.convId dc) let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc) let x = filter (\m -> not (Conv.lmId m `Set.member` exceptTo)) users - let y = Conv.Event Conv.MemberLeave qconvId (qUntagged lusr) now edata + let y = Conv.Event qconvId (qUntagged lusr) now edata for_ (newPushLocal (mems ^. teamMemberListType) (tUnqualified lusr) (ConvEvent y) (recipient <$> x)) $ \p -> E.push1 $ p & pushConn .~ zcon E.deliverAsync (bots `zip` repeat y) @@ -1339,7 +1339,7 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) memList = sizeBeforeAdd <- ensureNotTooLarge tid E.createTeamMember tid new now <- input - let e = newEvent MemberJoin tid now & eventData ?~ EdMemberJoin (new ^. userId) + let e = newEvent tid now (EdMemberJoin (new ^. userId)) E.push1 $ newPushLocal1 (memList ^. teamMemberListType) (new ^. userId) (TeamEvent e) (recipients origin new) & pushConn .~ originConn APITeamQueue.pushTeamEvent tid e @@ -1400,7 +1400,7 @@ finishCreateTeam team owner others zcon = do for_ (owner : others) $ E.createTeamMember (team ^. teamId) now <- input - let e = newEvent TeamCreate (team ^. teamId) now & eventData ?~ EdTeamCreate team + let e = newEvent (team ^. teamId) now (EdTeamCreate team) let r = membersToRecipients Nothing others E.push1 $ newPushLocal1 ListComplete zusr (TeamEvent e) (list1 (userRecipient zusr) r) & pushConn .~ zcon diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 54b6f91063..555cddb127 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -565,7 +565,7 @@ addCode lusr zcon lcnv = do E.createCode code now <- input conversationCode <- createCode code - let event = Event ConvCodeUpdate (qUntagged lcnv) (qUntagged lusr) now (EdConvCodeUpdate conversationCode) + let event = Event (qUntagged lcnv) (qUntagged lusr) now (EdConvCodeUpdate conversationCode) pushConversationEvent (Just zcon) event (qualifyAs lusr (map lmId users)) bots pure $ CodeAdded event Just code -> do @@ -621,7 +621,7 @@ rmCode lusr zcon lcnv = do key <- E.makeKey (tUnqualified lcnv) E.deleteCode key ReusableCode now <- input - let event = Event ConvCodeDelete (qUntagged lcnv) (qUntagged lusr) now EdConvCodeDelete + let event = Event (qUntagged lcnv) (qUntagged lusr) now EdConvCodeDelete pushConversationEvent (Just zcon) event (qualifyAs lusr (map lmId users)) bots pure event @@ -844,7 +844,7 @@ updateSelfMember lusr zcon qcnv update = do unless exists . throw $ ConvNotFound E.setSelfMember qcnv lusr update now <- input - let e = Event MemberStateUpdate qcnv (qUntagged lusr) now (EdMemberUpdate (updateData lusr)) + let e = Event qcnv (qUntagged lusr) now (EdMemberUpdate (updateData lusr)) pushConversationEvent (Just zcon) e (fmap pure lusr) [] where checkLocalMembership :: @@ -1055,7 +1055,7 @@ removeMemberFromRemoteConv cnv lusr victim handleSuccess _ = do t <- input pure . Just $ - Event MemberLeave (qUntagged cnv) (qUntagged lusr) t $ + Event (qUntagged cnv) (qUntagged lusr) t $ EdMembersLeave (QualifiedUserIdList [victim]) -- | Remove a member from a local conversation. @@ -1351,7 +1351,7 @@ isTyping lusr zcon lcnv typingData = do mm <- E.getLocalMembers (tUnqualified lcnv) unless (tUnqualified lusr `isMember` mm) . throw $ ConvNotFound now <- input - let e = Event Typing (qUntagged lcnv) (qUntagged lusr) now (EdTyping typingData) + let e = Event (qUntagged lcnv) (qUntagged lusr) now (EdTyping typingData) for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> mm)) $ \p -> E.push1 $ p @@ -1433,7 +1433,6 @@ addBot lusr zcon b = do bm <- E.createBotMember (b ^. addBotService) (b ^. addBotId) (b ^. addBotConv) let e = Event - MemberJoin (qUntagged (qualifyAs lusr (b ^. addBotConv))) (qUntagged lusr) t @@ -1509,7 +1508,7 @@ rmBot lusr zcon b = do t <- input do let evd = EdMembersLeave (QualifiedUserIdList [qUntagged (qualifyAs lusr (botUserId (b ^. rmBotId)))]) - let e = Event MemberLeave (qUntagged lcnv) (qUntagged lusr) t evd + let e = Event (qUntagged lcnv) (qUntagged lusr) t evd for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> users)) $ \p -> E.push1 $ p & pushConn .~ zcon E.deleteMembers (Data.convId c) (UserList [botUserId (b ^. rmBotId)] []) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index b3e35326c5..e2871d3be7 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -302,7 +302,7 @@ memberJoinEvent :: [RemoteMember] -> Event memberJoinEvent lorig qconv t lmems rmems = - Event MemberJoin qconv (qUntagged lorig) t $ + Event qconv (qUntagged lorig) t $ EdMembersJoin (SimpleMembers (map localToSimple lmems <> map remoteToSimple rmems)) where localToSimple u = SimpleMember (qUntagged (qualifyAs lorig (lmId u))) (lmConvRoleName u) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index a6405832a3..6074a97361 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -86,6 +86,7 @@ import TestSetup import Util.Options (Endpoint (Endpoint)) import Wire.API.Conversation import Wire.API.Conversation.Action +import Wire.API.Event.Conversation import Wire.API.Federation.API import qualified Wire.API.Federation.API.Brig as F import Wire.API.Federation.API.Galley diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 21086153d5..3c1623ece2 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -72,6 +72,7 @@ import TestSetup import Wire.API.Conversation.Action (ConversationAction (..)) import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role +import Wire.API.Event.Conversation import Wire.API.Federation.API.Common import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..)) import qualified Wire.API.Federation.API.Galley as FedGalley diff --git a/services/galley/test/integration/API/MessageTimer.hs b/services/galley/test/integration/API/MessageTimer.hs index 2339a993ab..f40e23dd53 100644 --- a/services/galley/test/integration/API/MessageTimer.hs +++ b/services/galley/test/integration/API/MessageTimer.hs @@ -46,6 +46,7 @@ import Test.Tasty.HUnit import TestHelpers import TestSetup import Wire.API.Conversation.Action +import Wire.API.Event.Conversation import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Component import qualified Wire.API.Team.Member as Member diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 9da167a2c0..fda229a8e2 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -42,6 +42,7 @@ import Test.Tasty.HUnit import TestHelpers import TestSetup import Wire.API.Conversation.Action +import Wire.API.Event.Conversation import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Component diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 0cd2a8d929..de2e59bd46 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -160,9 +160,8 @@ testCreateTeam = do eventChecks <- WS.awaitMatch timeout wsOwner $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamCreate e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdTeamCreate team) + e ^. eventData @?= EdTeamCreate team void $ WS.assertSuccess eventChecks testGetTeams :: TestM () @@ -237,9 +236,8 @@ testCreateTeamWithMembers = do checkCreateEvent team w = WS.assertMatch_ timeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamCreate e ^. eventTeam @?= (team ^. teamId) - e ^. eventData @?= Just (EdTeamCreate team) + e ^. eventData @?= EdTeamCreate team testListTeamMembersDefaultLimit :: TestM () testListTeamMembersDefaultLimit = do @@ -1584,9 +1582,8 @@ testUpdateTeamMember = do checkTeamMemberUpdateEvent tid uid w mPerm = WS.assertMatch_ timeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberUpdate e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdMemberUpdate uid mPerm) + e ^. eventData @?= EdMemberUpdate uid mPerm testUpdateTeamStatus :: TestM () testUpdateTeamStatus = do @@ -1925,6 +1922,5 @@ checkJoinEvent :: (MonadIO m, MonadCatch m) => TeamId -> UserId -> WS.WebSocket checkJoinEvent tid usr w = WS.assertMatch_ timeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberJoin e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdMemberJoin usr) + e ^. eventData @?= EdMemberJoin usr diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 536bc3bea6..722a045d64 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -109,7 +109,7 @@ import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Action -import Wire.API.Event.Conversation (_EdConversation, _EdMembersJoin, _EdMembersLeave) +import Wire.API.Event.Conversation import qualified Wire.API.Event.Team as TE import Wire.API.Federation.API import Wire.API.Federation.API.Galley @@ -1219,8 +1219,8 @@ getTeamQueue zusr msince msize onlyLast = (Error msg) -> error msg (Success (e :: TE.Event)) -> case e ^. TE.eventData of - Just (EdMemberJoin uid) -> uid - _ -> error ("bad even type: " <> show (e ^. TE.eventType)) + EdMemberJoin uid -> uid + _ -> error ("bad event type: " <> show (TE.eventType e)) getTeamQueue' :: HasCallStack => UserId -> Maybe NotificationId -> Maybe Int -> Bool -> TestM ResponseLBS getTeamQueue' zusr msince msize onlyLast = do @@ -1545,7 +1545,7 @@ decodeConvCode = responseJsonUnsafe decodeConvCodeEvent :: Response (Maybe Lazy.ByteString) -> ConversationCode decodeConvCodeEvent r = case responseJsonUnsafe r of - (Event ConvCodeUpdate _ _ _ (EdConvCodeUpdate c)) -> c + (Event _ _ _ (EdConvCodeUpdate c)) -> c _ -> error "Failed to parse ConversationCode from Event" decodeConvId :: HasCallStack => Response (Maybe Lazy.ByteString) -> ConvId @@ -2359,25 +2359,22 @@ checkTeamMemberJoin :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM checkTeamMemberJoin tid uid w = WS.awaitMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TE.MemberJoin e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdMemberJoin uid) + e ^. eventData @?= EdMemberJoin uid checkTeamMemberLeave :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM () checkTeamMemberLeave tid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TE.MemberLeave e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdMemberLeave usr) + e ^. eventData @?= EdMemberLeave usr checkTeamUpdateEvent :: (HasCallStack, MonadIO m, MonadCatch m) => TeamId -> TeamUpdateData -> WS.WebSocket -> m () checkTeamUpdateEvent tid upd w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TE.TeamUpdate e ^. eventTeam @?= tid - e ^. eventData @?= Just (EdTeamUpdate upd) + e ^. eventData @?= EdTeamUpdate upd checkConvCreateEvent :: HasCallStack => ConvId -> WS.WebSocket -> TestM () checkConvCreateEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do @@ -2411,9 +2408,8 @@ checkTeamDeleteEvent :: HasCallStack => TeamId -> WS.WebSocket -> TestM () checkTeamDeleteEvent tid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TE.TeamDelete e ^. eventTeam @?= tid - e ^. eventData @?= Nothing + e ^. eventData @?= EdTeamDelete checkConvDeleteEvent :: HasCallStack => Qualified ConvId -> WS.WebSocket -> TestM () checkConvDeleteEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do