From f9516f89bab78c8e27a1f8b6a8f2a6c1442d3f45 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 7 Jul 2026 11:55:07 +0200 Subject: [PATCH 1/5] brig: Reduce gc_grace_seconds on user tables --- cassandra-schema.cql | 10 ++--- services/brig/src/Brig/Schema/Run.hs | 4 +- .../Schema/V93_ReduceUserGCGracePeriod.hs | 44 +++++++++++++++++++ 3 files changed, 52 insertions(+), 6 deletions(-) create mode 100644 services/brig/src/Brig/Schema/V93_ReduceUserGCGracePeriod.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 7d2e47e16e0..5c62e1eff74 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -738,7 +738,7 @@ CREATE TABLE brig_test.rich_info ( AND crc_check_chance = 1.0 AND default_time_to_live = 0 AND extensions = {} - AND gc_grace_seconds = 864000 + AND gc_grace_seconds = 86400 AND max_index_interval = 2048 AND memtable_flush_period_in_ms = 0 AND min_index_interval = 128 @@ -848,7 +848,7 @@ CREATE TABLE brig_test.service_team ( AND crc_check_chance = 1.0 AND default_time_to_live = 0 AND extensions = {} - AND gc_grace_seconds = 864000 + AND gc_grace_seconds = 86400 AND max_index_interval = 2048 AND memtable_flush_period_in_ms = 0 AND min_index_interval = 128 @@ -874,7 +874,7 @@ CREATE TABLE brig_test.service_user ( AND crc_check_chance = 1.0 AND default_time_to_live = 0 AND extensions = {} - AND gc_grace_seconds = 864000 + AND gc_grace_seconds = 86400 AND max_index_interval = 2048 AND memtable_flush_period_in_ms = 0 AND min_index_interval = 128 @@ -1064,7 +1064,7 @@ CREATE TABLE brig_test.user ( AND crc_check_chance = 1.0 AND default_time_to_live = 0 AND extensions = {} - AND gc_grace_seconds = 864000 + AND gc_grace_seconds = 86400 AND max_index_interval = 2048 AND memtable_flush_period_in_ms = 0 AND min_index_interval = 128 @@ -1113,7 +1113,7 @@ CREATE TABLE brig_test.user_handle ( AND crc_check_chance = 1.0 AND default_time_to_live = 0 AND extensions = {} - AND gc_grace_seconds = 864000 + AND gc_grace_seconds = 86400 AND max_index_interval = 2048 AND memtable_flush_period_in_ms = 0 AND min_index_interval = 128 diff --git a/services/brig/src/Brig/Schema/Run.hs b/services/brig/src/Brig/Schema/Run.hs index bef0e82ce37..b7130212822 100644 --- a/services/brig/src/Brig/Schema/Run.hs +++ b/services/brig/src/Brig/Schema/Run.hs @@ -67,6 +67,7 @@ import Brig.Schema.V89_UpdateDomainRegistrationSchema qualified as V89_UpdateDom import Brig.Schema.V90_DomainRegistrationTeamIndex qualified as V90_DomainRegistrationTeamIndex import Brig.Schema.V91_UpdateDomainRegistrationSchema_AddWebappUrl qualified as V91_UpdateDomainRegistrationSchema_AddWebappUrl import Brig.Schema.V92_AddUserType qualified as V92_AddUserType +import Brig.Schema.V93_ReduceUserGCGracePeriod qualified as V93_ReduceUserGCGracePeriod import Cassandra.MigrateSchema (migrateSchema) import Cassandra.Schema import Control.Exception (finally) @@ -140,7 +141,8 @@ migrations = V89_UpdateDomainRegistrationSchema.migration, V90_DomainRegistrationTeamIndex.migration, V91_UpdateDomainRegistrationSchema_AddWebappUrl.migration, - V92_AddUserType.migration + V92_AddUserType.migration, + V93_ReduceUserGCGracePeriod.migration -- FUTUREWORK: undo V41 (searchable flag); we stopped using it in -- https://github.com/wireapp/wire-server/pull/964 ] diff --git a/services/brig/src/Brig/Schema/V93_ReduceUserGCGracePeriod.hs b/services/brig/src/Brig/Schema/V93_ReduceUserGCGracePeriod.hs new file mode 100644 index 00000000000..a29c26e1e83 --- /dev/null +++ b/services/brig/src/Brig/Schema/V93_ReduceUserGCGracePeriod.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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 Brig.Schema.V93_ReduceUserGCGracePeriod + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 93 "reduce user gc_grace_period" $ do + schema' + [r| ALTER TABLE user WITH gc_grace_seconds = 86400 |] + + schema' + [r| ALTER TABLE user_handle WITH gc_grace_seconds = 86400 |] + + schema' + [r| ALTER TABLE rich_info WITH gc_grace_seconds = 86400 |] + + schema' + [r| ALTER TABLE service_user WITH gc_grace_seconds = 86400 |] + + schema' + [r| ALTER TABLE service_team WITH gc_grace_seconds = 86400 |] From 14c7aaf6c37f9001450868565f1d5c27932319a2 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 9 Jul 2026 10:45:48 +0200 Subject: [PATCH 2/5] PostgresMarshall/Unmarshall instances for tuples of length 25 --- .../wire-api/src/Wire/API/PostgresMarshall.hs | 32 +++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/libs/wire-api/src/Wire/API/PostgresMarshall.hs b/libs/wire-api/src/Wire/API/PostgresMarshall.hs index e1a6f55f18d..24ff507ec27 100644 --- a/libs/wire-api/src/Wire/API/PostgresMarshall.hs +++ b/libs/wire-api/src/Wire/API/PostgresMarshall.hs @@ -521,6 +521,9 @@ instance (PostgresMarshall a1 b1, PostgresMarshall a2 b2, PostgresMarshall a3 b3 instance (PostgresMarshall a1 b1, PostgresMarshall a2 b2, PostgresMarshall a3 b3, PostgresMarshall a4 b4, PostgresMarshall a5 b5, PostgresMarshall a6 b6, PostgresMarshall a7 b7, PostgresMarshall a8 b8, PostgresMarshall a9 b9, PostgresMarshall a10 b10, PostgresMarshall a11 b11, PostgresMarshall a12 b12, PostgresMarshall a13 b13, PostgresMarshall a14 b14, PostgresMarshall a15 b15, PostgresMarshall a16 b16, PostgresMarshall a17 b17, PostgresMarshall a18 b18, PostgresMarshall a19 b19, PostgresMarshall a20 b20, PostgresMarshall a21 b21, PostgresMarshall a22 b22, PostgresMarshall a23 b23, PostgresMarshall a24 b24) => PostgresMarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24) where postgresMarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) = (postgresMarshall a1, postgresMarshall a2, postgresMarshall a3, postgresMarshall a4, postgresMarshall a5, postgresMarshall a6, postgresMarshall a7, postgresMarshall a8, postgresMarshall a9, postgresMarshall a10, postgresMarshall a11, postgresMarshall a12, postgresMarshall a13, postgresMarshall a14, postgresMarshall a15, postgresMarshall a16, postgresMarshall a17, postgresMarshall a18, postgresMarshall a19, postgresMarshall a20, postgresMarshall a21, postgresMarshall a22, postgresMarshall a23, postgresMarshall a24) +instance (PostgresMarshall a1 b1, PostgresMarshall a2 b2, PostgresMarshall a3 b3, PostgresMarshall a4 b4, PostgresMarshall a5 b5, PostgresMarshall a6 b6, PostgresMarshall a7 b7, PostgresMarshall a8 b8, PostgresMarshall a9 b9, PostgresMarshall a10 b10, PostgresMarshall a11 b11, PostgresMarshall a12 b12, PostgresMarshall a13 b13, PostgresMarshall a14 b14, PostgresMarshall a15 b15, PostgresMarshall a16 b16, PostgresMarshall a17 b17, PostgresMarshall a18 b18, PostgresMarshall a19 b19, PostgresMarshall a20 b20, PostgresMarshall a21 b21, PostgresMarshall a22 b22, PostgresMarshall a23 b23, PostgresMarshall a24 b24, PostgresMarshall a25 b25) => PostgresMarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25) where + postgresMarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) = (postgresMarshall a1, postgresMarshall a2, postgresMarshall a3, postgresMarshall a4, postgresMarshall a5, postgresMarshall a6, postgresMarshall a7, postgresMarshall a8, postgresMarshall a9, postgresMarshall a10, postgresMarshall a11, postgresMarshall a12, postgresMarshall a13, postgresMarshall a14, postgresMarshall a15, postgresMarshall a16, postgresMarshall a17, postgresMarshall a18, postgresMarshall a19, postgresMarshall a20, postgresMarshall a21, postgresMarshall a22, postgresMarshall a23, postgresMarshall a24, postgresMarshall a25) + instance PostgresMarshall UUID (Id a) where postgresMarshall = toUUID @@ -989,6 +992,35 @@ instance (PostgresUnmarshall a1 b1, PostgresUnmarshall a2 b2, PostgresUnmarshall <*> postgresUnmarshall a23 <*> postgresUnmarshall a24 +instance (PostgresUnmarshall a1 b1, PostgresUnmarshall a2 b2, PostgresUnmarshall a3 b3, PostgresUnmarshall a4 b4, PostgresUnmarshall a5 b5, PostgresUnmarshall a6 b6, PostgresUnmarshall a7 b7, PostgresUnmarshall a8 b8, PostgresUnmarshall a9 b9, PostgresUnmarshall a10 b10, PostgresUnmarshall a11 b11, PostgresUnmarshall a12 b12, PostgresUnmarshall a13 b13, PostgresUnmarshall a14 b14, PostgresUnmarshall a15 b15, PostgresUnmarshall a16 b16, PostgresUnmarshall a17 b17, PostgresUnmarshall a18 b18, PostgresUnmarshall a19 b19, PostgresUnmarshall a20 b20, PostgresUnmarshall a21 b21, PostgresUnmarshall a22 b22, PostgresUnmarshall a23 b23, PostgresUnmarshall a24 b24, PostgresUnmarshall a25 b25) => PostgresUnmarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25) where + postgresUnmarshall (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) = + (,,,,,,,,,,,,,,,,,,,,,,,,) + <$> postgresUnmarshall a1 + <*> postgresUnmarshall a2 + <*> postgresUnmarshall a3 + <*> postgresUnmarshall a4 + <*> postgresUnmarshall a5 + <*> postgresUnmarshall a6 + <*> postgresUnmarshall a7 + <*> postgresUnmarshall a8 + <*> postgresUnmarshall a9 + <*> postgresUnmarshall a10 + <*> postgresUnmarshall a11 + <*> postgresUnmarshall a12 + <*> postgresUnmarshall a13 + <*> postgresUnmarshall a14 + <*> postgresUnmarshall a15 + <*> postgresUnmarshall a16 + <*> postgresUnmarshall a17 + <*> postgresUnmarshall a18 + <*> postgresUnmarshall a19 + <*> postgresUnmarshall a20 + <*> postgresUnmarshall a21 + <*> postgresUnmarshall a22 + <*> postgresUnmarshall a23 + <*> postgresUnmarshall a24 + <*> postgresUnmarshall a25 + instance PostgresUnmarshall UUID (Id a) where postgresUnmarshall = Right . Id From 4dcb50cc9393c304dc41ed4cbcd8ef2c82f619d9 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 7 Jul 2026 18:03:47 +0200 Subject: [PATCH 3/5] UserStore.Migration: Implement migration --- ...559-add-user-migration-pending-deletes.sql | 3 + .../Wire/DomainRegistrationStore/Migration.hs | 23 +- libs/wire-subsystems/src/Wire/Migration.hs | 21 ++ .../src/Wire/UserStore/Migration.hs | 253 ++++++++++++++++++ .../src/Wire/UserStore/Migration/Types.hs | 89 ++++++ .../src/Wire/UserStore/Postgres.hs | 2 +- libs/wire-subsystems/wire-subsystems.cabal | 2 + postgres-schema.sql | 23 +- services/brig/brig.cabal | 1 + 9 files changed, 392 insertions(+), 25 deletions(-) create mode 100644 libs/wire-subsystems/postgres-migrations/20260625104559-add-user-migration-pending-deletes.sql create mode 100644 libs/wire-subsystems/src/Wire/UserStore/Migration.hs create mode 100644 libs/wire-subsystems/src/Wire/UserStore/Migration/Types.hs diff --git a/libs/wire-subsystems/postgres-migrations/20260625104559-add-user-migration-pending-deletes.sql b/libs/wire-subsystems/postgres-migrations/20260625104559-add-user-migration-pending-deletes.sql new file mode 100644 index 00000000000..21143117419 --- /dev/null +++ b/libs/wire-subsystems/postgres-migrations/20260625104559-add-user-migration-pending-deletes.sql @@ -0,0 +1,3 @@ +CREATE TABLE user_migration_pending_deletes ( + id uuid PRIMARY KEY + ); diff --git a/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Migration.hs b/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Migration.hs index 26a7d5de941..b1359b56b12 100644 --- a/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Migration.hs +++ b/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Migration.hs @@ -121,7 +121,7 @@ migrateAllDomainRegistrations migOpts migCounter migDuration = do lift $ info $ Log.msg (Log.val "migrateAllDomainRegistrations") withCount (paginateSem selectAllRegistrations (paramsP LocalQuorum () migOpts.pageSize) x5) .| logRetrievedPage migOpts.pageSize asRecord - .| C.mapM_ (traverse_ (\row -> handleRegistrationErrors (toByteString' (show row.domain)) (migrateDomainRegistrationRow migOpts migCounter migDuration row))) + .| C.mapM_ (traverse_ (\row -> handleLockAndDBErrors (toByteString' (show row.domain)) (migrateDomainRegistrationRow migOpts migCounter migDuration row))) migrateDomainRegistrationRow :: ( PGConstraints r, @@ -174,24 +174,3 @@ selectAllRegistrations = selectAllChallenges :: PrepQuery R () (ChallengeId, Domain, Token, DnsVerificationToken, Int32) selectAllChallenges = "SELECT id, domain, challenge_token_hash, dns_verification_token, ttl(challenge_token_hash) FROM domain_registration_challenge" - -handleRegistrationErrors :: - ( Member (State Int) r, - Member TinyLog r - ) => - ByteString -> - (Sem (Error MigrationLockError : Error Hasql.UsageError : r) ()) -> - Sem r () -handleRegistrationErrors key action = do - eithErr <- runError (runError action) - case eithErr of - Right (Right _) -> pure () - Right (Left e) -> logError (show e) - Left e -> logError (show e) - where - logError e = do - warn $ - Log.msg (Log.val "error occurred during migration") - . Log.field "key" (show key) - . Log.field "error" e - modify (+ 1) diff --git a/libs/wire-subsystems/src/Wire/Migration.hs b/libs/wire-subsystems/src/Wire/Migration.hs index 325910448ba..a4b528a16d8 100644 --- a/libs/wire-subsystems/src/Wire/Migration.hs +++ b/libs/wire-subsystems/src/Wire/Migration.hs @@ -169,6 +169,27 @@ handleErrors key action = do . Log.field "error" (show e) modify (+ 1) +handleLockAndDBErrors :: + ( Member (State Int) r, + Member TinyLog r + ) => + ByteString -> + (Sem (Error MigrationLockError : Error Hasql.UsageError : r) ()) -> + Sem r () +handleLockAndDBErrors key action = do + eithErr <- runError (runError action) + case eithErr of + Right (Right _) -> pure () + Right (Left e) -> logError (show e) + Left e -> logError (show e) + where + logError e = do + warn $ + Log.msg (Log.val "error occurred during migration") + . Log.field "key" (show key) + . Log.field "error" e + modify (+ 1) + withExclusiveMigrationLockAndTimeout :: forall x r. ( PGConstraints r, diff --git a/libs/wire-subsystems/src/Wire/UserStore/Migration.hs b/libs/wire-subsystems/src/Wire/UserStore/Migration.hs new file mode 100644 index 00000000000..c078869d1f2 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserStore/Migration.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Wire.UserStore.Migration where + +import Cassandra hiding (Set) +import Cassandra.Util +import Conduit +import Data.Conduit.List qualified as C +import Data.Handle +import Data.Id +import Data.Json.Util (UTCTimeMillis) +import Data.Misc +import Data.Time +import Database.CQL.Protocol (Record (..), TupleType) +import Hasql.Pool +import Hasql.Statement qualified as Hasql +import Hasql.TH (resultlessStatement) +import Hasql.Transaction qualified as Transaction +import Hasql.Transaction.Sessions (IsolationLevel (ReadCommitted), Mode (..)) +import Imports +import Polysemy +import Polysemy.Async +import Polysemy.Conc +import Polysemy.Error +import Polysemy.Input +import Polysemy.Resource +import Polysemy.State +import Polysemy.TinyLog +import Prometheus qualified +import System.Logger.Message qualified as Log +import Wire.API.Password +import Wire.API.PostgresMarshall +import Wire.API.User +import Wire.API.User.RichInfo +import Wire.Migration +import Wire.MigrationLock +import Wire.Postgres +import Wire.Sem.Concurrency +import Wire.UserStore.Migration.Types +import Wire.UserStore.Postgres + +migrateAllUsers :: + ( Member TinyLog r, + Member (Input ClientState) r, + Member (Embed IO) r, + Member (State Int) r, + Member (Concurrency Unsafe) r, + Member (Input Pool) r, + Member Async r, + Member Race r, + Member Resource r + ) => + MigrationOptions -> Prometheus.Counter -> Prometheus.Vector Text Prometheus.Histogram -> ConduitM () Void (Sem r) () +migrateAllUsers migOpts migCounter migDuration = do + lift $ info $ Log.msg (Log.val "migrateAllUsers") + withCount (paginateSem select (paramsP LocalQuorum () migOpts.pageSize) x5) + .| logRetrievedPage migOpts.pageSize runIdentity + .| C.mapM_ (unsafePooledMapConcurrentlyN_ migOpts.parallelism (\uid -> handleLockAndDBErrors "user" (migrateUser migOpts.timeout migCounter migDuration uid))) + where + select :: PrepQuery R () (Identity UserId) + select = "select id from user" + +migrateUser :: + ( PGConstraints r, + Member TinyLog r, + Member (Error MigrationLockError) r, + Member Async r, + Member Race r, + Member Resource r, + Member (Input ClientState) r + ) => + Duration -> Prometheus.Counter -> Prometheus.Vector Text Prometheus.Histogram -> UserId -> Sem r () +migrateUser migTimeout migCounter migDuration uid = + withExclusiveMigrationLockAndTimeout migTimeout migDuration [uid] $ do + cState <- input + mCassData <- runClient cState $ getUserData uid + case mCassData of + Nothing -> pure () + Just cassData -> do + let eithPGRow = mkUserRowPG cassData.id cassData.user cassData.isHandleClaimed cassData.richInfo + case eithPGRow of + Left e -> warn $ Log.msg (Log.val "Invalid user found, skipping") . Log.field "id" (idToText cassData.id) . Log.field "error" (show e) + Right pgRow -> do + saveToPostgres pgRow cassData.serviceConv + runClient cState $ deleteFromCassandra pgRow.id_ pgRow.handle ((,) <$> pgRow.providerId <*> pgRow.serviceId) + markDeletionComplete pgRow.id_ + liftIO $ Prometheus.incCounter migCounter + +getUserData :: UserId -> Client (Maybe RawUserData) +getUserData uid = do + mUserRow <- asRecord <$$> query1 selectUserRow (params LocalQuorum (Identity uid)) + case mUserRow of + Nothing -> pure Nothing + Just user -> do + serviceConv <- case (,) <$> user.providerId <*> user.serviceId of + Nothing -> pure Nothing + Just (pid, sid) -> asRecord <$$> query1 selectServiceConv (params LocalQuorum (pid, sid, uid)) + isHandleClaimed <- case user.handle of + Nothing -> pure False + Just h -> do + mClaimedBy <- runIdentity <$$> query1 selectHandleClaim (params LocalQuorum (Identity h)) + pure $ mClaimedBy == Just uid + richInfo <- runIdentity <$$> query1 selectRichInfo (params LocalQuorum (Identity uid)) + pure $ Just RawUserData {id = uid, ..} + where + selectUserRow :: PrepQuery R (Identity UserId) (TupleType UserRowCass) + selectUserRow = + "SELECT accent_id, activated, country, email, email_unvalidated,\ + \expires, feature_conference_calling, handle, language, managed_by, \ + \name, password, provider, searchable, service,\ + \sso_id, status, supported_protocols, team, text_status,\ + \user_type, write_time_bumper, accent, assets, picture,\ + \writetime(activated)\ + \FROM user WHERE id = ?" + + selectServiceConv :: PrepQuery R (ProviderId, ServiceId, UserId) (TupleType ServiceConv) + selectServiceConv = "SELECT conv, team FROM service_user WHERE provider = ? AND service = ? AND user = ?" + + selectHandleClaim :: PrepQuery R (Identity Handle) (Identity UserId) + selectHandleClaim = "SELECT user FROM handle WHERE handle = ?" + + selectRichInfo :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList) + selectRichInfo = "SELECT json FROM rich_info where user = ?" + +data InvalidUserError = UserHasNoName | UserHasNoActiavted + deriving (Show) + +mkUserRowPG :: UserId -> UserRowCass -> Bool -> Maybe RichInfoAssocList -> Either InvalidUserError UserRowPG +mkUserRowPG id_ cass@UserRowCass {..} isHandleClaimed richInfo = run . runError $ do + pgName <- note UserHasNoName cass.name + pgActivated <- note UserHasNoActiavted cass.activated + createdAt <- note UserHasNoActiavted $ writetimeToUTC <$> cass.activatedWriteTime + pure $ + UserRowPG + { accentId = fromMaybe defaultAccentId cass.accentId, + userType = fromMaybe UserTypeRegular cass.userType, + name = pgName, + activated = pgActivated, + handle = if isHandleClaimed then cass.handle else Nothing, + .. + } + +{- ORMOLU_DISABLE -} +type UserTuplePG = + (UserId, ColourId, Bool, Maybe Country, Maybe EmailAddress, + Maybe EmailAddress, Maybe UTCTimeMillis, Maybe Int32, Maybe Handle, Maybe Language, + Maybe ManagedBy, Name, Maybe Password, Maybe ProviderId, Maybe ServiceId, + Maybe UserSSOId, Maybe AccountStatus, Maybe (Set BaseProtocolTag), Maybe TeamId, Maybe TextStatus, + UserType, Maybe Pict, Maybe RichInfoAssocList, Maybe Bool, UTCTime + ) + +userRowPGToTuple :: UserRowPG -> UserTuplePG +userRowPGToTuple user = + (user.id_, user.accentId, user.activated, user.country,user.email, + user.emailUnvalidated, user.expires, user.featureConferenceCalling, user.handle, user.language, + user.managedBy, user.name, user.password, user.providerId, user.serviceId, + user.ssoId, user.status, user.supportedProtocols, user.teamId, user.textStatus, + user.userType, user.pict, user.richInfo, user.searchable, user.createdAt) +{- ORMOLU_ENABLE -} + +saveToPostgres :: (PGConstraints r) => UserRowPG -> Maybe ServiceConv -> Sem r () +saveToPostgres user mServiceConv = + runTransactionWithRetry ReadCommitted Write $ do + case user.status of + Just Deleted -> + Transaction.statement (user.id_, user.teamId, user.createdAt) insertDeleted + _ -> do + Transaction.statement (userRowPGToTuple user) insertUser + for_ user.assets $ \assets -> do + Transaction.statement user.id_ deleteAssetsStatement + Transaction.statement (mkAssetRows user.id_ assets) insertAssetsStatement + for_ mServiceConv $ \serviceConv -> + Transaction.statement (user.id_, serviceConv.convId, serviceConv.teamId) insertBotConv + Transaction.statement user.id_ markPendingDelete + where + insertDeleted :: Hasql.Statement (UserId, Maybe TeamId, UTCTime) () + insertDeleted = + lmapPG + [resultlessStatement| + INSERT INTO deleted_user + (id, team, created_at) + VALUES ($1 :: uuid, $2 :: uuid?, $3 :: timestamptz) + ON CONFLICT (id) DO NOTHING + |] + insertUser :: Hasql.Statement UserTuplePG () + insertUser = + lmapPG + [resultlessStatement| + INSERT INTO wire_user + (id, accent_id, activated, country, email, + email_unvalidated, expires, feature_conference_calling, handle, language, + managed_by, name, password, provider, service, + sso_id, account_status, supported_protocols, team, text_status, + user_type, picture, rich_info, searchable, created_at + ) + VALUES + ($1 :: uuid, $2 :: integer, $3 :: boolean, $4 :: text?, $5 :: text?, + $6 :: text?, $7 :: timestamptz?, $8 :: integer?, $9 :: text?, $10 :: text?, + $11 :: integer?, $12 :: text, $13 :: text?, $14 :: uuid?, $15 :: uuid?, + $16 :: jsonb?, $17 :: integer?, $18 :: integer?, $19 :: uuid?, $20 :: text?, + $21 :: integer, $22 :: jsonb?, $23 :: jsonb?, $24 :: boolean?, $25 :: timestamptz + ) + ON CONFLICT (id) DO NOTHING + |] + insertBotConv :: Hasql.Statement (UserId, ConvId, Maybe TeamId) () + insertBotConv = + lmapPG + [resultlessStatement| + INSERT INTO bot_conv + (id, conv, conv_team) + VALUES ($1 :: uuid, $2 :: uuid, $3 :: uuid?) + |] + + markPendingDelete :: Hasql.Statement UserId () + markPendingDelete = + lmapPG + [resultlessStatement| + INSERT INTO user_migration_pending_deletes (id) + VALUES ($1 :: uuid) + ON CONFLICT (id) DO NOTHING + |] + +markDeletionComplete :: (PGConstraints r) => UserId -> Sem r () +markDeletionComplete uid = + runStatement uid stmt + where + stmt :: Hasql.Statement UserId () + stmt = lmapPG [resultlessStatement|DELETE FROM user_migration_pending_deletes WHERE id = $1 :: uuid|] + +deleteFromCassandra :: UserId -> Maybe Handle -> Maybe (ProviderId, ServiceId) -> Client () +deleteFromCassandra uid mHandle mService = do + for_ mHandle $ \handle -> write deleteHandle (params LocalQuorum (Identity handle)) + for_ mService $ \(pid, sid) -> do + write deleteServiceUser (params LocalQuorum (pid, sid)) + write deleteServiceTeam (params LocalQuorum (pid, sid)) + write deleteRichInfo (params LocalQuorum (Identity uid)) + write deleteUser (params LocalQuorum (Identity uid)) + where + deleteUser :: PrepQuery W (Identity UserId) () + deleteUser = "DELETE FROM user WHERE id = ?" + + deleteHandle :: PrepQuery W (Identity Handle) () + deleteHandle = "DELETE FROM user_handle WHERE handle = ?" + + deleteServiceUser :: PrepQuery W (ProviderId, ServiceId) () + deleteServiceUser = "DELETE FROM service_user WHERE provider = ? AND service = ?" + + deleteServiceTeam :: PrepQuery W (ProviderId, ServiceId) () + deleteServiceTeam = "DELETE FROM service_team WHERE provider = ? AND service = ?" + + deleteRichInfo :: PrepQuery W (Identity UserId) () + deleteRichInfo = "DELETE FROM rich_info WHERE user = ?" diff --git a/libs/wire-subsystems/src/Wire/UserStore/Migration/Types.hs b/libs/wire-subsystems/src/Wire/UserStore/Migration/Types.hs new file mode 100644 index 00000000000..e2077541d6e --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserStore/Migration/Types.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.UserStore.Migration.Types where + +import Cassandra.Util +import Data.Handle +import Data.Id +import Data.Json.Util +import Data.Time +import Database.CQL.Protocol (Record (..), TupleType, recordInstance) +import Imports +import Wire.API.Password +import Wire.API.User +import Wire.API.User.RichInfo + +data RawUserData = RawUserData + { id :: UserId, + user :: UserRowCass, + richInfo :: Maybe RichInfoAssocList, + serviceConv :: Maybe ServiceConv, + isHandleClaimed :: Bool + } + +-- | Some fields are read as 'Maybe' even if they're supposed to always be +-- there. This is to deal with potential old data in the DB. +data UserRowCass = UserRowCass + { accentId :: Maybe ColourId, + activated :: Maybe Bool, + country :: Maybe Country, + email :: Maybe EmailAddress, + emailUnvalidated :: Maybe EmailAddress, + expires :: Maybe UTCTimeMillis, + featureConferenceCalling :: Maybe Int32, + handle :: Maybe Handle, + language :: Maybe Language, + managedBy :: Maybe ManagedBy, + name :: Maybe Name, + password :: Maybe Password, + providerId :: Maybe ProviderId, + searchable :: Maybe Bool, + serviceId :: Maybe ServiceId, + ssoId :: Maybe UserSSOId, + status :: Maybe AccountStatus, + supportedProtocols :: Maybe (Set BaseProtocolTag), + teamId :: Maybe TeamId, + textStatus :: Maybe TextStatus, + userType :: Maybe UserType, + assets :: Maybe [Asset], + pict :: Maybe Pict, + activatedWriteTime :: Maybe (Writetime ()) + } + +data ServiceConv = ServiceConv + { convId :: ConvId, + teamId :: Maybe TeamId + } + +data UserRowPG = UserRowPG + { id_ :: UserId, + accentId :: ColourId, + activated :: Bool, + country :: Maybe Country, + email :: Maybe EmailAddress, + emailUnvalidated :: Maybe EmailAddress, + expires :: Maybe UTCTimeMillis, + featureConferenceCalling :: Maybe Int32, + handle :: Maybe Handle, + language :: Maybe Language, + managedBy :: Maybe ManagedBy, + name :: Name, + password :: Maybe Password, + providerId :: Maybe ProviderId, + searchable :: Maybe Bool, + serviceId :: Maybe ServiceId, + ssoId :: Maybe UserSSOId, + status :: Maybe AccountStatus, + supportedProtocols :: Maybe (Set BaseProtocolTag), + teamId :: Maybe TeamId, + textStatus :: Maybe TextStatus, + userType :: UserType, + assets :: Maybe [Asset], + pict :: Maybe Pict, + richInfo :: Maybe RichInfoAssocList, + createdAt :: UTCTime + } + +recordInstance ''UserRowCass + +recordInstance ''ServiceConv diff --git a/libs/wire-subsystems/src/Wire/UserStore/Postgres.hs b/libs/wire-subsystems/src/Wire/UserStore/Postgres.hs index 9192317b407..1b4168cfd24 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Postgres.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} -module Wire.UserStore.Postgres (interpretUserStorePostgres) where +module Wire.UserStore.Postgres (interpretUserStorePostgres, deleteAssetsStatement, insertAssetsStatement, mkAssetRows) where import Cassandra (GeneralPaginationState (PaginationStatePostgres), PageWithState (..), paginationStatePostgres) import Data.Handle diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 680a8e71519..ffae0ec110f 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -455,6 +455,8 @@ library Wire.UserStore Wire.UserStore.Cassandra Wire.UserStore.IndexUser + Wire.UserStore.Migration + Wire.UserStore.Migration.Types Wire.UserStore.Postgres Wire.UserStore.Unique Wire.UserSubsystem diff --git a/postgres-schema.sql b/postgres-schema.sql index c60938bceb0..d1df5013e89 100644 --- a/postgres-schema.sql +++ b/postgres-schema.sql @@ -9,8 +9,8 @@ \restrict 79bbfb4630959c48307653a5cd3d83f2582b3c2210f75f10d79e3ebf0015620 --- Dumped from database version 17.9 --- Dumped by pg_dump version 17.9 +-- Dumped from database version 17.10 +-- Dumped by pg_dump version 17.10 SET statement_timeout = 0; SET lock_timeout = 0; @@ -444,6 +444,17 @@ CREATE TABLE public.user_group_member ( ALTER TABLE public.user_group_member OWNER TO "wire-server"; +-- +-- Name: user_migration_pending_deletes; Type: TABLE; Schema: public; Owner: wire-server +-- + +CREATE TABLE public.user_migration_pending_deletes ( + id uuid NOT NULL +); + + +ALTER TABLE public.user_migration_pending_deletes OWNER TO "wire-server"; + -- -- Name: wire_user; Type: TABLE; Schema: public; Owner: wire-server -- @@ -656,6 +667,14 @@ ALTER TABLE ONLY public.user_group ADD CONSTRAINT user_group_pkey PRIMARY KEY (team_id, id); +-- +-- Name: user_migration_pending_deletes user_migration_pending_deletes_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server +-- + +ALTER TABLE ONLY public.user_migration_pending_deletes + ADD CONSTRAINT user_migration_pending_deletes_pkey PRIMARY KEY (id); + + -- -- Name: wire_user wire_user_handle_key; Type: CONSTRAINT; Schema: public; Owner: wire-server -- diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 2f7ab0b0789..2937cd6d5b3 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -189,6 +189,7 @@ library Brig.Schema.V90_DomainRegistrationTeamIndex Brig.Schema.V91_UpdateDomainRegistrationSchema_AddWebappUrl Brig.Schema.V92_AddUserType + Brig.Schema.V93_ReduceUserGCGracePeriod Brig.Team.API Brig.Team.Template Brig.Template From 5507119f44af06347e5792e9aa4d4d96622f65a0 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 13 Jul 2026 13:58:29 +0200 Subject: [PATCH 4/5] UserStore.Migration: Fix typo, add todo --- libs/wire-subsystems/src/Wire/UserStore/Migration.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/UserStore/Migration.hs b/libs/wire-subsystems/src/Wire/UserStore/Migration.hs index c078869d1f2..4a866b62767 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Migration.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Migration.hs @@ -100,6 +100,7 @@ getUserData uid = do Nothing -> pure False Just h -> do mClaimedBy <- runIdentity <$$> query1 selectHandleClaim (params LocalQuorum (Identity h)) + -- TODO: log if the handle is claimed by someone else. pure $ mClaimedBy == Just uid richInfo <- runIdentity <$$> query1 selectRichInfo (params LocalQuorum (Identity uid)) pure $ Just RawUserData {id = uid, ..} @@ -123,14 +124,14 @@ getUserData uid = do selectRichInfo :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList) selectRichInfo = "SELECT json FROM rich_info where user = ?" -data InvalidUserError = UserHasNoName | UserHasNoActiavted +data InvalidUserError = UserHasNoName | UserHasNoActivated deriving (Show) mkUserRowPG :: UserId -> UserRowCass -> Bool -> Maybe RichInfoAssocList -> Either InvalidUserError UserRowPG mkUserRowPG id_ cass@UserRowCass {..} isHandleClaimed richInfo = run . runError $ do pgName <- note UserHasNoName cass.name - pgActivated <- note UserHasNoActiavted cass.activated - createdAt <- note UserHasNoActiavted $ writetimeToUTC <$> cass.activatedWriteTime + pgActivated <- note UserHasNoActivated cass.activated + createdAt <- note UserHasNoActivated $ writetimeToUTC <$> cass.activatedWriteTime pure $ UserRowPG { accentId = fromMaybe defaultAccentId cass.accentId, From d7de45d0922021a7a407c6a104012bc5a4084efa Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 13 Jul 2026 17:02:32 +0200 Subject: [PATCH 5/5] [WIP] integration: Add test for user migration to pg --- integration/integration.cabal | 1 + integration/test/Test/Migration/User.hs | 252 ++++++++++++++++++++++++ 2 files changed, 253 insertions(+) create mode 100644 integration/test/Test/Migration/User.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index 92abb7662b7..d9a4d9583d4 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -181,6 +181,7 @@ library Test.Migration.ConversationCodes Test.Migration.DomainRegistration Test.Migration.TeamFeatures + Test.Migration.User Test.Migration.Util Test.MLS Test.MLS.Clients diff --git a/integration/test/Test/Migration/User.hs b/integration/test/Test/Migration/User.hs new file mode 100644 index 00000000000..bf34eaa5acd --- /dev/null +++ b/integration/test/Test/Migration/User.hs @@ -0,0 +1,252 @@ +-- | The migration has these phases. +-- 1. Write to cassandra (before any migration activity) +-- 2. Galley is prepared for migrations (new things created in PG, old things are in Cassandra) +-- 3. Backgound worker starts migration +-- 4. Background worker finishes migration, galley is still configured to think migration is on going +-- 5. Background worker is configured to not do anything, galley is configured to only use PG +-- +-- The comments and variable names call these phases by number i.e. Phase1, Phase2, and so on. +-- +-- The tests are from the perspective of mel, a user on the dynamic backend, +-- called backendM (migrating backend). There are also users called mark and mia +-- on this backend. +module Test.Migration.User where + +import API.Brig +import API.Galley +import qualified API.GalleyInternal as I +import API.Spar +import Control.Applicative +import Control.Concurrent (threadDelay) +import Control.Monad.Codensity +import Control.Monad.Reader +import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.IntMap.Merge.Lazy +import qualified Data.IntSet as IntSet +import qualified Data.Map as Map +import GHC.Stack +import MLS.Util +import Notifications +import qualified SAML2.WebSSO as SAML +import SetupHelpers hiding (deleteUser) +import Test.MLS.History (channelsConfig) +import Test.Migration.Util +import Testlib.Prelude +import Testlib.ResourcePool +import UnliftIO + +-- | User types: +-- - SCIM + Rich Info +-- - SCIM + No rich info +-- - Non SCIM Team user +-- - Personal + No Handle +-- - Personal + Handle +-- - Bot in team conv +-- - Bot in non team conv +-- - Team SSO users +-- - Users with passwords +-- +-- Weird cases: +-- - Users without a name +-- - Users without activated +-- - Users with unclaimed handles +-- +-- Data modifications to test: +-- 1. Account creation +-- - create account by registering +-- - create team +-- - accept invite into a team +-- - sso +-- - scim +-- 2. Updates +-- - profile info +-- - email +-- - password +-- - handle claim (fresh handle, no collisions) +-- - handle claim (existing, yes collisions) +-- 3. Deletes +-- - user delete +-- - team delete +-- +-- Queries to test +-- 1. Search +-- 2. Get by id +-- 3. Get by handle +-- 4. Get by email +testMigrationToPostgres :: App () +testMigrationToPostgres = do + resourcePool <- asks (.resourcePool) + alice <- randomUser OwnDomain def + + runCodensity (acquireResources 1 resourcePool) $ \[migratingBackend] -> do + let domainM = migratingBackend.berDomain + testUsersAfterPhase1 <- runCodensity (startDynamicBackend migratingBackend phase1Overrides) $ \_ -> do + undefined + undefined + where + n = 1 + + createUsers :: (HasCallStack) => String -> App TestUserList + createUsers domain = do + undefined + + getUnqualifiedUser :: String -> String -> App (Map String Value) + getUnqualifiedUser domain uid = do + let quid = object ["domain" .= domain, "id" .= uid] + Map.singleton uid <$> (getUser quid quid >>= getJSON 200) + + createScimUsers :: (HasCallStack) => String -> Bool -> App (Map String Value) + createScimUsers domain shouldCreateRichInfo = do + (owner, tid, _) <- createTeam domain 1 + tok <- createScimToken owner def >>= \resp -> resp.json %. "token" >>= asString + fmap Map.unions . replicateM n $ do + scimUser0 <- randomScimUser + scimUser <- + if shouldCreateRichInfo + then setField "rich_info" "very arbitrary" scimUser0 -- TODO: Actually generate rich info + else pure scimUser0 + email <- asString $ scimUser %. "emails.0.value" + uid <- + createScimUser domain tok scimUser `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "id" >>= asString + registerInvitedUser domain tid email + getUnqualifiedUser domain uid + + createSsoUsers :: (HasCallStack) => String -> App (Map String Value) + createSsoUsers domain = do + (owner, tid, _) <- createTeam domain 1 + I.setTeamFeatureStatus owner tid "sso" "enabled" >>= assertSuccess + (createIdpResp, (idpMeta, privcreds)) <- registerTestIdPWithMetaWithPrivateCreds owner + assertSuccess createIdpResp + idpId <- asString =<< (createIdpResp.json %. "id") + + fmap Map.unions . replicateM n $ do + subject <- nextSubject + (mUid, _) <- loginWithSaml True tid subject (idpId, (idpMeta, privcreds)) + uid <- assertJust "user id not created by logging in with SAML" mUid + getUnqualifiedUser domain uid + + createPasswordTeamUsers :: (HasCallStack) => String -> App (Map String Value) + createPasswordTeamUsers = undefined + + createTeamUsersPendingInvitation :: (HasCallStack) => String -> App (Map String Value) + createTeamUsersPendingInvitation = undefined + + createPersonalUsersWithoutHandle :: (HasCallStack) => String -> App (Map String Value) + createPersonalUsersWithoutHandle = undefined + + createPersonalUsersWithHandle :: (HasCallStack) => String -> App (Map String Value) + createPersonalUsersWithHandle = undefined + + createBotsInTeamConvs :: (HasCallStack) => String -> App (Map String (Value, Value)) + createBotsInTeamConvs = undefined + + createBotsInPersonalConvs :: (HasCallStack) => String -> App (Map String (Value, Value)) + createBotsInPersonalConvs = undefined + +-- * Test Helpers + +data TestUsersByOperations = TestUsersByOperations + { creates :: IntMap TestUserList, + updates :: IntMap TestUserList, + deletes :: IntMap TestUserList + } + +-- | +-- TODO: Add Weird cases +-- - Users without a name +-- - Users without activated +-- - Users with unclaimed handles +data TestUserList = TestUserList + { scimUsersWithRichInfo :: (Map String Value), + scimUsersWithoutRichInfo :: (Map String Value), + ssoUsers :: (Map String Value), + passwordTeamUsers :: (Map String Value), + teamUsersPendingInvitation :: (Map String Value), + personalUsersWithoutHandle :: (Map String Value), + personalUsersWithHandle :: (Map String Value), + -- | {Phase -> {Id -> {User, BotConv}}} + botsInTeamConvs :: (Map String (Value, Value)), + botsInPersonalConvs :: (Map String (Value, Value)) + } + +instance ToJSON TestUserList where + toJSON userList = do + object + [ fromString "scimUsersWithRichInfo" .= Map.keys userList.scimUsersWithRichInfo, + fromString "scimUsersWithoutRichInfo" .= Map.keys userList.scimUsersWithoutRichInfo, + fromString "ssoUsers" .= Map.keys userList.ssoUsers, + fromString "passwordTeamUsers" .= Map.keys userList.passwordTeamUsers, + fromString "teamUsersPendingInvitation" .= Map.keys userList.teamUsersPendingInvitation, + fromString "personalUsersWithoutHandle" .= Map.keys userList.personalUsersWithoutHandle, + fromString "personalUsersWithHandle" .= Map.keys userList.personalUsersWithHandle, + fromString "botsInTeamConvs" .= Map.keys userList.botsInTeamConvs, + fromString "botsInPersonalConvs" .= Map.keys userList.botsInPersonalConvs + ] + +-- instance Semigroup TestUserList where +-- l1 <> l2 = +-- TestUserList +-- { scimUsersWithRichInfo = l1.scimUsersWithRichInfo <> l2.scimUsersWithRichInfo, +-- scimUsersWithoutRichInfo = deepMerge l1.scimUsersWithoutRichInfo l2.scimUsersWithoutRichInfo, +-- ssoUsers = deepMerge l1.ssoUsers l2.ssoUsers, +-- passwordTeamUsers = deepMerge l1.passwordTeamUsers l2.passwordTeamUsers, +-- teamUsersPendingInvitation = deepMerge l1.teamUsersPendingInvitation l2.teamUsersPendingInvitation, +-- personalUsersWithoutHandle = deepMerge l1.personalUsersWithoutHandle l2.personalUsersWithoutHandle, +-- personalUsersWithHandle = deepMerge l1.personalUsersWithHandle l2.personalUsersWithHandle, +-- botsInTeamConvs = deepMerge l1.botsInTeamConvs l2.botsInTeamConvs, +-- botsInPersonalConvs = deepMerge l1.botsInPersonalConvs l2.botsInPersonalConvs +-- } +-- where +-- deepMerge :: (Map String v) -> (Map String v) -> (Map String v) +-- deepMerge = merge missingTactic missingTactic mergeTactic + +-- missingTactic :: SimpleWhenMissing x x +-- missingTactic = traverseMissing $ (\_ x -> Identity x) + +-- mergeTactic :: (Ord k) => SimpleWhenMatched (Map k v) (Map k v) (Map k v) +-- mergeTactic = zipWithMatched (\_ x y -> Map.union x y) + +userMigrationFinishedCounterName :: String +userMigrationFinishedCounterName = "^wire_users_migration_finished" + +phase1Overrides, phase2Overrides, phase3Overrides, phase4Overrides, phase5Overrides :: ServiceOverrides +phase1Overrides = + def + { galleyCfg = setField "postgresMigration.user" "cassandra", + backgroundWorkerCfg = setField "migrateUsers" False + } +phase2Overrides = + def + { galleyCfg = setField "postgresMigration.user" "migration-to-postgresql", + backgroundWorkerCfg = setField "migrateUsers" False + } +phase3Overrides = + def + { galleyCfg = setField "postgresMigration.user" "migration-to-postgresql", + backgroundWorkerCfg = setField "migrateUsers" True + } +phase4Overrides = + def + { galleyCfg = setField "postgresMigration.user" "migration-to-postgresql", + backgroundWorkerCfg = setField "migrateUsers" False + } +phase5Overrides = + def + { galleyCfg = setField "postgresMigration.user" "postgresql", + backgroundWorkerCfg = setField "migrateUsers" False + } + +phaseOverrides :: IntMap ServiceOverrides +phaseOverrides = + IntMap.fromList + [ (1, phase1Overrides), + (2, phase2Overrides), + (3, phase3Overrides), + (4, phase4Overrides), + (5, phase5Overrides) + ]