Cleanup of event record types

changelog.d/5-internal/event-cleanup

@@ -0,0 +1 @@
+The `Event` record type does not contain a `type` field anymore

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:

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

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 =

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,15 +135,15 @@ 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
 
 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

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")