module Wire.UserStore.Cassandra (interpretUserStoreCassandra) where

import Cassandra
import Cassandra.Exec (prepared)
import Data.Handle
import Data.Id
import Data.Time.Clock
import Database.CQL.Protocol
import Imports
import Polysemy
import Polysemy.Embed
import Polysemy.Error
import Wire.API.Password (Password)
import Wire.API.User hiding (DeleteUser)
import Wire.API.User.RichInfo
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 :: forall (r :: EffectRow).
Member (Embed IO) r =>
ClientState -> InterpreterFor UserStore r
interpretUserStoreCassandra ClientState
casClient =
  (forall (rInitial :: EffectRow) x.
 UserStore (Sem rInitial) x -> Sem r x)
-> Sem (UserStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  UserStore (Sem rInitial) x -> Sem r x)
 -> Sem (UserStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    UserStore (Sem rInitial) x -> Sem r x)
-> Sem (UserStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
    (forall x. Client x -> IO x) -> Sem (Embed Client : r) x -> Sem r x
forall (m1 :: * -> *) (m2 :: * -> *) (r :: EffectRow) a.
Member (Embed m2) r =>
(forall x. m1 x -> m2 x) -> Sem (Embed m1 : r) a -> Sem r a
runEmbedded (ClientState -> Client x -> IO x
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
casClient) (Sem (Embed Client : r) x -> Sem r x)
-> (UserStore (Sem rInitial) x -> Sem (Embed Client : r) x)
-> UserStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client x -> Sem (Embed Client : r) x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Client x -> Sem (Embed Client : r) x)
-> (UserStore (Sem rInitial) x -> Client x)
-> UserStore (Sem rInitial) x
-> Sem (Embed Client : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      GetUsers [UserId]
uids -> [UserId] -> Client [StoredUser]
getUsersImpl [UserId]
uids
      GetIndexUser UserId
uid -> UserId -> Client (Maybe IndexUser)
getIndexUserImpl UserId
uid
      GetIndexUsersPaginated Int32
pageSize Maybe PagingState
mPagingState -> Int32 -> Maybe PagingState -> Client (PageWithState IndexUser)
getIndexUserPaginatedImpl Int32
pageSize Maybe PagingState
mPagingState
      UpdateUser UserId
uid StoredUserUpdate
update -> UserId -> StoredUserUpdate -> Client ()
updateUserImpl UserId
uid StoredUserUpdate
update
      UpdateUserHandleEither UserId
uid StoredUserHandleUpdate
update -> UserId
-> StoredUserHandleUpdate
-> Client (Either StoredUserUpdateError ())
updateUserHandleEitherImpl UserId
uid StoredUserHandleUpdate
update
      DeleteUser User
user -> User -> Client ()
deleteUserImpl User
user
      LookupHandle Handle
hdl -> Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl Consistency
LocalQuorum Handle
hdl
      GlimpseHandle Handle
hdl -> Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl Consistency
One Handle
hdl
      LookupStatus UserId
uid -> UserId -> Client (Maybe AccountStatus)
lookupStatusImpl UserId
uid
      IsActivated UserId
uid -> UserId -> Client Bool
isActivatedImpl UserId
uid
      LookupLocale UserId
uid -> UserId -> Client (Maybe (Maybe Language, Maybe Country))
lookupLocaleImpl UserId
uid
      UpdateUserTeam UserId
uid TeamId
tid -> UserId -> TeamId -> Client ()
updateUserTeamImpl UserId
uid TeamId
tid
      GetActivityTimestamps UserId
uid -> UserId -> Client [Maybe UTCTime]
getActivityTimestampsImpl UserId
uid
      GetRichInfo UserId
uid -> UserId -> Client (Maybe RichInfoAssocList)
getRichInfoImpl UserId
uid
      GetUserAuthenticationInfo UserId
uid -> UserId -> Client (Maybe (Maybe Password, AccountStatus))
getUserAuthenticationInfoImpl UserId
uid

getUserAuthenticationInfoImpl :: UserId -> Client (Maybe (Maybe Password, AccountStatus))
getUserAuthenticationInfoImpl :: UserId -> Client (Maybe (Maybe Password, AccountStatus))
getUserAuthenticationInfoImpl UserId
uid = ((Maybe Password, Maybe AccountStatus)
 -> (Maybe Password, AccountStatus))
-> Maybe (Maybe Password, Maybe AccountStatus)
-> Maybe (Maybe Password, AccountStatus)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Password, Maybe AccountStatus)
-> (Maybe Password, AccountStatus)
forall {a}. (a, Maybe AccountStatus) -> (a, AccountStatus)
f (Maybe (Maybe Password, Maybe AccountStatus)
 -> Maybe (Maybe Password, AccountStatus))
