Fix user event serialisation golden tests

wireapp · Mar 5, 2024 · 2c4e3c5 · 2c4e3c5
1 parent a86fd5f
commit 2c4e3c5
Show file tree

Hide file tree

Showing 8 changed files with 94 additions and 106 deletions.
diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs
@@ -38,6 +38,7 @@ module Data.Id
     ScimTokenId,
     parseIdFromText,
     idToText,
+    idObjectSchema,
     IdObject (..),
 
     -- * Client IDs
@@ -444,7 +445,7 @@ newtype IdObject a = IdObject {fromIdObject :: a}
   deriving (ToJSON, FromJSON, S.ToSchema) via Schema (IdObject a)
 
 instance ToSchema a => ToSchema (IdObject a) where
-  schema =
-    object "Id" $
-      IdObject
-        <$> fromIdObject .= field "id" schema
+  schema = idObjectSchema (IdObject <$> fromIdObject .= schema)
+
+idObjectSchema :: ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b
+idObjectSchema sch = object "Id" (field "id" sch)
diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs
@@ -59,11 +59,11 @@ eventType (UserEvent (UserLegalHoldDisabled _)) = EventTypeUserLegalholdDisabled
 eventType (UserEvent (UserLegalHoldEnabled _)) = EventTypeUserLegalholdEnabled
 eventType (UserEvent (LegalHoldClientRequested _)) = EventTypeUserLegalholdRequested
 eventType (ConnectionEvent _) = EventTypeConnection
-eventType (PropertyEvent (PropertySet _ _ _)) = EventTypePropertiesSet
-eventType (PropertyEvent (PropertyDeleted _ _)) = EventTypePropertiesDeleted
-eventType (PropertyEvent (PropertiesCleared _)) = EventTypePropertiesCleared
-eventType (ClientEvent (ClientAdded _ _)) = EventTypeClientAdded
-eventType (ClientEvent (ClientRemoved _ _)) = EventTypeClientRemoved
+eventType (PropertyEvent (PropertySet _ _)) = EventTypePropertiesSet
+eventType (PropertyEvent (PropertyDeleted _)) = EventTypePropertiesDeleted
+eventType (PropertyEvent PropertiesCleared) = EventTypePropertiesCleared
+eventType (ClientEvent (ClientAdded _)) = EventTypeClientAdded
+eventType (ClientEvent (ClientRemoved _)) = EventTypeClientRemoved
 
 data EventType
   = EventTypeUserCreated
@@ -97,7 +97,7 @@ instance ToSchema EventType where
           element "user.delete" EventTypeUserDeleted,
           element "user.legalhold-enable" EventTypeUserLegalholdEnabled,
           element "user.legalhold-disable" EventTypeUserLegalholdDisabled,
-          element "user.legalhold-requested" EventTypeUserLegalholdRequested,
+          element "user.legalhold-request" EventTypeUserLegalholdRequested,
           element "user.properties-set" EventTypePropertiesSet,
           element "user.properties-delete" EventTypePropertiesDeleted,
           element "user.properties-clear" EventTypePropertiesCleared,
@@ -133,14 +133,14 @@ data ConnectionEvent = ConnectionUpdated
   deriving stock (Eq, Show)
 
 data PropertyEvent
-  = PropertySet !UserId !PropertyKey !A.Value
-  | PropertyDeleted !UserId !PropertyKey
-  | PropertiesCleared !UserId
+  = PropertySet !PropertyKey !A.Value
+  | PropertyDeleted !PropertyKey
+  | PropertiesCleared
   deriving stock (Eq, Show)
 
 data ClientEvent
-  = ClientAdded !UserId !Client
-  | ClientRemoved !UserId !ClientId
+  = ClientAdded !Client
+  | ClientRemoved !ClientId
   deriving stock (Eq, Show)
 
 data UserUpdatedData = UserUpdatedData
