-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- 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 <https://www.gnu.org/licenses/>.

module Wire.UserStore.Cassandra (interpretUserStoreCassandra) where

import Cassandra
import Cassandra.Exec (prepared)
import Control.Lens ((^.))
import Data.Handle
import Data.Id
import Database.CQL.Protocol
import Imports
import Polysemy
import Polysemy.Embed
import Polysemy.Error
import Wire.API.Password (Password)
import Wire.API.Provider.Service
import Wire.API.Team.Feature (FeatureStatus)
import Wire.API.User hiding (DeleteUser)
import Wire.API.User.RichInfo
import Wire.API.User.Search (SetSearchable (SetSearchable))
import Wire.StoredUser
import Wire.UserStore
import Wire.UserStore.IndexUser hiding (userId)
import Wire.UserStore.Unique

interpretUserStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor UserStore r
interpretUserStoreCassandra casClient =
  interpret $
    runEmbedded (runClient casClient) . embed . \case
      CreateUser new mbConv -> createUserImpl new mbConv
      GetUsers uids -> getUsersImpl uids
      DoesUserExist uid -> doesUserExistImpl uid
      GetIndexUser uid -> getIndexUserImpl uid
      GetIndexUsersPaginated pageSize mPagingState -> getIndexUserPaginatedImpl pageSize (paginationStateCassandra =<< mPagingState)
      UpdateUser uid update -> updateUserImpl uid update
      UpdateEmail uid email -> updateEmailImpl uid email
      UpdateEmailUnvalidated uid email -> updateEmailUnvalidatedImpl uid email
      DeleteEmailUnvalidated uid -> deleteEmailUnvalidatedImpl uid
      UpdateUserHandleEither uid update -> updateUserHandleEitherImpl uid update
      UpdateSSOId uid ssoId -> updateSSOIdImpl uid ssoId
      UpdateManagedBy uid managedBy -> updateManagedByImpl uid managedBy
      UpdateAccountStatus uid accountStatus -> updateAccountStatusImpl uid accountStatus
      ActivateUser uid identity -> activateUserImpl uid identity
      DeactivateUser uid -> deactivateUserImpl uid
      UpdateRichInfo uid richInfo -> updateRichInfoImpl uid richInfo
      UpdateFeatureConferenceCalling uid feat -> updateFeatureConferenceCallingImpl uid feat
      LookupFeatureConferenceCalling uid -> lookupFeatureConferenceCallingImpl uid
      DeleteUser user -> deleteUserImpl user
      LookupName uid -> lookupNameImpl uid
      LookupHandle hdl -> lookupHandleImpl LocalQuorum hdl
      GlimpseHandle hdl -> lookupHandleImpl One hdl
      LookupStatus uid -> lookupStatusImpl uid
      IsActivated uid -> isActivatedImpl uid
      LookupLocale uid -> lookupLocaleImpl uid
      GetUserTeam uid -> getUserTeamImpl uid
      UpdateUserTeam uid tid -> updateUserTeamImpl uid tid
      GetRichInfo uid -> getRichInfoImpl uid
      UpsertHashedPassword uid pw -> upsertHashedPasswordImpl uid pw
      LookupHashedPassword uid -> lookupHashedPasswordImpl uid
      GetUserAuthenticationInfo uid -> getUserAuthenticationInfoImpl uid
      DeleteEmail uid -> deleteEmailImpl uid
      SetUserSearchable uid searchable -> setUserSearchableImpl uid searchable
      DeleteServiceUser pid sid bid -> deleteServiceUserImpl pid sid bid
      LookupServiceUsers pid sid mPagingState -> lookupServiceUsersImpl pid sid (paginationStateCassandra =<< mPagingState)
      LookupServiceUsersForTeam pid sid tid mPagingState -> lookupServiceUsersForTeamImpl pid sid tid (paginationStateCassandra =<< mPagingState)

createUserImpl :: NewStoredUser -> Maybe (ConvId, Maybe TeamId) -> Client ()
createUserImpl new mbConv = retry x5 . batch $ do
  setType BatchLogged
  setConsistency LocalQuorum
  addPrepQuery insertUser (asTuple new)
  for_ ((,) <$> new.service <*> mbConv) $ \(sref, (cid, mbTid)) -> do
    let pid = sref ^. serviceRefProvider
        sid = sref ^. serviceRefId
    addPrepQuery insertServiceUser (pid, sid, BotId new.id, cid, mbTid)
    for_ mbTid $ \tid ->
      addPrepQuery insertServiceTeam (pid, sid, BotId new.id, cid, tid)

