From ab9b38d1a945d559fb02069e867f2be38d1cf3e7 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 19 Jan 2026 16:09:10 +0100 Subject: [PATCH] UserStore.IndexUser: Simplify type by only tracking overall created and updated timestamps This way adapting it for postgresql will be much easier --- .../IndexedUserStore/Bulk/ElasticSearch.hs | 4 +- .../src/Wire/UserStore/Cassandra.hs | 4 +- .../src/Wire/UserStore/IndexUser.hs | 140 +++++++----------- .../src/Wire/UserSubsystem/Interpreter.hs | 6 +- .../unit/Wire/MockInterpreters/UserStore.hs | 28 ++-- 5 files changed, 77 insertions(+), 105 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs index e5585735bd..41e905f9cf 100644 --- a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs +++ b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs @@ -116,7 +116,7 @@ syncAllUsersWithVersion mkVersion = -- contains User, Maybe Role, UserType, ..., and pass around -- ExtendedUser. this should make the code less convoluted. - let teams :: Map TeamId [IndexUser] = Map.fromListWith (<>) $ mapMaybe (\u -> (,[u]) . value <$> u.teamId) page + let teams :: Map TeamId [IndexUser] = Map.fromListWith (<>) $ mapMaybe (\u -> (,[u]) <$> u.teamId) page teamIds = Map.keys teams visMap <- fmap Map.fromList . unsafePooledForConcurrentlyN 16 teamIds $ \t -> (t,) <$> teamSearchVisibilityInbound t @@ -125,7 +125,7 @@ syncAllUsersWithVersion mkVersion = roles :: Map UserId (WithWritetime Role) <- fmap (Map.fromList . concat) . unsafePooledForConcurrentlyN 16 (Map.toList teams) $ \(t, us) -> do tms <- (.members) <$> selectTeamMemberInfos t (fmap (.userId) us) pure $ mapMaybe mkRoleWithWriteTime tms - let vis indexUser = fromMaybe defaultSearchVisibilityInbound $ (flip Map.lookup visMap . value =<< indexUser.teamId) + let vis indexUser = fromMaybe defaultSearchVisibilityInbound $ (flip Map.lookup visMap =<< indexUser.teamId) mkUserDoc indexUser = indexUserToDoc (vis indexUser) diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index 54f6218331..98b930f0cf 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -117,14 +117,14 @@ doesUserExistImpl uid = getIndexUserImpl :: UserId -> Client (Maybe IndexUser) getIndexUserImpl u = do mIndexUserTuple <- retry x1 $ query1 cql (params LocalQuorum (Identity u)) - pure $ asRecord <$> mIndexUserTuple + pure $ indexUserFromTuple <$> mIndexUserTuple where cql :: PrepQuery R (Identity UserId) (TupleType IndexUser) cql = prepared . QueryString $ getIndexUserBaseQuery <> " WHERE id = ?" getIndexUserPaginatedImpl :: Int32 -> Maybe PagingState -> Client (PageWithState IndexUser) getIndexUserPaginatedImpl pageSize mPagingState = - asRecord <$$> paginateWithState cql (paramsPagingState LocalQuorum () pageSize mPagingState) + indexUserFromTuple <$$> paginateWithState cql (paramsPagingState LocalQuorum () pageSize mPagingState) where cql :: PrepQuery R () (TupleType IndexUser) cql = prepared $ QueryString getIndexUserBaseQuery diff --git a/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs b/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs index 824fe49e24..ce3d9221f2 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs @@ -28,6 +28,7 @@ import Data.Json.Util import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error qualified as Text import Data.Text.ICU.Translit +import Data.Time import Database.CQL.Protocol import Imports import SAML2.WebSSO qualified as SAML @@ -44,19 +45,20 @@ data WithWritetime a = WithWriteTime {value :: a, writetime :: Writetime a} data IndexUser = IndexUser { userId :: UserId, - teamId :: Maybe (WithWritetime TeamId), - name :: WithWritetime Name, - accountStatus :: Maybe (WithWritetime AccountStatus), - handle :: Maybe (WithWritetime Handle), - email :: Maybe (WithWritetime EmailAddress), - colourId :: WithWritetime ColourId, - activated :: WithWritetime Activated, - serviceId :: Maybe (WithWritetime ServiceId), - managedBy :: Maybe (WithWritetime ManagedBy), - ssoId :: Maybe (WithWritetime UserSSOId), - unverifiedEmail :: Maybe (WithWritetime EmailAddress), - searchable :: Maybe (WithWritetime Bool), - writeTimeBumper :: Maybe (Writetime WriteTimeBumper) + teamId :: Maybe TeamId, + name :: Name, + accountStatus :: Maybe AccountStatus, + handle :: Maybe Handle, + email :: Maybe EmailAddress, + colourId :: ColourId, + activated :: Activated, + serviceId :: Maybe ServiceId, + managedBy :: Maybe ManagedBy, + ssoId :: Maybe UserSSOId, + unverifiedEmail :: Maybe EmailAddress, + searchable :: Maybe Bool, + createdAt :: UTCTime, + updatedAt :: UTCTime } deriving (Eq, Show) @@ -79,75 +81,45 @@ type instance Maybe (Writetime WriteTimeBumper) ) -instance Record IndexUser where - asTuple (IndexUser {..}) = +indexUserFromTuple :: TupleType IndexUser -> IndexUser +indexUserFromTuple ( userId, - value <$> teamId, writetime <$> teamId, - name.value, name.writetime, - value <$> accountStatus, writetime <$> accountStatus, - value <$> handle, writetime <$> handle, - value <$> email, writetime <$> email, - colourId.value, colourId.writetime, - activated.value, activated.writetime, - value <$> serviceId, writetime <$> serviceId, - value <$> managedBy, writetime <$> managedBy, - value <$> ssoId, writetime <$> ssoId, - value <$> unverifiedEmail, writetime <$> unverifiedEmail, - value <$> searchable, writetime <$> searchable, - writeTimeBumper - ) - - asRecord - ( u, - mTeam, tTeam, + teamId, tTeam, name, tName, - status, tStatus, + accountStatus, tStatus, handle, tHandle, email, tEmail, - colour, tColour, + colourId, tColour, activated, tActivated, - service, tService, + serviceId, tService, managedBy, tManagedBy, ssoId, tSsoId, - emailUnvalidated, tEmailUnvalidated, + unverifiedEmail, tEmailUnvalidated, searchable, tSearchable, tWriteTimeBumper ) = IndexUser { - userId = u, - teamId = WithWriteTime <$> mTeam <*> tTeam, - name = WithWriteTime name tName, - accountStatus = WithWriteTime <$> status <*> tStatus, - handle = WithWriteTime <$> handle <*> tHandle, - email = WithWriteTime <$> email <*> tEmail, - colourId = WithWriteTime colour tColour, - activated = WithWriteTime activated tActivated, - serviceId = WithWriteTime <$> service <*> tService, - managedBy = WithWriteTime <$> managedBy <*> tManagedBy, - ssoId = WithWriteTime <$> ssoId <*> tSsoId, - unverifiedEmail = WithWriteTime <$> emailUnvalidated <*> tEmailUnvalidated, - searchable = WithWriteTime <$> searchable <*> tSearchable, - writeTimeBumper = tWriteTimeBumper + createdAt = writetimeToUTC tActivated, + updatedAt = maximum $ catMaybes [writetimeToUTC <$> tTeam, + Just $ writetimeToUTC tName, + writetimeToUTC <$> tStatus, + writetimeToUTC <$> tHandle, + writetimeToUTC <$> tEmail, + Just $ writetimeToUTC tColour, + Just $ writetimeToUTC tActivated, + writetimeToUTC <$> tService, + writetimeToUTC <$> tManagedBy, + writetimeToUTC <$> tSsoId, + writetimeToUTC <$> tEmailUnvalidated, + writetimeToUTC <$> tSearchable, + writetimeToUTC <$> tWriteTimeBumper + ], + .. } {- ORMOLU_ENABLE -} indexUserToVersion :: Maybe (WithWritetime Role) -> IndexUser -> IndexVersion -indexUserToVersion role IndexUser {..} = - mkIndexVersion - [ const () <$$> Just name.writetime, - const () <$$> fmap writetime teamId, - const () <$$> fmap writetime accountStatus, - const () <$$> fmap writetime handle, - const () <$$> fmap writetime email, - const () <$$> Just colourId.writetime, - const () <$$> Just activated.writetime, - const () <$$> fmap writetime serviceId, - const () <$$> fmap writetime managedBy, - const () <$$> fmap writetime ssoId, - const () <$$> fmap writetime unverifiedEmail, - const () <$$> fmap writetime role, - const () <$$> fmap writetime searchable, - const () <$$> writeTimeBumper - ] +indexUserToVersion role iu = + mkIndexVersion [Just $ Writetime iu.updatedAt, const () <$$> fmap writetime role] indexUserToDoc :: SearchVisibilityInbound -> Maybe UserType -> Maybe Role -> IndexUser -> UserDoc indexUserToDoc searchVisInbound mUserType mRole IndexUser {..} = @@ -156,22 +128,22 @@ indexUserToDoc searchVisInbound mUserType mRole IndexUser {..} = UserDoc { udId = userId, udType = mUserType, - udSearchable = value <$> searchable, - udEmailUnvalidated = value <$> unverifiedEmail, - udSso = sso . value =<< ssoId, - udScimExternalId = join $ scimExternalId <$> (value <$> managedBy) <*> (value <$> ssoId), + udSearchable = searchable, + udEmailUnvalidated = unverifiedEmail, + udSso = sso =<< ssoId, + udScimExternalId = join $ scimExternalId <$> (managedBy) <*> (ssoId), udSearchVisibilityInbound = Just searchVisInbound, udRole = mRole, - udCreatedAt = Just . toUTCTimeMillis $ writetimeToUTC activated.writetime, - udManagedBy = value <$> managedBy, - udSAMLIdP = idpUrl . value =<< ssoId, - udAccountStatus = value <$> accountStatus, - udColourId = Just colourId.value, - udEmail = value <$> email, - udHandle = value <$> handle, - udNormalized = Just $ normalized name.value.fromName, - udName = Just name.value, - udTeam = value <$> teamId + udCreatedAt = Just . toUTCTimeMillis $ createdAt, + udManagedBy = managedBy, + udSAMLIdP = idpUrl =<< ssoId, + udAccountStatus = accountStatus, + udColourId = Just colourId, + udEmail = email, + udHandle = handle, + udNormalized = Just $ normalized name.fromName, + udName = Just name, + udTeam = teamId } else -- We insert a tombstone-style user here, as it's easier than -- deleting the old one. It's mostly empty, but having the status here @@ -179,7 +151,7 @@ indexUserToDoc searchVisInbound mUserType mRole IndexUser {..} = emptyUserDoc userId where shouldIndex = - ( case value <$> accountStatus of + ( case accountStatus of Nothing -> True Just Active -> True Just Suspended -> True @@ -187,7 +159,7 @@ indexUserToDoc searchVisInbound mUserType mRole IndexUser {..} = Just Ephemeral -> False Just PendingInvitation -> False ) - && activated.value -- FUTUREWORK: how is this adding to the first case? + && activated -- FUTUREWORK: how is this adding to the first case? && isNothing serviceId idpUrl :: UserSSOId -> Maybe Text diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index c6524d8e6b..1db607a961 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -729,10 +729,10 @@ syncUserIndex uid = vis <- maybe (pure defaultSearchVisibilityInbound) - (teamSearchVisibilityInbound . value) + teamSearchVisibilityInbound indexUser.teamId - tm <- maybe (pure Nothing) (selectTeamMember . value) indexUser.teamId - userType <- getUserType indexUser.userId (indexUser.teamId <&> (.value)) (indexUser.serviceId <&> (.value)) + tm <- maybe (pure Nothing) selectTeamMember indexUser.teamId + userType <- getUserType indexUser.userId indexUser.teamId indexUser.serviceId let mRole = tm >>= mkRoleWithWriteTime userDoc = indexUserToDoc vis (Just userType) (value <$> mRole) indexUser version = ES.ExternalGT . ES.ExternalDocVersion . docVersion $ indexUserToVersion mRole indexUser diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs index 1aa3869515..3711c0a469 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs @@ -19,7 +19,6 @@ module Wire.MockInterpreters.UserStore where -import Cassandra.Util import Data.Handle import Data.Id import Data.Time @@ -150,22 +149,23 @@ storedUserToIndexUser :: StoredUser -> IndexUser storedUserToIndexUser storedUser = -- If we really care about this, we could start storing the writetimes, but we -- don't need it right now - let withDefaultTime x = WithWriteTime x $ Writetime $ UTCTime (YearDay 0 1) 0 + let defaultTime = UTCTime (YearDay 0 1) 0 in IndexUser { userId = storedUser.id, - teamId = withDefaultTime <$> storedUser.teamId, - name = withDefaultTime storedUser.name, - accountStatus = withDefaultTime <$> storedUser.status, - handle = withDefaultTime <$> storedUser.handle, - email = withDefaultTime <$> storedUser.email, - colourId = withDefaultTime storedUser.accentId, - activated = withDefaultTime storedUser.activated, - serviceId = withDefaultTime <$> storedUser.serviceId, - managedBy = withDefaultTime <$> storedUser.managedBy, - ssoId = withDefaultTime <$> storedUser.ssoId, + teamId = storedUser.teamId, + name = storedUser.name, + accountStatus = storedUser.status, + handle = storedUser.handle, + email = storedUser.email, + colourId = storedUser.accentId, + activated = storedUser.activated, + serviceId = storedUser.serviceId, + managedBy = storedUser.managedBy, + ssoId = storedUser.ssoId, unverifiedEmail = Nothing, - searchable = withDefaultTime <$> storedUser.searchable, - writeTimeBumper = Nothing + searchable = storedUser.searchable, + createdAt = defaultTime, + updatedAt = defaultTime } lookupLocaleImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe ((Maybe Language, Maybe Country)))