Fix involuntary cassandra upserts

changelog.d/5-internal/wpb-3915

@@ -0,0 +1 @@
+Distinguish between update and upsert cassandra commands (follow-up to #3504) (#3513)

services/brig/src/Brig/API/OAuth.hs

@@ -313,7 +313,7 @@ updateOAuthClient' :: (MonadClient m) => OAuthClientId -> OAuthApplicationName -
 updateOAuthClient' cid name uri = retry x5 . write q $ params LocalQuorum (name, uri, cid)
   where
     q :: PrepQuery W (OAuthApplicationName, RedirectUrl, OAuthClientId) ()
-    q = "UPDATE oauth_client SET name = ?, redirect_uri = ? WHERE id = ?"
+    q = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE oauth_client SET name = ?, redirect_uri = ? WHERE id = ?"
 
 insertOAuthClient :: (MonadClient m) => OAuthClientId -> OAuthApplicationName -> RedirectUrl -> Password -> m ()
 insertOAuthClient cid name uri pw = retry x5 . write q $ params LocalQuorum (cid, name, uri, pw)

services/brig/src/Brig/Data/Client.hs

@@ -382,10 +382,10 @@ insertClient :: PrepQuery W (UserId, ClientId, UTCTimeMillis, ClientType, Maybe
 insertClient = "INSERT INTO clients (user, client, tstamp, type, label, class, cookie, lat, lon, model, capabilities) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
 
 updateClientLabelQuery :: PrepQuery W (Maybe Text, UserId, ClientId) ()
-updateClientLabelQuery = "UPDATE clients SET label = ? WHERE user = ? AND client = ?"
+updateClientLabelQuery = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE clients SET label = ? WHERE user = ? AND client = ?"
 
 updateClientCapabilitiesQuery :: PrepQuery W (Maybe (C.Set ClientCapability), UserId, ClientId) ()
-updateClientCapabilitiesQuery = "UPDATE clients SET capabilities = ? WHERE user = ? AND client = ?"
+updateClientCapabilitiesQuery = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE clients SET capabilities = ? WHERE user = ? AND client = ?"
 
 updateClientLastActiveQuery :: PrepQuery W (UTCTime, UserId, ClientId) Row
 updateClientLastActiveQuery = "UPDATE clients SET last_active = ? WHERE user = ? AND client = ? IF EXISTS"

services/brig/src/Brig/Data/Connection.hs

@@ -340,7 +340,7 @@ connectionInsert :: PrepQuery W (UserId, UserId, RelationWithHistory, UTCTimeMil
 connectionInsert = "INSERT INTO connection (left, right, status, last_update, conv) VALUES (?, ?, ?, ?, ?)"
 
 connectionUpdate :: PrepQuery W (RelationWithHistory, UTCTimeMillis, UserId, UserId) ()
-connectionUpdate = "UPDATE connection SET status = ?, last_update = ? WHERE left = ? AND right = ?"
+connectionUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE connection SET status = ?, last_update = ? WHERE left = ? AND right = ?"
 
 connectionSelect :: PrepQuery R (UserId, UserId) (UserId, UserId, RelationWithHistory, UTCTimeMillis, Maybe ConvId)
 connectionSelect = "SELECT left, right, status, last_update, conv FROM connection WHERE left = ? AND right = ?"
@@ -391,7 +391,7 @@ remoteConnectionSelectFrom :: PrepQuery R (UserId, Domain, UserId) (RelationWith
 remoteConnectionSelectFrom = "SELECT status, last_update, conv_domain, conv_id FROM connection_remote where left = ? AND right_domain = ? AND right_user = ?"
 
 remoteConnectionUpdate :: PrepQuery W (RelationWithHistory, UTCTimeMillis, UserId, Domain, UserId) ()
-remoteConnectionUpdate = "UPDATE connection_remote set status = ?, last_update = ? WHERE left = ? and right_domain = ? and right_user = ?"
+remoteConnectionUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE connection_remote set status = ?, last_update = ? WHERE left = ? and right_domain = ? and right_user = ?"
 
 remoteConnectionDelete :: PrepQuery W (UserId, Domain, UserId) ()
 remoteConnectionDelete = "DELETE FROM connection_remote where left = ? AND right_domain = ? AND right_user = ?"

services/brig/src/Brig/Data/MLS/KeyPackage.hs

@@ -189,11 +189,11 @@ addKeyPackageRef :: MonadClient m => KeyPackageRef -> NewKeyPackageRef -> m ()
 addKeyPackageRef ref nkpr = do
   retry x5 $
     write
-      q
+      upsertQuery
       (params LocalQuorum (nkprClientId nkpr, qUnqualified (nkprConversation nkpr), qDomain (nkprConversation nkpr), qDomain (nkprUserId nkpr), qUnqualified (nkprUserId nkpr), ref))
   where
-    q :: PrepQuery W (ClientId, ConvId, Domain, Domain, UserId, KeyPackageRef) x
-    q = "UPDATE mls_key_package_refs SET client = ?, conv = ?, conv_domain = ?, domain = ?, user = ? WHERE ref = ?"
+    upsertQuery :: PrepQuery W (ClientId, ConvId, Domain, Domain, UserId, KeyPackageRef) x
+    upsertQuery = "UPDATE mls_key_package_refs SET client = ?, conv = ?, conv_domain = ?, domain = ?, user = ? WHERE ref = ?"
 
 -- | Update key package ref, used in Galley when commit reveals key package ref update for the sender.
 -- Nothing is changed if the previous key package ref is not found in the table.

services/brig/src/Brig/Data/User.hs

@@ -622,64 +622,64 @@ userInsert =
   \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
 
 userDisplayNameUpdate :: PrepQuery W (Name, UserId) ()
-userDisplayNameUpdate = "UPDATE user SET name = ? WHERE id = ?"
+userDisplayNameUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET name = ? WHERE id = ?"
 
 userPictUpdate :: PrepQuery W (Pict, UserId) ()
-userPictUpdate = "UPDATE user SET picture = ? WHERE id = ?"
+userPictUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET picture = ? WHERE id = ?"
 
 userAssetsUpdate :: PrepQuery W ([Asset], UserId) ()
-userAssetsUpdate = "UPDATE user SET assets = ? WHERE id = ?"
+userAssetsUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET assets = ? WHERE id = ?"
 
 userAccentIdUpdate :: PrepQuery W (ColourId, UserId) ()
-userAccentIdUpdate = "UPDATE user SET accent_id = ? WHERE id = ?"
+userAccentIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET accent_id = ? WHERE id = ?"
 
 userEmailUpdate :: PrepQuery W (Email, UserId) ()
-userEmailUpdate = "UPDATE user SET email = ? WHERE id = ?"
+userEmailUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = ? WHERE id = ?"
 
 userEmailUnvalidatedUpdate :: PrepQuery W (Email, UserId) ()
-userEmailUnvalidatedUpdate = "UPDATE user SET email_unvalidated = ? WHERE id = ?"
+userEmailUnvalidatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email_unvalidated = ? WHERE id = ?"
 
 userEmailUnvalidatedDelete :: PrepQuery W (Identity UserId) ()
-userEmailUnvalidatedDelete = "UPDATE user SET email_unvalidated = null WHERE id = ?"
+userEmailUnvalidatedDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email_unvalidated = null WHERE id = ?"
 
 userPhoneUpdate :: PrepQuery W (Phone, UserId) ()
-userPhoneUpdate = "UPDATE user SET phone = ? WHERE id = ?"
+userPhoneUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET phone = ? WHERE id = ?"
 
 userSSOIdUpdate :: PrepQuery W (Maybe UserSSOId, UserId) ()
-userSSOIdUpdate = "UPDATE user SET sso_id = ? WHERE id = ?"
+userSSOIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET sso_id = ? WHERE id = ?"
 
 userManagedByUpdate :: PrepQuery W (ManagedBy, UserId) ()
-userManagedByUpdate = "UPDATE user SET managed_by = ? WHERE id = ?"
+userManagedByUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET managed_by = ? WHERE id = ?"
 
 userHandleUpdate :: PrepQuery W (Handle, UserId) ()
-userHandleUpdate = "UPDATE user SET handle = ? WHERE id = ?"
+userHandleUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET handle = ? WHERE id = ?"
 
 userSupportedProtocolUpdate :: PrepQuery W (Set BaseProtocolTag, UserId) ()
-userSupportedProtocolUpdate = "UPDATE user SET supported_protocols = ? WHERE id = ?"
+userSupportedProtocolUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET supported_protocols = ? WHERE id = ?"
 
 userPasswordUpdate :: PrepQuery W (Password, UserId) ()
-userPasswordUpdate = "UPDATE user SET password = ? WHERE id = ?"
+userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?"
 
 userStatusUpdate :: PrepQuery W (AccountStatus, UserId) ()
-userStatusUpdate = "UPDATE user SET status = ? WHERE id = ?"
+userStatusUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET status = ? WHERE id = ?"
 
 userDeactivatedUpdate :: PrepQuery W (Identity UserId) ()
-userDeactivatedUpdate = "UPDATE user SET activated = false WHERE id = ?"
+userDeactivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = false WHERE id = ?"
 
 userActivatedUpdate :: PrepQuery W (Maybe Email, Maybe Phone, UserId) ()
-userActivatedUpdate = "UPDATE user SET activated = true, email = ?, phone = ? WHERE id = ?"
+userActivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = true, email = ?, phone = ? WHERE id = ?"
 
 userLocaleUpdate :: PrepQuery W (Language, Maybe Country, UserId) ()
-userLocaleUpdate = "UPDATE user SET language = ?, country = ? WHERE id = ?"
+userLocaleUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET language = ?, country = ? WHERE id = ?"
 
 userEmailDelete :: PrepQuery W (Identity UserId) ()
-userEmailDelete = "UPDATE user SET email = null WHERE id = ?"
+userEmailDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = null WHERE id = ?"
 
 userPhoneDelete :: PrepQuery W (Identity UserId) ()
-userPhoneDelete = "UPDATE user SET phone = null WHERE id = ?"
+userPhoneDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET phone = null WHERE id = ?"
 
 userRichInfoUpdate :: PrepQuery W (RichInfoAssocList, UserId) ()
-userRichInfoUpdate = "UPDATE rich_info SET json = ? WHERE user = ?"
+userRichInfoUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE rich_info SET json = ? WHERE user = ?"
 
 -------------------------------------------------------------------------------
 -- Conversions

services/brig/src/Brig/Provider/DB.hs

@@ -72,11 +72,11 @@ updateAccountProfile p name url descr = retry x5 . batch $ do
   for_ descr $ \x -> addPrepQuery cqlDescr (x, p)
   where
     cqlName :: PrepQuery W (Name, ProviderId) ()
-    cqlName = "UPDATE provider SET name = ? WHERE id = ?"
+    cqlName = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET name = ? WHERE id = ?"
     cqlUrl :: PrepQuery W (HttpsUrl, ProviderId) ()
-    cqlUrl = "UPDATE provider SET url = ? WHERE id = ?"
+    cqlUrl = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET url = ? WHERE id = ?"
     cqlDescr :: PrepQuery W (Text, ProviderId) ()
-    cqlDescr = "UPDATE provider SET descr = ? WHERE id = ?"
+    cqlDescr = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET descr = ? WHERE id = ?"
 
 -- | Lookup the raw account data of a (possibly unverified) provider.
 lookupAccountData ::
@@ -136,7 +136,7 @@ updateAccountPassword pid pwd = do
   retry x5 $ write cql $ params LocalQuorum (p, pid)
   where
     cql :: PrepQuery W (Password, ProviderId) ()
-    cql = "UPDATE provider SET password = ? where id = ?"
+    cql = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET password = ? where id = ?"
 
 --------------------------------------------------------------------------------
 -- Unique (Natural) Keys
@@ -156,10 +156,12 @@ insertKey p old new = retry x5 . batch $ do
   where
     cqlKeyInsert :: PrepQuery W (Text, ProviderId) ()
     cqlKeyInsert = "INSERT INTO provider_keys (key, provider) VALUES (?, ?)"
+
     cqlKeyDelete :: PrepQuery W (Identity Text) ()
     cqlKeyDelete = "DELETE FROM provider_keys WHERE key = ?"
+
     cqlEmail :: PrepQuery W (Email, ProviderId) ()
-    cqlEmail = "UPDATE provider SET email = ? WHERE id = ?"
+    cqlEmail = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET email = ? WHERE id = ?"
 
 lookupKey ::
   MonadClient m =>
@@ -306,15 +308,15 @@ updateService pid sid svcName svcTags nameChange summary descr assets tagsChange
   for_ assets $ \x -> addPrepQuery cqlAssets (x, pid, sid)
   where
     cqlName :: PrepQuery W (Name, ProviderId, ServiceId) ()
-    cqlName = "UPDATE service SET name = ? WHERE provider = ? AND id = ?"
+    cqlName = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET name = ? WHERE provider = ? AND id = ?"
     cqlSummary :: PrepQuery W (Text, ProviderId, ServiceId) ()
-    cqlSummary = "UPDATE service SET summary = ? WHERE provider = ? AND id = ?"
+    cqlSummary = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET summary = ? WHERE provider = ? AND id = ?"
     cqlDescr :: PrepQuery W (Text, ProviderId, ServiceId) ()
-    cqlDescr = "UPDATE service SET descr = ? WHERE provider = ? AND id = ?"
+    cqlDescr = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET descr = ? WHERE provider = ? AND id = ?"
     cqlAssets :: PrepQuery W ([Asset], ProviderId, ServiceId) ()
-    cqlAssets = "UPDATE service SET assets = ? WHERE provider = ? AND id = ?"
+    cqlAssets = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET assets = ? WHERE provider = ? AND id = ?"
     cqlTags :: PrepQuery W (C.Set ServiceTag, ProviderId, ServiceId) ()
-    cqlTags = "UPDATE service SET tags = ? WHERE provider = ? AND id = ?"
+    cqlTags = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET tags = ? WHERE provider = ? AND id = ?"
 
 -- NB: can take a significant amount of time if many teams were using the service
 deleteService ::
@@ -436,16 +438,17 @@ updateServiceConn pid sid url tokens keys enabled = retry x5 . batch $ do
   for_ enabled $ \x -> addPrepQuery cqlEnabled (x, pid, sid)
   where
     (pks, fps) = (fmap fst &&& fmap snd) (unzip . toList <$> keys)
+
     cqlBaseUrl :: PrepQuery W (HttpsUrl, ProviderId, ServiceId) ()
-    cqlBaseUrl = "UPDATE service SET base_url = ? WHERE provider = ? AND id = ?"
+    cqlBaseUrl = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET base_url = ? WHERE provider = ? AND id = ?"
     cqlTokens :: PrepQuery W (List1 ServiceToken, ProviderId, ServiceId) ()
-    cqlTokens = "UPDATE service SET auth_tokens = ? WHERE provider = ? AND id = ?"
+    cqlTokens = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET auth_tokens = ? WHERE provider = ? AND id = ?"
     cqlKeys :: PrepQuery W ([ServiceKey], ProviderId, ServiceId) ()
-    cqlKeys = "UPDATE service SET pubkeys = ? WHERE provider = ? AND id = ?"
+    cqlKeys = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET pubkeys = ? WHERE provider = ? AND id = ?"
     cqlFps :: PrepQuery W ([Fingerprint Rsa], ProviderId, ServiceId) ()
-    cqlFps = "UPDATE service SET fingerprints = ? WHERE provider = ? AND id = ?"
+    cqlFps = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET fingerprints = ? WHERE provider = ? AND id = ?"
     cqlEnabled :: PrepQuery W (Bool, ProviderId, ServiceId) ()
-    cqlEnabled = "UPDATE service SET enabled = ? WHERE provider = ? AND id = ?"
+    cqlEnabled = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE service SET enabled = ? WHERE provider = ? AND id = ?"
 
 --------------------------------------------------------------------------------
 -- Service "Indexes" (tag and prefix); contain only enabled services

services/brig/src/Brig/Unique.hs

@@ -66,13 +66,13 @@ withClaim u v t io = do
     -- [Note: Guarantees]
     claim = do
       let ttl = max minTtl (fromIntegral (t #> Second))
-      retry x5 $ write cql $ params LocalQuorum (ttl * 2, C.Set [u], v)
+      retry x5 $ write upsertQuery $ params LocalQuorum (ttl * 2, C.Set [u], v)
       claimed <- (== [u]) <$> lookupClaims v
       if claimed
         then liftIO $ timeout (fromIntegral ttl # Second) io
         else pure Nothing
-    cql :: PrepQuery W (Int32, C.Set (Id a), Text) ()
-    cql = "UPDATE unique_claims USING TTL ? SET claims = claims + ? WHERE value = ?"
+    upsertQuery :: PrepQuery W (Int32, C.Set (Id a), Text) ()
+    upsertQuery = "UPDATE unique_claims USING TTL ? SET claims = claims + ? WHERE value = ?"
 
 deleteClaim ::
   MonadClient m =>
@@ -91,7 +91,7 @@ deleteClaim u v t = do
   retry x5 $ write cql $ params LocalQuorum (ttl * 2, C.Set [u], v)
   where
     cql :: PrepQuery W (Int32, C.Set (Id a), Text) ()
-    cql = "UPDATE unique_claims USING TTL ? SET claims = claims - ? WHERE value = ?"
+    cql = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE unique_claims USING TTL ? SET claims = claims - ? WHERE value = ?"
 
 -- | Lookup the current claims on a value.
 lookupClaims :: MonadClient m => Text -> m [Id a]

services/brig/test/integration/API/User/Auth.hs

@@ -202,17 +202,20 @@ testLoginWith6CharPassword brig db = do
         (PasswordLogin (PasswordLoginData (LoginByEmail email) pw Nothing Nothing))
         PersistentCookie
         !!! const expectedStatusCode === statusCode
+
     -- Since 8 char passwords are required, when setting a password via the API,
     -- we need to write this directly to the db, to be able to test this
     writeDirectlyToDB :: UserId -> PlainTextPassword6 -> Http ()
     writeDirectlyToDB uid pw =
       liftIO (runClient db (updatePassword uid pw >> revokeAllCookies uid))
+
     updatePassword :: MonadClient m => UserId -> PlainTextPassword6 -> m ()
     updatePassword u t = do
       p <- liftIO $ mkSafePassword t
       retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u))
+
     userPasswordUpdate :: PrepQuery W (Password, UserId) ()
-    userPasswordUpdate = "UPDATE user SET password = ? WHERE id = ?"
+    userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?"
 
 --------------------------------------------------------------------------------
 -- ZAuth test environment for generating arbitrary tokens.

services/galley/src/Galley/Cassandra/Client.hs

@@ -41,7 +41,7 @@ import UnliftIO qualified
 
 updateClient :: Bool -> UserId -> ClientId -> Client ()
 updateClient add usr cls = do
-  let q = if add then Cql.addMemberClient else Cql.rmMemberClient
+  let q = if add then Cql.upsertMemberAddClient else Cql.upsertMemberRmClient
   retry x5 $ write (q cls) (params LocalQuorum (Identity usr))
 
 -- Do, at most, 16 parallel lookups of up to 128 users each

services/galley/src/Galley/Cassandra/CustomBackend.hs

@@ -51,7 +51,7 @@ getCustomBackend domain =
 
 setCustomBackend :: MonadClient m => Domain -> CustomBackend -> m ()
 setCustomBackend domain CustomBackend {..} = do
-  retry x5 $ write Cql.updateCustomBackend (params LocalQuorum (backendConfigJsonUrl, backendWebappWelcomeUrl, domain))
+  retry x5 $ write Cql.upsertCustomBackend (params LocalQuorum (backendConfigJsonUrl, backendWebappWelcomeUrl, domain))
 
 deleteCustomBackend :: MonadClient m => Domain -> m ()
 deleteCustomBackend domain = do