upsertHashedPasswordImpl :: (MonadClient m) => UserId -> Password -> m ()
upsertHashedPasswordImpl u p = do
  retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u))
  where
    userPasswordUpdate :: PrepQuery W (Password, UserId) ()
    userPasswordUpdate = "UPDATE user SET password = ? WHERE id = ?"

lookupHashedPasswordImpl :: (MonadClient m) => UserId -> m (Maybe Password)
lookupHashedPasswordImpl u =
  (runIdentity =<<)
    <$> retry x1 (query1 selectPassword (params LocalQuorum (Identity u)))
  where
    selectPassword :: PrepQuery R (Identity UserId) (Identity (Maybe Password))
    selectPassword = "SELECT password FROM user WHERE id = ?"

getUserAuthenticationInfoImpl :: UserId -> Client (Maybe (Maybe Password, AccountStatus))
getUserAuthenticationInfoImpl uid = fmap f <$> retry x1 (query1 authSelect (params LocalQuorum (Identity uid)))
  where
    f (pw, st) = (pw, fromMaybe Active st)
    authSelect :: PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus)
    authSelect =
      [sql|
        SELECT password, status FROM user WHERE id = ?
      |]

getUsersImpl :: [UserId] -> Client [StoredUser]
getUsersImpl usrs =
  map asRecord
    <$> retry x1 (query selectUsers (params LocalQuorum (Identity usrs)))

doesUserExistImpl :: UserId -> Client Bool
doesUserExistImpl uid =
  isJust <$> retry x1 (query1 idSelect (params LocalQuorum (Identity uid)))
  where
    idSelect :: PrepQuery R (Identity UserId) (Identity UserId)
    idSelect = "SELECT id FROM user WHERE id = ?"

getIndexUserImpl :: UserId -> Client (Maybe IndexUser)
getIndexUserImpl u = do
  mIndexUserTuple <- retry x1 $ query1 cql (params LocalQuorum (Identity u))
  pure $ indexUserFromTuple <$> mIndexUserTuple
  where
    cql :: PrepQuery R (Identity UserId) (TupleType IndexUser)
    cql = prepared . QueryString $ getIndexUserBaseQuery <> " WHERE id = ?"

getIndexUserPaginatedImpl :: Int32 -> Maybe PagingState -> Client (PageWithState x IndexUser)
getIndexUserPaginatedImpl pageSize mPagingState =
  indexUserFromTuple <$$> paginateWithState cql (paramsPagingState LocalQuorum () pageSize mPagingState) x1
  where
    cql :: PrepQuery R () (TupleType IndexUser)
    cql = prepared $ QueryString getIndexUserBaseQuery

getIndexUserBaseQuery :: LText
getIndexUserBaseQuery =
  [sql|
    SELECT
    id,
    user_type,
    team, writetime(team),
    name, writetime(name),
    status, writetime(status),
    handle, writetime(handle),
    email, writetime(email),
    accent_id, writetime(accent_id),
    activated, writetime(activated),
    service, writetime(service),
    managed_by, writetime(managed_by),
    sso_id, writetime(sso_id),
    email_unvalidated, writetime(email_unvalidated),
    searchable, writetime(searchable),
    writetime(write_time_bumper)
    FROM user
  |]

updateUserImpl :: UserId -> StoredUserUpdate -> Client ()
updateUserImpl uid update =
  retry x5 $ batch do
    -- PERFORMANCE(fisx): if a user changes 4 attributes with one request, the database will
    -- be hit with one request for each attribute.  this is probably fine, since this
    -- operation is not heavily used.  (also, the four operations are batched, which may or
    -- may not help.)
    setType BatchLogged
    setConsistency LocalQuorum
    for_ update.name \n -> addPrepQuery userDisplayNameUpdate (n, uid)
    for_ update.textStatus \s -> addPrepQuery userTextStatusUpdate (s, uid)
    for_ update.pict \p -> addPrepQuery userPictUpdate (p, uid)
    for_ update.assets \a -> addPrepQuery userAssetsUpdate (a, uid)
    for_ update.locale \a -> addPrepQuery userLocaleUpdate (a.lLanguage, a.lCountry, uid)
    for_ update.accentId \c -> addPrepQuery userAccentIdUpdate (c, uid)
    for_ update.supportedProtocols \a -> addPrepQuery userSupportedProtocolsUpdate (a, uid)