-> Client (Maybe (Maybe Password, Maybe AccountStatus))
-> Client (Maybe (Maybe Password, AccountStatus))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Maybe Password, Maybe AccountStatus))
-> Client (Maybe (Maybe Password, Maybe AccountStatus))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus)
-> QueryParams (Identity UserId)
-> Client (Maybe (Maybe Password, Maybe AccountStatus))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus)
authSelect (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))
  where
    f :: (a, Maybe AccountStatus) -> (a, AccountStatus)
f (a
pw, Maybe AccountStatus
st) = (a
pw, AccountStatus -> Maybe AccountStatus -> AccountStatus
forall a. a -> Maybe a -> a
fromMaybe AccountStatus
Active Maybe AccountStatus
st)
    authSelect :: PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus)
    authSelect :: PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus)
authSelect =
      [sql|
        SELECT password, status FROM user WHERE id = ?
      |]

getUsersImpl :: [UserId] -> Client [StoredUser]
getUsersImpl :: [UserId] -> Client [StoredUser]
getUsersImpl [UserId]
usrs =
  ((UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
  Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
  Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
  Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
  Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))
 -> StoredUser)
-> [(UserId, Name, Maybe TextStatus, Maybe Pict,
     Maybe EmailAddress, Maybe EmailAddress, Maybe UserSSOId, ColourId,
     Maybe [Asset], Bool, Maybe AccountStatus, Maybe UTCTimeMillis,
     Maybe Language, Maybe Country, Maybe ProviderId, Maybe ServiceId,
     Maybe Handle, Maybe TeamId, Maybe ManagedBy,
     Maybe (Set BaseProtocolTag))]
-> [StoredUser]
forall a b. (a -> b) -> [a] -> [b]
map (UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
 Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
 Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
 Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
 Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))
-> StoredUser
TupleType StoredUser -> StoredUser
forall a. Record a => TupleType a -> a
asRecord
    ([(UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
   Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
   Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
   Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
   Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))]
 -> [StoredUser])
-> Client
     [(UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
       Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
       Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
       Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
       Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))]
-> Client [StoredUser]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client
     [(UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
       Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
       Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
       Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
       Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))]
