UserStore: Add migration logic and migration interpreter

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

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

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)
+    ]

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
 

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
+  );

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)