updateEmailImpl :: UserId -> EmailAddress -> Client ()
updateEmailImpl u e = retry x5 $ write userEmailUpdate (params LocalQuorum (e, u))
  where
    userEmailUpdate :: PrepQuery W (EmailAddress, UserId) ()
    userEmailUpdate = "UPDATE user SET email = ? WHERE id = ?"

updateEmailUnvalidatedImpl :: UserId -> EmailAddress -> Client ()
updateEmailUnvalidatedImpl u e =
  retry x5 $ write userEmailUnvalidatedUpdate (params LocalQuorum (e, u))
  where
    userEmailUnvalidatedUpdate :: PrepQuery W (EmailAddress, UserId) ()
    userEmailUnvalidatedUpdate = "UPDATE user SET email_unvalidated = ? WHERE id = ?"

deleteEmailUnvalidatedImpl :: UserId -> Client ()
deleteEmailUnvalidatedImpl u = retry x5 $ write userEmailUnvalidatedDelete (params LocalQuorum (Identity u))
  where
    userEmailUnvalidatedDelete :: PrepQuery W (Identity UserId) ()
    userEmailUnvalidatedDelete = "UPDATE user SET email_unvalidated = null WHERE id = ?"

updateUserHandleEitherImpl :: UserId -> StoredUserHandleUpdate -> Client (Either StoredUserUpdateError ())
updateUserHandleEitherImpl uid update =
  runM $ runError do
    claimed <- embed $ claimHandleImpl uid update.old update.new
    unless claimed $ throw StoredUserUpdateHandleExists

updateSSOIdImpl :: UserId -> Maybe UserSSOId -> Client Bool
updateSSOIdImpl u ssoid = do
  mteamid <- getUserTeamImpl u
  case mteamid of
    Just _ -> do
      retry x5 $ write userSSOIdUpdate (params LocalQuorum (ssoid, u))
      pure True
    Nothing -> pure False
  where
    userSSOIdUpdate :: PrepQuery W (Maybe UserSSOId, UserId) ()
    userSSOIdUpdate = "UPDATE user SET sso_id = ? WHERE id = ?"

updateManagedByImpl :: UserId -> ManagedBy -> Client ()
updateManagedByImpl u h = retry x5 $ write userManagedByUpdate (params LocalQuorum (h, u))
  where
    userManagedByUpdate :: PrepQuery W (ManagedBy, UserId) ()
    userManagedByUpdate = "UPDATE user SET managed_by = ? WHERE id = ?"

updateAccountStatusImpl :: UserId -> AccountStatus -> Client ()
updateAccountStatusImpl u s =
  retry x5 $ write userStatusUpdate (params LocalQuorum (s, u))
  where
    userStatusUpdate :: PrepQuery W (AccountStatus, UserId) ()
    userStatusUpdate = "UPDATE user SET status = ? WHERE id = ?"

activateUserImpl :: (MonadClient m) => UserId -> UserIdentity -> m ()
activateUserImpl u ident = do
  let email = emailIdentity ident
  retry x5 $ write userActivatedUpdate (params LocalQuorum (email, u))
  where
    userActivatedUpdate :: PrepQuery W (Maybe EmailAddress, UserId) ()
    userActivatedUpdate = "UPDATE user SET activated = true, email = ? WHERE id = ?"

deactivateUserImpl :: (MonadClient m) => UserId -> m ()
deactivateUserImpl u =
  retry x5 $ write userDeactivatedUpdate (params LocalQuorum (Identity u))
  where
    userDeactivatedUpdate :: PrepQuery W (Identity UserId) ()
    userDeactivatedUpdate = "UPDATE user SET activated = false WHERE id = ?"