-> Client
     [(UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
       Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
       Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
       Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
       Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
  R
  (Identity [UserId])
  (UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
   Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
   Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
   Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
   Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))
-> QueryParams (Identity [UserId])
-> Client
     [(UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
       Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
       Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
       Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
       Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery
  R
  (Identity [UserId])
  (UserId, Name, Maybe TextStatus, Maybe Pict, Maybe EmailAddress,
   Maybe EmailAddress, Maybe UserSSOId, ColourId, Maybe [Asset], Bool,
   Maybe AccountStatus, Maybe UTCTimeMillis, Maybe Language,
   Maybe Country, Maybe ProviderId, Maybe ServiceId, Maybe Handle,
   Maybe TeamId, Maybe ManagedBy, Maybe (Set BaseProtocolTag))
PrepQuery R (Identity [UserId]) (TupleType StoredUser)
selectUsers (Consistency -> Identity [UserId] -> QueryParams (Identity [UserId])
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum ([UserId] -> Identity [UserId]
forall a. a -> Identity a
Identity [UserId]
usrs)))

getIndexUserImpl :: UserId -> Client (Maybe IndexUser)
getIndexUserImpl :: UserId -> Client (Maybe IndexUser)
getIndexUserImpl UserId
u = do
  Maybe
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
mIndexUserTuple <- RetrySettings
-> Client
     (Maybe
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
-> Client
     (Maybe
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (Client
   (Maybe
      (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
       Writetime Name, Maybe AccountStatus,
       Maybe (Writetime AccountStatus), Maybe Handle,
       Maybe (Writetime Handle), Maybe EmailAddress,
       Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
       Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
       Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
       Maybe (Writetime UserSSOId), Maybe EmailAddress,
       Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
 -> Client
      (Maybe
         (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
          Writetime Name, Maybe AccountStatus,
          Maybe (Writetime AccountStatus), Maybe Handle,
          Maybe (Writetime Handle), Maybe EmailAddress,
          Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
          Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
          Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
          Maybe (Writetime UserSSOId), Maybe EmailAddress,
          Maybe (Writetime EmailAddress),
          Maybe (Writetime WriteTimeBumper))))
-> Client
     (Maybe
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
-> Client
     (Maybe
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
forall a b. (a -> b) -> a -> b
$ PrepQuery
  R
  (Identity UserId)
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> QueryParams (Identity UserId)
-> Client
     (Maybe
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery
  R
  (Identity UserId)
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
PrepQuery R (Identity UserId) (TupleType IndexUser)
cql (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
u))
  Maybe IndexUser -> Client (Maybe IndexUser)
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IndexUser -> Client (Maybe IndexUser))
-> Maybe IndexUser -> Client (Maybe IndexUser)
forall a b. (a -> b) -> a -> b
$ (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
 Writetime Name, Maybe AccountStatus,
 Maybe (Writetime AccountStatus), Maybe Handle,
 Maybe (Writetime Handle), Maybe EmailAddress,
 Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
 Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
 Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
 Maybe (Writetime UserSSOId), Maybe EmailAddress,
 Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> IndexUser
TupleType IndexUser -> IndexUser
forall a. Record a => TupleType a -> a
asRecord ((UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
  Writetime Name, Maybe AccountStatus,
  Maybe (Writetime AccountStatus), Maybe Handle,
  Maybe (Writetime Handle), Maybe EmailAddress,
  Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
  Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
  Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
  Maybe (Writetime UserSSOId), Maybe EmailAddress,
  Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
 -> IndexUser)
-> Maybe
     (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
      Writetime Name, Maybe AccountStatus,
      Maybe (Writetime AccountStatus), Maybe Handle,
      Maybe (Writetime Handle), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
      Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
      Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
      Maybe (Writetime UserSSOId), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> Maybe IndexUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
mIndexUserTuple
  where
    cql :: PrepQuery R (Identity UserId) (TupleType IndexUser)
    cql :: PrepQuery R (Identity UserId) (TupleType IndexUser)
cql = QueryString
  R
  (Identity UserId)
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> PrepQuery
     R
     (Identity UserId)
     (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
      Writetime Name, Maybe AccountStatus,
      Maybe (Writetime AccountStatus), Maybe Handle,
      Maybe (Writetime Handle), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
      Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
      Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
      Maybe (Writetime UserSSOId), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
QueryString
  R
  (Identity UserId)
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> PrepQuery R (Identity UserId) (TupleType IndexUser)
forall k a b. QueryString k a b -> PrepQuery k a b
prepared (QueryString
   R
   (Identity UserId)
   (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
    Writetime Name, Maybe AccountStatus,
    Maybe (Writetime AccountStatus), Maybe Handle,
    Maybe (Writetime Handle), Maybe EmailAddress,
    Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
    Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
    Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
    Maybe (Writetime UserSSOId), Maybe EmailAddress,
    Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
 -> PrepQuery R (Identity UserId) (TupleType IndexUser))
-> (LText
    -> QueryString
         R
         (Identity UserId)
         (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
          Writetime Name, Maybe AccountStatus,
          Maybe (Writetime AccountStatus), Maybe Handle,
          Maybe (Writetime Handle), Maybe EmailAddress,
          Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
          Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
          Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
          Maybe (Writetime UserSSOId), Maybe EmailAddress,
          Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
-> LText
-> PrepQuery R (Identity UserId) (TupleType IndexUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LText
-> QueryString
     R
     (Identity UserId)
     (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
      Writetime Name, Maybe AccountStatus,
      Maybe (Writetime AccountStatus), Maybe Handle,
      Maybe (Writetime Handle), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
      Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
      Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
      Maybe (Writetime UserSSOId), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
forall k a b. LText -> QueryString k a b
QueryString (LText -> PrepQuery R (Identity UserId) (TupleType IndexUser))
-> LText -> PrepQuery R (Identity UserId) (TupleType IndexUser)
forall a b. (a -> b) -> a -> b
$ LText
getIndexUserBaseQuery LText -> LText -> LText
forall a. Semigroup a => a -> a -> a
<> LText
" WHERE id = ?"

getIndexUserPaginatedImpl :: Int32 -> Maybe PagingState -> Client (PageWithState IndexUser)
getIndexUserPaginatedImpl :: Int32 -> Maybe PagingState -> Client (PageWithState IndexUser)
getIndexUserPaginatedImpl Int32
pageSize Maybe PagingState
mPagingState =
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
 Writetime Name, Maybe AccountStatus,
 Maybe (Writetime AccountStatus), Maybe Handle,
 Maybe (Writetime Handle), Maybe EmailAddress,
 Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
 Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
 Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
 Maybe (Writetime UserSSOId), Maybe EmailAddress,
 Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> IndexUser
TupleType IndexUser -> IndexUser
forall a. Record a => TupleType a -> a
asRecord ((UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
  Writetime Name, Maybe AccountStatus,
  Maybe (Writetime AccountStatus), Maybe Handle,
  Maybe (Writetime Handle), Maybe EmailAddress,
  Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
  Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
  Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
  Maybe (Writetime UserSSOId), Maybe EmailAddress,
  Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
 -> IndexUser)
-> Client
     (PageWithState
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
-> Client (PageWithState IndexUser)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> PrepQuery
  R
  ()
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
-> QueryParams ()
-> Client
     (PageWithState
        (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
         Writetime Name, Maybe AccountStatus,
         Maybe (Writetime AccountStatus), Maybe Handle,
         Maybe (Writetime Handle), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
         Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
         Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
         Maybe (Writetime UserSSOId), Maybe EmailAddress,
         Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper)))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (PageWithState b)
paginateWithState PrepQuery
  R
  ()
  (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
   Writetime Name, Maybe AccountStatus,
   Maybe (Writetime AccountStatus), Maybe Handle,
   Maybe (Writetime Handle), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
   Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
   Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
   Maybe (Writetime UserSSOId), Maybe EmailAddress,
   Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
PrepQuery R () (TupleType IndexUser)
cql (Consistency -> () -> Int32 -> Maybe PagingState -> QueryParams ()
forall a.
Consistency -> a -> Int32 -> Maybe PagingState -> QueryParams a
paramsPagingState Consistency
LocalQuorum () Int32
pageSize Maybe PagingState
mPagingState)
  where
    cql :: PrepQuery R () (TupleType IndexUser)
    cql :: PrepQuery R () (TupleType IndexUser)
cql = QueryString R () (TupleType IndexUser)
-> PrepQuery R () (TupleType IndexUser)
forall k a b. QueryString k a b -> PrepQuery k a b
prepared (QueryString R () (TupleType IndexUser)
 -> PrepQuery R () (TupleType IndexUser))
-> QueryString R () (TupleType IndexUser)
-> PrepQuery R () (TupleType IndexUser)
forall a b. (a -> b) -> a -> b
$ LText
-> QueryString
     R
     ()
     (UserId, Maybe TeamId, Maybe (Writetime TeamId), Name,
      Writetime Name, Maybe AccountStatus,
      Maybe (Writetime AccountStatus), Maybe Handle,
      Maybe (Writetime Handle), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), ColourId, Writetime ColourId, Bool,
      Writetime Bool, Maybe ServiceId, Maybe (Writetime ServiceId),
      Maybe ManagedBy, Maybe (Writetime ManagedBy), Maybe UserSSOId,
      Maybe (Writetime UserSSOId), Maybe EmailAddress,
      Maybe (Writetime EmailAddress), Maybe (Writetime WriteTimeBumper))
forall k a b. LText -> QueryString k a b
QueryString LText
getIndexUserBaseQuery

getIndexUserBaseQuery :: LText
getIndexUserBaseQuery :: LText
getIndexUserBaseQuery =
  [sql|
    SELECT
    id,
    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),
    writetime(write_time_bumper)
    FROM user
  |]

updateUserImpl :: UserId -> StoredUserUpdate -> Client ()
updateUserImpl :: UserId -> StoredUserUpdate -> Client ()
updateUserImpl UserId
uid StoredUserUpdate
update =
  RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ BatchM () -> Client ()
forall (m :: * -> *). MonadClient m => BatchM () -> m ()
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.)
    BatchType -> BatchM ()
setType BatchType
BatchLogged
    Consistency -> BatchM ()
setConsistency Consistency
LocalQuorum
    Maybe Name -> (Name -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.name \Name
n -> PrepQuery W (Name, UserId) () -> (Name, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Name, UserId) ()
userDisplayNameUpdate (Name
n, UserId
uid)
    Maybe TextStatus -> (TextStatus -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.textStatus \TextStatus
s -> PrepQuery W (TextStatus, UserId) ()
-> (TextStatus, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (TextStatus, UserId) ()
userTextStatusUpdate (TextStatus
s, UserId
uid)
    Maybe Pict -> (Pict -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.pict \Pict
p -> PrepQuery W (Pict, UserId) () -> (Pict, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Pict, UserId) ()
userPictUpdate (Pict
p, UserId
uid)
    Maybe [Asset] -> ([Asset] -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.assets \[Asset]
a -> PrepQuery W ([Asset], UserId) () -> ([Asset], UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W ([Asset], UserId) ()
userAssetsUpdate ([Asset]
a, UserId
uid)
    Maybe Locale -> (Locale -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.locale \Locale
a -> PrepQuery W (Language, Maybe Country, UserId) ()
-> (Language, Maybe Country, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Language, Maybe Country, UserId) ()
userLocaleUpdate (Locale
a.lLanguage, Locale
a.lCountry, UserId
uid)
    Maybe ColourId -> (ColourId -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.accentId \ColourId
c -> PrepQuery W (ColourId, UserId) ()
-> (ColourId, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (ColourId, UserId) ()
userAccentIdUpdate (ColourId
c, UserId
uid)
    Maybe (Set BaseProtocolTag)
-> (Set BaseProtocolTag -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ StoredUserUpdate
update.supportedProtocols \Set BaseProtocolTag
a -> PrepQuery W (Set BaseProtocolTag, UserId) ()
-> (Set BaseProtocolTag, UserId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Set BaseProtocolTag, UserId) ()
userSupportedProtocolsUpdate (Set BaseProtocolTag
a, UserId
uid)

updateUserHandleEitherImpl :: UserId -> StoredUserHandleUpdate -> Client (Either StoredUserUpdateError ())
updateUserHandleEitherImpl :: UserId
-> StoredUserHandleUpdate
-> Client (Either StoredUserUpdateError ())
updateUserHandleEitherImpl UserId
uid StoredUserHandleUpdate
update =
  Sem '[Embed Client] (Either StoredUserUpdateError ())
-> Client (Either StoredUserUpdateError ())
forall (m :: * -> *) a. Monad m => Sem '[Embed m] a -> m a
runM (Sem '[Embed Client] (Either StoredUserUpdateError ())
 -> Client (Either StoredUserUpdateError ()))
-> Sem '[Embed Client] (Either StoredUserUpdateError ())
-> Client (Either StoredUserUpdateError ())
forall a b. (a -> b) -> a -> b
$ Sem '[Error StoredUserUpdateError, Embed Client] ()
-> Sem '[Embed Client] (Either StoredUserUpdateError ())
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError do
    Bool
claimed <- Client Bool
-> Sem '[Error StoredUserUpdateError, Embed Client] Bool
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Client Bool
 -> Sem '[Error StoredUserUpdateError, Embed Client] Bool)
-> Client Bool
-> Sem '[Error StoredUserUpdateError, Embed Client] Bool
forall a b. (a -> b) -> a -> b
$ UserId -> Maybe Handle -> Handle -> Client Bool
claimHandleImpl UserId
uid StoredUserHandleUpdate
update.old StoredUserHandleUpdate
update.new
    Bool
-> Sem '[Error StoredUserUpdateError, Embed Client] ()
-> Sem '[Error StoredUserUpdateError, Embed Client] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
claimed (Sem '[Error StoredUserUpdateError, Embed Client] ()
 -> Sem '[Error StoredUserUpdateError, Embed Client] ())
-> Sem '[Error StoredUserUpdateError, Embed Client] ()
-> Sem '[Error StoredUserUpdateError, Embed Client] ()
forall a b. (a -> b) -> a -> b
$ StoredUserUpdateError
-> Sem '[Error StoredUserUpdateError, Embed Client] ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw StoredUserUpdateError
StoredUserUpdateHandleExists

-- | 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 :: UserId -> Maybe Handle -> Handle -> Client Bool
claimHandleImpl UserId
uid Maybe Handle
oldHandle Handle
newHandle =
  Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Client (Maybe ()) -> Client Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Maybe UserId
owner <- Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl Consistency
LocalQuorum Handle
newHandle
    case Maybe UserId
owner of
      Just UserId
uid' | UserId
uid UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
uid' -> Maybe () -> Client (Maybe ())
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ()
forall a. Maybe a
Nothing
      Maybe UserId
_ -> do
        let key :: Text
key = Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Handle -> Text
fromHandle Handle
newHandle
        UserId -> Text -> Timeout -> Client () -> Client (Maybe ())
forall {k} (a :: k) b.
Id a -> Text -> Timeout -> Client b -> Client (Maybe b)
withClaim UserId
uid Text
key (Word64
30 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Minute) (Client () -> Client (Maybe ())) -> Client () -> Client (Maybe ())
forall a b. (a -> b) -> a -> b
$
          do
            -- Record ownership
            RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Handle, UserId) ()
-> QueryParams (Handle, UserId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Handle, UserId) ()
handleInsert (Consistency -> (Handle, UserId) -> QueryParams (Handle, UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Handle
newHandle, UserId
uid))
            -- Update profile
            ()
result <- UserId -> Handle -> Client ()
updateHandle UserId
uid Handle
newHandle
            -- Free old handle (if it changed)
            Maybe Handle -> (Handle -> Client ()) -> Client ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((Handle -> Bool) -> Maybe Handle -> Maybe Handle
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
newHandle) Maybe Handle
oldHandle) ((Handle -> Client ()) -> Client ())
-> (Handle -> Client ()) -> Client ()
forall a b. (a -> b) -> a -> b
$
              UserId -> Handle -> Client ()
freeHandleImpl UserId
uid
            () -> Client ()
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
result
  where
    updateHandle :: UserId -> Handle -> Client ()
    updateHandle :: UserId -> Handle -> Client ()
updateHandle UserId
u Handle
h = RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Handle, UserId) ()
-> QueryParams (Handle, UserId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Handle, UserId) ()
userHandleUpdate (Consistency -> (Handle, UserId) -> QueryParams (Handle, UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Handle
h, UserId
u))

-- | Free a 'Handle', making it available to be claimed again.
freeHandleImpl :: UserId -> Handle -> Client ()
freeHandleImpl :: UserId -> Handle -> Client ()
freeHandleImpl UserId
uid Handle
h = do
  Maybe UserId
mbHandleUid <- Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl Consistency
LocalQuorum Handle
h
  case Maybe UserId
mbHandleUid of
    Just UserId
handleUid | UserId
handleUid UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId
uid -> do
      RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Identity Handle) ()
-> QueryParams (Identity Handle) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity Handle) ()
handleDelete (Consistency -> Identity Handle -> QueryParams (Identity Handle)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Handle -> Identity Handle
forall a. a -> Identity a
Identity Handle
h))
      let key :: Text
key = Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Handle -> Text
fromHandle Handle
h
      UserId -> Text -> Timeout -> Client ()
forall {k} (a :: k). Id a -> Text -> Timeout -> Client ()
deleteClaim UserId
uid Text
key (Word64
30 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Minute)
    Maybe UserId
_ -> () -> Client ()
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: Consistency -> Handle -> Client (Maybe UserId)
lookupHandleImpl Consistency
consistencyLevel Handle
h = do
  (Identity (Maybe UserId) -> Maybe UserId
forall a. Identity a -> a
runIdentity =<<)
    (Maybe (Identity (Maybe UserId)) -> Maybe UserId)
-> Client (Maybe (Identity (Maybe UserId)))
-> Client (Maybe UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Identity (Maybe UserId)))
-> Client (Maybe (Identity (Maybe UserId)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity Handle) (Identity (Maybe UserId))
-> QueryParams (Identity Handle)
-> Client (Maybe (Identity (Maybe UserId)))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity Handle) (Identity (Maybe UserId))
handleSelect (Consistency -> Identity Handle -> QueryParams (Identity Handle)
forall a. Consistency -> a -> QueryParams a
params Consistency
consistencyLevel (Handle -> Identity Handle
forall a. a -> Identity a
Identity Handle
h)))

deleteUserImpl :: User -> Client ()
deleteUserImpl :: User -> Client ()
deleteUserImpl User
user = do
  Maybe Handle -> (Handle -> Client ()) -> Client ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (User -> Maybe Handle
userHandle User
user) \Handle
h ->
    UserId -> Handle -> Client ()
freeHandleImpl (User -> UserId
userId User
user) Handle
h
  RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$
    PrepQuery
  W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
-> QueryParams
     (AccountStatus, Name, ColourId, Pict, [Asset], UserId)
-> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write
      PrepQuery
  W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
updateUserToTombstone
      ( Consistency
-> (AccountStatus, Name, ColourId, Pict, [Asset], UserId)
-> QueryParams
     (AccountStatus, Name, ColourId, Pict, [Asset], UserId)
forall a. Consistency -> a -> QueryParams a
params
          Consistency
LocalQuorum
          (AccountStatus
Deleted, Text -> Name
Name Text
"default", ColourId
defaultAccentId, Pict
noPict, [], User -> UserId
userId User
user)
      )

lookupStatusImpl :: UserId -> Client (Maybe AccountStatus)
lookupStatusImpl :: UserId -> Client (Maybe AccountStatus)
lookupStatusImpl UserId
u =
  (Identity (Maybe AccountStatus) -> Maybe AccountStatus
forall a. Identity a -> a
runIdentity =<<)
    (Maybe (Identity (Maybe AccountStatus)) -> Maybe AccountStatus)
-> Client (Maybe (Identity (Maybe AccountStatus)))
-> Client (Maybe AccountStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Identity (Maybe AccountStatus)))
-> Client (Maybe (Identity (Maybe AccountStatus)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus))
-> QueryParams (Identity UserId)
-> Client (Maybe (Identity (Maybe AccountStatus)))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus))
statusSelect (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
u)))

isActivatedImpl :: UserId -> Client Bool
isActivatedImpl :: UserId -> Client Bool
isActivatedImpl UserId
uid =
  (Maybe (Identity Bool) -> Maybe (Identity Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Identity Bool -> Maybe (Identity Bool)
forall a. a -> Maybe a
Just (Bool -> Identity Bool
forall a. a -> Identity a
Identity Bool
True))
    (Maybe (Identity Bool) -> Bool)
-> Client (Maybe (Identity Bool)) -> Client Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Identity Bool)) -> Client (Maybe (Identity Bool))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Identity Bool)
-> QueryParams (Identity UserId) -> Client (Maybe (Identity Bool))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity UserId) (Identity Bool)
activatedSelect (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))

lookupLocaleImpl :: UserId -> Client (Maybe (Maybe Language, Maybe Country))
lookupLocaleImpl :: UserId -> Client (Maybe (Maybe Language, Maybe Country))
lookupLocaleImpl UserId
u = do
  RetrySettings
-> Client (Maybe (Maybe Language, Maybe Country))
-> Client (Maybe (Maybe Language, Maybe Country))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Maybe Language, Maybe Country)
-> QueryParams (Identity UserId)
-> Client (Maybe (Maybe Language, Maybe Country))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity UserId) (Maybe Language, Maybe Country)
localeSelect (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
u)))

updateUserTeamImpl :: UserId -> TeamId -> Client ()
updateUserTeamImpl :: UserId -> TeamId -> Client ()
updateUserTeamImpl UserId
u TeamId
t = RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (TeamId, UserId) ()
-> QueryParams (TeamId, UserId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (TeamId, UserId) ()
userTeamUpdate (Consistency -> (TeamId, UserId) -> QueryParams (TeamId, UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId
t, UserId
u))
  where
    userTeamUpdate :: PrepQuery W (TeamId, UserId) ()
    userTeamUpdate :: PrepQuery W (TeamId, UserId) ()
userTeamUpdate = PrepQuery W (TeamId, UserId) ()
"UPDATE user SET team = ? WHERE id = ?"

getActivityTimestampsImpl :: UserId -> Client [Maybe UTCTime]
getActivityTimestampsImpl :: UserId -> Client [Maybe UTCTime]
getActivityTimestampsImpl UserId
uid = do
  Identity (Maybe UTCTime) -> Maybe UTCTime
forall a. Identity a -> a
runIdentity (Identity (Maybe UTCTime) -> Maybe UTCTime)
-> Client [Identity (Maybe UTCTime)] -> Client [Maybe UTCTime]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings
-> Client [Identity (Maybe UTCTime)]
-> Client [Identity (Maybe UTCTime)]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Identity (Maybe UTCTime))
-> QueryParams (Identity UserId)
-> Client [Identity (Maybe UTCTime)]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (Identity UserId) (Identity (Maybe UTCTime))
q (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))
  where
    q :: PrepQuery R (Identity UserId) (Identity (Maybe UTCTime))
    q :: PrepQuery R (Identity UserId) (Identity (Maybe UTCTime))
q = PrepQuery R (Identity UserId) (Identity (Maybe UTCTime))
"SELECT last_active from clients where user = ?"

getRichInfoImpl :: UserId -> Client (Maybe RichInfoAssocList)
getRichInfoImpl :: UserId -> Client (Maybe RichInfoAssocList)
getRichInfoImpl UserId
uid =
  (Identity RichInfoAssocList -> RichInfoAssocList)
-> Maybe (Identity RichInfoAssocList) -> Maybe RichInfoAssocList
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity RichInfoAssocList -> RichInfoAssocList
forall a. Identity a -> a
runIdentity
    (Maybe (Identity RichInfoAssocList) -> Maybe RichInfoAssocList)
-> Client (Maybe (Identity RichInfoAssocList))
-> Client (Maybe RichInfoAssocList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Identity RichInfoAssocList))
-> Client (Maybe (Identity RichInfoAssocList))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
-> QueryParams (Identity UserId)
-> Client (Maybe (Identity RichInfoAssocList))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
q (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))
  where
    q :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
    q :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
q = PrepQuery R (Identity UserId) (Identity RichInfoAssocList)
"SELECT json FROM rich_info WHERE user = ?"

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

selectUsers :: PrepQuery R (Identity [UserId]) (TupleType StoredUser)
selectUsers :: PrepQuery R (Identity [UserId]) (TupleType StoredUser)
selectUsers =
  PrepQuery R (Identity [UserId]) (TupleType StoredUser)
[sql|
  SELECT id, 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
  FROM user WHERE id IN ?
  |]

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

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

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

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

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

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

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

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

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

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

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

updateUserToTombstone :: PrepQuery W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
updateUserToTombstone :: PrepQuery
  W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
updateUserToTombstone =
  PrepQuery
  W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) ()
"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 :: PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus))
statusSelect = PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus))
"SELECT status FROM user WHERE id = ?"

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

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