@@ -266,46 +266,72 @@ eventObjectSchema =
               _UserEvent
               ( tag
                   _UserUpdated
-                  ( UserUpdatedData
-                      <$> eupId .= field "id" schema
-                      <*> eupName .= maybe_ (optField "name" schema)
-                      <*> eupPict .= maybe_ (optField "picture" schema) -- DEPRECATED
-                      <*> eupAccentId .= maybe_ (optField "accent_id" schema)
-                      <*> eupAssets .= maybe_ (optField "assets" (array schema))
-                      <*> eupHandle .= maybe_ (optField "handle" schema)
-                      <*> eupLocale .= maybe_ (optField "locale" schema)
-                      <*> eupManagedBy .= maybe_ (optField "managed_by" schema)
-                      <*> eupSSOId .= maybe_ (optField "sso_id" genericToSchema)
-                      <*> eupSSOIdRemoved .= field "sso_id_deleted" schema
-                      <*> eupSupportedProtocols
-                        .= maybe_
-                          ( optField
-                              "supported_protocols"
-                              (set schema)
+                  ( field
+                      "user"
+                      ( object
+                          "UserUpdatedData"
+                          ( UserUpdatedData
+                              <$> eupId .= field "id" schema
+                              <*> eupName .= maybe_ (optField "name" schema)
+                              <*> eupPict .= maybe_ (optField "picture" schema) -- DEPRECATED
+                              <*> eupAccentId .= maybe_ (optField "accent_id" schema)
+                              <*> eupAssets .= maybe_ (optField "assets" (array schema))
+                              <*> eupHandle .= maybe_ (optField "handle" schema)
+                              <*> eupLocale .= maybe_ (optField "locale" schema)
+                              <*> eupManagedBy .= maybe_ (optField "managed_by" schema)
+                              <*> eupSSOId .= maybe_ (optField "sso_id" genericToSchema)
+                              <*> eupSSOIdRemoved .= field "sso_id_deleted" schema
+                              <*> eupSupportedProtocols
+                                .= maybe_
+                                  ( optField
+                                      "supported_protocols"
+                                      (set schema)
+                                  )
                           )
+                      )
                   )
                   <|> tag
                     _UserIdentityUpdated
-                    ( UserIdentityUpdatedData
-                        <$> eiuId .= field "id" schema
-                        <*> eiuEmail .= maybe_ (optField "email" schema)
-                        <*> eiuPhone .= maybe_ (optField "phone" schema)
+                    ( field
+                        "user"
+                        ( object
+                            "UserIdentityUpdatedData"
+                            ( UserIdentityUpdatedData
+                                <$> eiuId .= field "id" schema
+                                <*> eiuEmail .= maybe_ (optField "email" schema)
+                                <*> eiuPhone .= maybe_ (optField "phone" schema)
+                            )
+                        )
                     )
               )
           EventTypeUserIdentityRemoved ->
             tag
               _UserEvent
               ( tag
                   _UserIdentityRemoved
-                  ( UserIdentityRemovedData
-                      <$> eirId .= field "id" schema
-                      <*> eirEmail .= maybe_ (optField "email" schema)
-                      <*> eirPhone .= maybe_ (optField "phone" schema)
+                  ( field
+                      "user"
+                      ( object
+                          "UserIdentityRemovedData"
+                          ( UserIdentityRemovedData
+                              <$> eirId .= field "id" schema
+                              <*> eirEmail .= maybe_ (optField "email" schema)
+                              <*> eirPhone .= maybe_ (optField "phone" schema)
+                          )
+                      )
                   )
               )
           EventTypeUserSuspended -> tag _UserEvent (tag _UserSuspended (field "id" schema))
           EventTypeUserResumed -> tag _UserEvent (tag _UserResumed (field "id" schema))
-          EventTypeUserDeleted -> tag _UserEvent (tag _UserDeleted (field "id" schema))
+          EventTypeUserDeleted ->
+            tag
+              _UserEvent
+              ( tag
+                  _UserDeleted
+                  ( field "qualified_id" schema
+                      <* qUnqualified .= field "id" schema
+                  )
+              )
           EventTypeUserLegalholdEnabled ->
             tag
               _UserEvent
@@ -324,57 +350,46 @@ eventObjectSchema =
                   ( LegalHoldClientRequestedData
                       <$> lhcTargetUser .= field "id" schema
                       <*> lhcLastPrekey .= field "last_prekey" schema
-                      <*> lhcClientId .= field "client" schema
+                      <*> lhcClientId .= field "client" (idObjectSchema schema)
                   )
               )
           EventTypePropertiesSet ->
             tag
               _PropertyEvent
               ( tag
                   _PropertySet
-                  ( (,,)
-                      <$> (\(x, _, _) -> x) .= field "id" schema
-                      <*> (\(_, x, _) -> x) .= field "key" genericToSchema
-                      <*> (\(_, _, x) -> x)
-                        .= field "value" jsonValue
+                  ( (,)
+                      <$> fst .= field "key" genericToSchema
+                      <*> snd .= field "value" jsonValue
                   )
               )
           EventTypePropertiesDeleted ->
             tag
               _PropertyEvent
               ( tag
                   _PropertyDeleted
-                  ( (,)
-                      <$> fst .= field "id" schema
-                      <*> snd .= field "key" genericToSchema
-                  )
+                  (field "key" genericToSchema)
               )
           EventTypePropertiesCleared ->
             tag
               _PropertyEvent
               ( tag
                   _PropertiesCleared
-                  (field "id" schema)
+                  (pure ())
               )
           EventTypeClientAdded ->
             tag
               _ClientEvent
               ( tag
                   _ClientAdded
-                  ( (,)
-                      <$> fst .= field "id" schema
-                      <*> snd .= field "client" (Versioned @'V5 .= unVersioned <$> schema)
-                  )
+                  (field "client" (Versioned @'V5 .= unVersioned <$> schema))
               )
           EventTypeClientRemoved ->
             tag
               _ClientEvent
               ( tag
                   _ClientRemoved
-                  ( (,)
-                      <$> fst .= field "id" schema
-                      <*> snd .= field "client" schema
-                  )
+                  (field "client" (idObjectSchema schema))
               )
           EventTypeConnection ->
             tag
@@ -406,11 +421,6 @@ deriving via (Schema Event) instance A.FromJSON Event
 connEventUserId :: ConnectionEvent -> UserId
 connEventUserId ConnectionUpdated {..} = ucFrom ucConn
 
-propEventUserId :: PropertyEvent -> UserId
-propEventUserId (PropertySet u _ _) = u
-propEventUserId (PropertyDeleted u _) = u
-propEventUserId (PropertiesCleared u) = u
-
 instance ToBytes Event where
   bytes (UserEvent e) = bytes e
   bytes (ConnectionEvent e) = bytes e
@@ -434,10 +444,10 @@ instance ToBytes ConnectionEvent where
   bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e)
 
 instance ToBytes PropertyEvent where
-  bytes e@PropertySet {} = val "user.properties-set: " +++ toByteString (propEventUserId e)
-  bytes e@PropertyDeleted {} = val "user.properties-delete: " +++ toByteString (propEventUserId e)
-  bytes e@PropertiesCleared {} = val "user.properties-clear: " +++ toByteString (propEventUserId e)
+  bytes PropertySet {} = val "user.properties-set"
+  bytes PropertyDeleted {} = val "user.properties-delete"
+  bytes PropertiesCleared {} = val "user.properties-clear"
 
 instance ToBytes ClientEvent where
-  bytes (ClientAdded u _) = val "user.client-add: " +++ toByteString u
-  bytes (ClientRemoved u _) = val "user.client-remove: " +++ toByteString u
+  bytes (ClientAdded _) = val "user.client-add"
+  bytes (ClientRemoved _) = val "user.client-remove"
diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs
@@ -157,23 +157,22 @@ testObject_UserEvent_12 =
 testObject_UserEvent_13 :: Event
 testObject_UserEvent_13 =
   PropertyEvent
-    ( PropertySet alice.userId (PropertyKey "a") (toJSON (39 :: Int))
+    ( PropertySet (PropertyKey "a") (toJSON (39 :: Int))
     )
 
 testObject_UserEvent_14 :: Event
 testObject_UserEvent_14 =
   PropertyEvent
-    ( PropertyDeleted alice.userId (PropertyKey "a")
+    ( PropertyDeleted (PropertyKey "a")
     )
 
 testObject_UserEvent_15 :: Event
-testObject_UserEvent_15 = PropertyEvent (PropertiesCleared alice.userId)
+testObject_UserEvent_15 = PropertyEvent PropertiesCleared
 
 testObject_UserEvent_16 :: Event
 testObject_UserEvent_16 =
   ClientEvent
     ( ClientAdded
-        alice.userId
         ( Client
             (ClientId 2839)
             PermanentClientType
@@ -189,7 +188,7 @@ testObject_UserEvent_16 =
     )
 
 testObject_UserEvent_17 :: Event
-testObject_UserEvent_17 = ClientEvent (ClientRemoved alice.userId (ClientId 2839))
+testObject_UserEvent_17 = ClientEvent (ClientRemoved (ClientId 2839))
 
 --------------------------------------------------------------------------------
 

diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs
@@ -211,7 +211,7 @@ addClientWithReAuthPolicy policy u con new = do
   lift $ do
     for_ old $ execDelete u con
     liftSem $ GalleyProvider.newClient u (clientId clt)
-    liftSem $ Intra.onClientEvent u con (ClientAdded u clt)
+    liftSem $ Intra.onClientEvent u con (ClientAdded clt)
     when (clientType clt == LegalHoldClientType) $ liftSem $ Intra.onUserEvent u con (UserLegalHoldEnabled u)
     when (count > 1) $
       for_ (userEmail usr) $

diff --git a/services/brig/src/Brig/API/Properties.hs b/services/brig/src/Brig/API/Properties.hs
@@ -41,14 +41,14 @@ import Wire.NotificationSubsystem
 setProperty :: (Member NotificationSubsystem r) => UserId -> ConnId -> PropertyKey -> PropertyValue -> ExceptT PropertiesDataError (AppT r) ()
 setProperty u c k v = do
   wrapClientE $ Data.insertProperty u k (propertyRaw v)
-  lift $ liftSem $ Intra.onPropertyEvent u c (PropertySet u k (propertyValue v))
+  lift $ liftSem $ Intra.onPropertyEvent u c (PropertySet k (propertyValue v))
 
 deleteProperty :: (Member NotificationSubsystem r) => UserId -> ConnId -> PropertyKey -> AppT r ()
 deleteProperty u c k = do
   wrapClient $ Data.deleteProperty u k
-  liftSem $ Intra.onPropertyEvent u c (PropertyDeleted u k)
+  liftSem $ Intra.onPropertyEvent u c (PropertyDeleted k)
 
 clearProperties :: (Member NotificationSubsystem r) => UserId -> ConnId -> AppT r ()
 clearProperties u c = do
   wrapClient $ Data.clearProperties u
-  liftSem $ Intra.onPropertyEvent u c (PropertiesCleared u)
+  liftSem $ Intra.onPropertyEvent u c PropertiesCleared
diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs
@@ -63,7 +63,7 @@ onEvent ::
 onEvent n = handleTimeout $ case n of
   DeleteClient clientId uid mcon -> do
     rmClient uid clientId
-    Intra.onClientEvent uid mcon (ClientRemoved uid clientId)
+    Intra.onClientEvent uid mcon (ClientRemoved clientId)
   DeleteUser uid -> do
     Log.info $
       msg (val "Processing user delete event")

diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
@@ -237,7 +237,7 @@ testApproveLegalHoldDevice = do
           UserLegalHoldEnabled
           userStatus
       let pluck = \case
-            Ev.ClientAdded _ eClient -> do
+            Ev.ClientAdded eClient -> do
               clientId eClient @?= someClientId
               clientType eClient @?= LegalHoldClientType
               clientClass eClient @?= Just LegalHoldClient
@@ -316,7 +316,7 @@ testDisableLegalHoldForUser = do
     requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing
     approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing
     assertNotification mws $ \case
-      Ev.ClientAdded _ client -> do
+      Ev.ClientAdded client -> do
         clientId client @?= someClientId
         clientType client @?= LegalHoldClientType
         clientClass client @?= Just LegalHoldClient
@@ -332,7 +332,7 @@ testDisableLegalHoldForUser = do
       assertEqual "method" "POST" (requestMethod req)
       assertEqual "path" (pathInfo req) ["legalhold", "remove"]
     assertNotification mws $ \case
-      Ev.ClientEvent (Ev.ClientRemoved _ clientId') -> clientId' @?= someClientId
+      Ev.ClientEvent (Ev.ClientRemoved clientId') -> clientId' @?= someClientId
       _ -> assertBool "Unexpected event" False
     assertNotification mws $ \case
       Ev.UserEvent (Ev.UserLegalHoldDisabled uid) -> uid @?= member

diff --git a/services/galley/test/integration/API/Teams/LegalHold/Util.hs b/services/galley/test/integration/API/Teams/LegalHold/Util.hs
@@ -487,26 +487,6 @@ requestLegalHoldDevice' g zusr uid tid = do
 ----------------------------------------------------------------------
 -- test helpers
 
-deriving instance Show Ev.Event
-
-deriving instance Show Ev.UserEvent
-
-deriving instance Show Ev.ClientEvent
-
-deriving instance Show Ev.PropertyEvent
-
-deriving instance Show Ev.ConnectionEvent
-
--- (partial implementation, just good enough to make the tests work)
-instance FromJSON Ev.Event where
-  parseJSON ev = flip (withObject "Ev.Event") ev $ \o -> do
-    typ :: Text <- o .: "type"
-    if
-        | typ `elem` ["user.legalhold-request", "user.legalhold-enable", "user.legalhold-disable"] -> Ev.UserEvent <$> Aeson.parseJSON ev
-        | typ `elem` ["user.client-add", "user.client-remove"] -> Ev.ClientEvent <$> Aeson.parseJSON ev
-        | typ == "user.connection" -> Ev.ConnectionEvent <$> Aeson.parseJSON ev
-        | otherwise -> fail $ "Ev.Event: unsupported event type: " <> show typ
-
 -- (partial implementation, just good enough to make the tests work)
 instance FromJSON Ev.UserEvent where
   parseJSON = withObject "Ev.UserEvent" $ \o -> do
@@ -528,11 +508,9 @@ instance FromJSON Ev.ClientEvent where
   parseJSON = withObject "Ev.ClientEvent" $ \o -> do
     tag :: Text <- o .: "type"
     case tag of
-      "user.client-add" -> Ev.ClientAdded fakeuid <$> o .: "client"
-      "user.client-remove" -> Ev.ClientRemoved fakeuid <$> (o .: "client" >>= withObject "id" (.: "id"))
+      "user.client-add" -> Ev.ClientAdded <$> o .: "client"
+      "user.client-remove" -> Ev.ClientRemoved <$> (o .: "client" >>= withObject "id" (.: "id"))
       x -> fail $ "Ev.ClientEvent: unsupported event type: " ++ show x
-    where
-      fakeuid = read @UserId "6980fb5e-ba64-11eb-a339-0b3625bf01be"
 
 instance FromJSON Ev.ConnectionEvent where
   parseJSON = Aeson.withObject "ConnectionEvent" $ \o -> do