lookupNameImpl :: (MonadClient m) => UserId -> m (Maybe Name)
lookupNameImpl u =
  fmap runIdentity
    <$> retry x1 (query1 nameSelect (params LocalQuorum (Identity u)))
  where
    nameSelect :: PrepQuery R (Identity UserId) (Identity Name)
    nameSelect = "SELECT name FROM user WHERE id = ?"

lookupFeatureConferenceCallingImpl :: (MonadClient m) => UserId -> m (Maybe FeatureStatus)
lookupFeatureConferenceCallingImpl uid = do
  let q = query1 select (params LocalQuorum (Identity uid))
  (>>= runIdentity) <$> retry x1 q
  where
    select :: PrepQuery R (Identity UserId) (Identity (Maybe FeatureStatus))
    select = fromString "select feature_conference_calling from user where id = ?"

-------------------------------------------------------------------------------
-- Queries

updateRichInfoImpl :: (MonadClient m) => UserId -> RichInfoAssocList -> m ()
updateRichInfoImpl u ri = retry x5 $ write userRichInfoUpdate (params LocalQuorum (ri, u))
  where
    userRichInfoUpdate :: PrepQuery W (RichInfoAssocList, UserId) ()
    userRichInfoUpdate = "UPDATE rich_info SET json = ? WHERE user = ?"

updateFeatureConferenceCallingImpl :: (MonadClient m) => UserId -> Maybe FeatureStatus -> m ()
updateFeatureConferenceCallingImpl uid mStatus =
  retry x5 $ write update (params LocalQuorum (mStatus, uid))
  where
    update :: PrepQuery W (Maybe FeatureStatus, UserId) ()
    update = fromString "update user set feature_conference_calling = ? where id = ?"

-- | Claim a new handle for an existing 'User': validate it, and in case of success, assign it
-- to user and mark it as taken.
claimHandleImpl :: UserId -> Maybe Handle -> Handle -> Client Bool
claimHandleImpl uid oldHandle newHandle =
  isJust <$> do
    owner <- lookupHandleImpl LocalQuorum newHandle
    case owner of
      Just uid' | uid /= uid' -> pure Nothing
      _ -> do
        let key = "@" <> fromHandle newHandle
        withClaim uid key (30 # Minute) $
          do
            -- Record ownership
            retry x5 $ write handleInsert (params LocalQuorum (newHandle, uid))
            -- Update profile
            result <- updateHandle uid newHandle
            -- Free old handle (if it changed)
            for_ (mfilter (/= newHandle) oldHandle) $
              freeHandleImpl uid
            pure result
  where
    updateHandle :: UserId -> Handle -> Client ()
    updateHandle u h = retry x5 $ write userHandleUpdate (params LocalQuorum (h, u))

-- | Free a 'Handle', making it available to be claimed again.
freeHandleImpl :: UserId -> Handle -> Client ()
freeHandleImpl uid h = do
  mbHandleUid <- lookupHandleImpl LocalQuorum h
  case mbHandleUid of
    Just handleUid | handleUid == uid -> do
      retry x5 $ write handleDelete (params LocalQuorum (Identity h))
      let key = "@" <> fromHandle h
      deleteClaim uid key (30 # Minute)
    _ -> pure () -- this shouldn't happen, the call side should always check that `h` and `uid` belong to the same account.

-- | Sending an empty 'Handle' here causes C* to throw "Key may not be empty"
-- error.
lookupHandleImpl :: Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl consistencyLevel h = do
  (runIdentity =<<)
    <$> retry x1 (query1 handleSelect (params consistencyLevel (Identity h)))

deleteUserImpl :: User -> Client ()
deleteUserImpl user = do
  for_ (userHandle user) \h ->
    freeHandleImpl (userId user) h
  retry x5 $
    write
      updateUserToTombstone
      ( params
          LocalQuorum
          (Deleted, Name "default", defaultAccentId, noPict, [], userId user)
      )

lookupStatusImpl :: UserId -> Client (Maybe AccountStatus)
lookupStatusImpl u =
  (runIdentity =<<)
    <$> retry x1 (query1 statusSelect (params LocalQuorum (Identity u)))

isActivatedImpl :: UserId -> Client Bool
isActivatedImpl uid =
  (== Just (Identity True))
    <$> retry x1 (query1 activatedSelect (params LocalQuorum (Identity uid)))

lookupLocaleImpl :: UserId -> Client (Maybe (Maybe Language, Maybe Country))
lookupLocaleImpl u = do
  retry x1 (query1 localeSelect (params LocalQuorum (Identity u)))

getUserTeamImpl :: UserId -> Client (Maybe TeamId)
getUserTeamImpl u = (runIdentity =<<) <$> retry x1 (query1 q (params LocalQuorum (Identity u)))
  where
    q :: PrepQuery R (Identity UserId) (Identity (Maybe TeamId))
    q = "SELECT team FROM user WHERE id = ?"

updateUserTeamImpl :: UserId -> TeamId -> Client ()
updateUserTeamImpl u t = retry x5 $ write userTeamUpdate (params LocalQuorum (t, u))
  where
    userTeamUpdate :: PrepQuery W (TeamId, UserId) ()
    userTeamUpdate = "UPDATE user SET team = ? WHERE id = ?"

getRichInfoImpl :: UserId -> Client (Maybe RichInfoAssocList)
getRichInfoImpl uid =
  fmap runIdentity
    <$> retry x1 (query1 q (params LocalQuorum (Identity uid)))
  where
    q :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
    q = "SELECT json FROM rich_info WHERE user = ?"

deleteEmailImpl :: UserId -> Client ()
deleteEmailImpl u = retry x5 $ write userEmailDelete (params LocalQuorum (Identity u))

setUserSearchableImpl :: UserId -> SetSearchable -> Client ()
setUserSearchableImpl uid (SetSearchable searchable) = retry x5 $ write q (params LocalQuorum (searchable, uid))
  where
    q :: PrepQuery W (Bool, UserId) ()
    q = "UPDATE user SET searchable = ? WHERE id = ?"

deleteServiceUserImpl :: ProviderId -> ServiceId -> BotId -> Client ()
deleteServiceUserImpl pid sid bid = do
  lookupServiceUser pid sid bid >>= \case
    Nothing -> pure ()
    Just (_, mbTid) -> retry x5 . batch $ do
      setType BatchLogged
      setConsistency LocalQuorum
      addPrepQuery cql (pid, sid, bid)
      for_ mbTid $ \tid ->
        addPrepQuery cqlTeam (pid, sid, tid, bid)
  where
    cql :: PrepQuery W (ProviderId, ServiceId, BotId) ()
    cql =
      "DELETE FROM service_user \
      \WHERE provider = ? AND service = ? AND user = ?"
    cqlTeam :: PrepQuery W (ProviderId, ServiceId, TeamId, BotId) ()
    cqlTeam =
      "DELETE FROM service_team \
      \WHERE provider = ? AND service = ? AND team = ? AND user = ?"

lookupServiceUser ::
  ProviderId ->
  ServiceId ->
  BotId ->
  Client (Maybe (ConvId, Maybe TeamId))
lookupServiceUser pid sid bid =
  retry x1 (query1 cql (params LocalQuorum (pid, sid, bid)))
  where
    cql :: PrepQuery R (ProviderId, ServiceId, BotId) (ConvId, Maybe TeamId)
    cql =
      "SELECT conv, team FROM service_user \
      \WHERE provider = ? AND service = ? AND user = ?"

lookupServiceUsersImpl ::
  ProviderId ->
  ServiceId ->
  Maybe PagingState ->
  Client (PageWithState x (BotId, ConvId, Maybe TeamId))
lookupServiceUsersImpl pid sid mPagingState =
  paginateWithState cql (paramsPagingState LocalQuorum (pid, sid) 100 mPagingState) x1
  where
    cql :: PrepQuery R (ProviderId, ServiceId) (BotId, ConvId, Maybe TeamId)
    cql =
      "SELECT user, conv, team FROM service_user \
      \WHERE provider = ? AND service = ?"

lookupServiceUsersForTeamImpl ::
  ProviderId ->
  ServiceId ->
  TeamId ->
  Maybe PagingState ->
  Client (PageWithState x (BotId, ConvId))
lookupServiceUsersForTeamImpl pid sid tid mPagingState =
  paginateWithState cql (paramsPagingState LocalQuorum (pid, sid, tid) 100 mPagingState) x1
  where
    cql :: PrepQuery R (ProviderId, ServiceId, TeamId) (BotId, ConvId)
    cql =
      "SELECT user, conv FROM service_team \
      \WHERE provider = ? AND service = ? AND team = ?"

--------------------------------------------------------------------------------
-- Queries

insertUser :: PrepQuery W (TupleType NewStoredUser) ()
insertUser =
  "INSERT INTO user (id, user_type, name, text_status, picture, assets, email, sso_id, \
  \accent_id, password, activated, status, expires, language, \
  \country, provider, service, handle, team, managed_by, supported_protocols, searchable) \
  \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"

insertServiceUser :: PrepQuery W (ProviderId, ServiceId, BotId, ConvId, Maybe TeamId) ()
insertServiceUser =
  "INSERT INTO service_user (provider, service, user, conv, team) \
  \VALUES (?, ?, ?, ?, ?)"

insertServiceTeam :: PrepQuery W (ProviderId, ServiceId, BotId, ConvId, TeamId) ()
insertServiceTeam =
  "INSERT INTO service_team (provider, service, user, conv, team) \
  \VALUES (?, ?, ?, ?, ?)"

selectUsers :: PrepQuery R (Identity [UserId]) (TupleType StoredUser)
selectUsers =
  [sql|
  SELECT id, user_type, name, text_status, picture, email, email_unvalidated, sso_id, accent_id, assets,
  activated, status, expires, language, country, provider,
  service, handle, team, managed_by, supported_protocols, searchable
  FROM user WHERE id IN ?
  |]

userDisplayNameUpdate :: PrepQuery W (Name, UserId) ()
userDisplayNameUpdate = "UPDATE user SET name = ? WHERE id = ?"

userTextStatusUpdate :: PrepQuery W (TextStatus, UserId) ()
userTextStatusUpdate = "UPDATE user SET text_status = ? WHERE id = ?"

userPictUpdate :: PrepQuery W (Pict, UserId) ()
userPictUpdate = "UPDATE user SET picture = ? WHERE id = ?"

userAssetsUpdate :: PrepQuery W ([Asset], UserId) ()
userAssetsUpdate = "UPDATE user SET assets = ? WHERE id = ?"

userAccentIdUpdate :: PrepQuery W (ColourId, UserId) ()
userAccentIdUpdate = "UPDATE user SET accent_id = ? WHERE id = ?"

userLocaleUpdate :: PrepQuery W (Language, Maybe Country, UserId) ()
userLocaleUpdate = "UPDATE user SET language = ?, country = ? WHERE id = ?"

userSupportedProtocolsUpdate :: PrepQuery W (Imports.Set BaseProtocolTag, UserId) ()
userSupportedProtocolsUpdate = "UPDATE user SET supported_protocols = ? WHERE id = ?"

handleInsert :: PrepQuery W (Handle, UserId) ()
handleInsert = "INSERT INTO user_handle (handle, user) VALUES (?, ?)"

handleSelect :: PrepQuery R (Identity Handle) (Identity (Maybe UserId))
handleSelect = "SELECT user FROM user_handle WHERE handle = ?"

handleDelete :: PrepQuery W (Identity Handle) ()
handleDelete = "DELETE FROM user_handle WHERE handle = ?"

userHandleUpdate :: PrepQuery W (Handle, UserId) ()
userHandleUpdate = "UPDATE user SET handle = ? WHERE id = ?"

updateUserToTombstone :: PrepQuery W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
updateUserToTombstone =
  "UPDATE user SET status = ?, name = ?,\
  \ accent_id = ?, picture = ?, assets = ?, handle = null, country = null,\
  \ language = null, email = null, sso_id = null WHERE id = ?"

statusSelect :: PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus))
statusSelect = "SELECT status FROM user WHERE id = ?"

activatedSelect :: PrepQuery R (Identity UserId) (Identity Bool)
activatedSelect = "SELECT activated FROM user WHERE id = ?"

localeSelect :: PrepQuery R (Identity UserId) (Maybe Language, Maybe Country)
localeSelect = "SELECT language, country FROM user WHERE id = ?"

userEmailDelete :: PrepQuery W (Identity UserId) ()
userEmailDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = null, write_time_bumper = 0 WHERE id = ?"
