{-# LANGUAGE TemplateHaskell #-}

module Wire.UserStore where

import Cassandra (PageWithState (..), PagingState)
import Data.Default
import Data.Handle
import Data.Id
import Data.Time.Clock
import Imports
import Polysemy
import Polysemy.Error
import Wire.API.Password
import Wire.API.User
import Wire.API.User.RichInfo
import Wire.Arbitrary
import Wire.StoredUser
import Wire.UserStore.IndexUser

-- | Update of any "simple" attributes (ones that do not involve locking, like handle, or
-- validation protocols, like email).
--
-- | see 'UserProfileUpdate'.
data StoredUserUpdate = MkStoredUserUpdate
  { StoredUserUpdate -> Maybe Name
name :: Maybe Name,
    StoredUserUpdate -> Maybe TextStatus
textStatus :: Maybe TextStatus,
    StoredUserUpdate -> Maybe Pict
pict :: Maybe Pict,
    StoredUserUpdate -> Maybe [Asset]
assets :: Maybe [Asset],
    StoredUserUpdate -> Maybe ColourId
accentId :: Maybe ColourId,
    StoredUserUpdate -> Maybe Locale
locale :: Maybe Locale,
    StoredUserUpdate -> Maybe (Set BaseProtocolTag)
supportedProtocols :: Maybe (Set BaseProtocolTag)
  }
  deriving stock (StoredUserUpdate -> StoredUserUpdate -> Bool
(StoredUserUpdate -> StoredUserUpdate -> Bool)
-> (StoredUserUpdate -> StoredUserUpdate -> Bool)
-> Eq StoredUserUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoredUserUpdate -> StoredUserUpdate -> Bool
== :: StoredUserUpdate -> StoredUserUpdate -> Bool
$c/= :: StoredUserUpdate -> StoredUserUpdate -> Bool
/= :: StoredUserUpdate -> StoredUserUpdate -> Bool
Eq, Eq StoredUserUpdate
Eq StoredUserUpdate =>
(StoredUserUpdate -> StoredUserUpdate -> Ordering)
-> (StoredUserUpdate -> StoredUserUpdate -> Bool)
-> (StoredUserUpdate -> StoredUserUpdate -> Bool)
-> (StoredUserUpdate -> StoredUserUpdate -> Bool)
-> (StoredUserUpdate -> StoredUserUpdate -> Bool)
-> (StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate)
-> (StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate)
-> Ord StoredUserUpdate
StoredUserUpdate -> StoredUserUpdate -> Bool
StoredUserUpdate -> StoredUserUpdate -> Ordering
StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StoredUserUpdate -> StoredUserUpdate -> Ordering
compare :: StoredUserUpdate -> StoredUserUpdate -> Ordering
$c< :: StoredUserUpdate -> StoredUserUpdate -> Bool
< :: StoredUserUpdate -> StoredUserUpdate -> Bool
$c<= :: StoredUserUpdate -> StoredUserUpdate -> Bool
<= :: StoredUserUpdate -> StoredUserUpdate -> Bool
$c> :: StoredUserUpdate -> StoredUserUpdate -> Bool
> :: StoredUserUpdate -> StoredUserUpdate -> Bool
$c>= :: StoredUserUpdate -> StoredUserUpdate -> Bool
>= :: StoredUserUpdate -> StoredUserUpdate -> Bool
$cmax :: StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate
max :: StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate
$cmin :: StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate
min :: StoredUserUpdate -> StoredUserUpdate -> StoredUserUpdate
Ord, Int -> StoredUserUpdate -> ShowS
[StoredUserUpdate] -> ShowS
StoredUserUpdate -> String
(Int -> StoredUserUpdate -> ShowS)
-> (StoredUserUpdate -> String)
-> ([StoredUserUpdate] -> ShowS)
-> Show StoredUserUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoredUserUpdate -> ShowS
showsPrec :: Int -> StoredUserUpdate -> ShowS
$cshow :: StoredUserUpdate -> String
show :: StoredUserUpdate -> String
$cshowList :: [StoredUserUpdate] -> ShowS
showList :: [StoredUserUpdate] -> ShowS
Show, (forall x. StoredUserUpdate -> Rep StoredUserUpdate x)
-> (forall x. Rep StoredUserUpdate x -> StoredUserUpdate)
-> Generic StoredUserUpdate
forall x. Rep StoredUserUpdate x -> StoredUserUpdate
forall x. StoredUserUpdate -> Rep StoredUserUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoredUserUpdate -> Rep StoredUserUpdate x
from :: forall x. StoredUserUpdate -> Rep StoredUserUpdate x
$cto :: forall x. Rep StoredUserUpdate x -> StoredUserUpdate
to :: forall x. Rep StoredUserUpdate x -> StoredUserUpdate
Generic)
  deriving (Gen StoredUserUpdate
Gen StoredUserUpdate
-> (StoredUserUpdate -> [StoredUserUpdate])
-> Arbitrary StoredUserUpdate
StoredUserUpdate -> [StoredUserUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen StoredUserUpdate
arbitrary :: Gen StoredUserUpdate
$cshrink :: StoredUserUpdate -> [StoredUserUpdate]
shrink :: StoredUserUpdate -> [StoredUserUpdate]
Arbitrary) via GenericUniform StoredUserUpdate

instance Default StoredUserUpdate where
  def :: StoredUserUpdate
def = Maybe Name
-> Maybe TextStatus
-> Maybe Pict
-> Maybe [Asset]
-> Maybe ColourId
-> Maybe Locale
-> Maybe (Set BaseProtocolTag)
-> StoredUserUpdate
MkStoredUserUpdate Maybe Name
forall a. Maybe a
Nothing Maybe TextStatus
forall a. Maybe a
Nothing Maybe Pict
forall a. Maybe a
Nothing Maybe [Asset]
forall a. Maybe a
Nothing Maybe ColourId
forall a. Maybe a
Nothing Maybe Locale
forall a. Maybe a
Nothing Maybe (Set BaseProtocolTag)
forall a. Maybe a
Nothing

-- | Update user handle (this involves several http requests for locking the required handle).
-- The old/previous handle (for deciding idempotency).
data StoredUserHandleUpdate = MkStoredUserHandleUpdate
  { StoredUserHandleUpdate -> Maybe Handle
old :: Maybe Handle,
    StoredUserHandleUpdate -> Handle
new :: Handle
  }
  deriving stock (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
(StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> Eq StoredUserHandleUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
== :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
$c/= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
/= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
Eq, Eq StoredUserHandleUpdate
Eq StoredUserHandleUpdate =>
(StoredUserHandleUpdate -> StoredUserHandleUpdate -> Ordering)
-> (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> (StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool)
-> (StoredUserHandleUpdate
    -> StoredUserHandleUpdate -> StoredUserHandleUpdate)
-> (StoredUserHandleUpdate
    -> StoredUserHandleUpdate -> StoredUserHandleUpdate)
-> Ord StoredUserHandleUpdate
StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
StoredUserHandleUpdate -> StoredUserHandleUpdate -> Ordering
StoredUserHandleUpdate
-> StoredUserHandleUpdate -> StoredUserHandleUpdate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Ordering
compare :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Ordering
$c< :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
< :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
$c<= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
<= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
$c> :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
> :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
$c>= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
>= :: StoredUserHandleUpdate -> StoredUserHandleUpdate -> Bool
$cmax :: StoredUserHandleUpdate
-> StoredUserHandleUpdate -> StoredUserHandleUpdate
max :: StoredUserHandleUpdate
-> StoredUserHandleUpdate -> StoredUserHandleUpdate
$cmin :: StoredUserHandleUpdate
-> StoredUserHandleUpdate -> StoredUserHandleUpdate
min :: StoredUserHandleUpdate
-> StoredUserHandleUpdate -> StoredUserHandleUpdate
Ord, Int -> StoredUserHandleUpdate -> ShowS
[StoredUserHandleUpdate] -> ShowS
StoredUserHandleUpdate -> String
(Int -> StoredUserHandleUpdate -> ShowS)
-> (StoredUserHandleUpdate -> String)
-> ([StoredUserHandleUpdate] -> ShowS)
-> Show StoredUserHandleUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoredUserHandleUpdate -> ShowS
showsPrec :: Int -> StoredUserHandleUpdate -> ShowS
$cshow :: StoredUserHandleUpdate -> String
show :: StoredUserHandleUpdate -> String
$cshowList :: [StoredUserHandleUpdate] -> ShowS
showList :: [StoredUserHandleUpdate] -> ShowS
Show, (forall x. StoredUserHandleUpdate -> Rep StoredUserHandleUpdate x)
-> (forall x.
    Rep StoredUserHandleUpdate x -> StoredUserHandleUpdate)
-> Generic StoredUserHandleUpdate
forall x. Rep StoredUserHandleUpdate x -> StoredUserHandleUpdate
forall x. StoredUserHandleUpdate -> Rep StoredUserHandleUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoredUserHandleUpdate -> Rep StoredUserHandleUpdate x
from :: forall x. StoredUserHandleUpdate -> Rep StoredUserHandleUpdate x
$cto :: forall x. Rep StoredUserHandleUpdate x -> StoredUserHandleUpdate
to :: forall x. Rep StoredUserHandleUpdate x -> StoredUserHandleUpdate
Generic)
  deriving (Gen StoredUserHandleUpdate
Gen StoredUserHandleUpdate
-> (StoredUserHandleUpdate -> [StoredUserHandleUpdate])
-> Arbitrary StoredUserHandleUpdate
StoredUserHandleUpdate -> [StoredUserHandleUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen StoredUserHandleUpdate
arbitrary :: Gen StoredUserHandleUpdate
$cshrink :: StoredUserHandleUpdate -> [StoredUserHandleUpdate]
shrink :: StoredUserHandleUpdate -> [StoredUserHandleUpdate]
Arbitrary) via GenericUniform StoredUserHandleUpdate

data StoredUserUpdateError = StoredUserUpdateHandleExists

-- | Effect containing database logic around 'StoredUser'.  (Example: claim handle lock is
-- database logic; validate handle is application logic.)
data UserStore m a where
  GetIndexUser :: UserId -> UserStore m (Maybe IndexUser)
  GetIndexUsersPaginated :: Int32 -> Maybe PagingState -> UserStore m (PageWithState IndexUser)
  GetUsers :: [UserId] -> UserStore m [StoredUser]
  UpdateUser :: UserId -> StoredUserUpdate -> UserStore m ()
  UpdateUserHandleEither :: UserId -> StoredUserHandleUpdate -> UserStore m (Either StoredUserUpdateError ())
  DeleteUser :: User -> UserStore m ()
  -- | This operation looks up a handle but is guaranteed to not give you stale locks.
  --   It is potentially slower and less resilient than 'GlimpseHandle'.
  LookupHandle :: Handle -> UserStore m (Maybe UserId)
  -- | The interpretation for 'LookupHandle' and 'GlimpseHandle'
  --   may differ in terms of how consistent they are.  If that
  --   matters for the interpretation, this operation may give you stale locks,
  --   but is faster and more resilient.
  GlimpseHandle :: Handle -> UserStore m (Maybe UserId)
  LookupStatus :: UserId -> UserStore m (Maybe AccountStatus)
  -- | Whether the account has been activated by verifying
  --   an email address or phone number.
  IsActivated :: UserId -> UserStore m Bool
  LookupLocale :: UserId -> UserStore m (Maybe (Maybe Language, Maybe Country))
  UpdateUserTeam :: UserId -> TeamId -> UserStore m ()
  GetActivityTimestamps :: UserId -> UserStore m [Maybe UTCTime]
  GetRichInfo :: UserId -> UserStore m (Maybe RichInfoAssocList)
  GetUserAuthenticationInfo :: UserId -> UserStore m (Maybe (Maybe Password, AccountStatus))

makeSem ''UserStore

getUser :: (Member UserStore r) => UserId -> Sem r (Maybe StoredUser)
getUser :: forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser UserId
uid = [StoredUser] -> Maybe StoredUser
forall a. [a] -> Maybe a
listToMaybe ([StoredUser] -> Maybe StoredUser)
-> Sem r [StoredUser] -> Sem r (Maybe StoredUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem r [StoredUser]
forall (r :: EffectRow).
Member UserStore r =>
[UserId] -> Sem r [StoredUser]
getUsers [UserId
uid]

updateUserHandle ::
  (Member UserStore r, Member (Error StoredUserUpdateError) r) =>
  UserId ->
  StoredUserHandleUpdate ->
  Sem r ()
updateUserHandle :: forall (r :: EffectRow).
(Member UserStore r, Member (Error StoredUserUpdateError) r) =>
UserId -> StoredUserHandleUpdate -> Sem r ()
updateUserHandle UserId
uid StoredUserHandleUpdate
update = (StoredUserUpdateError -> Sem r ())
-> (() -> Sem r ()) -> Either StoredUserUpdateError () -> Sem r ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StoredUserUpdateError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoredUserUpdateError () -> Sem r ())
-> Sem r (Either StoredUserUpdateError ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UserId
-> StoredUserHandleUpdate
-> Sem r (Either StoredUserUpdateError ())
forall (r :: EffectRow).
Member UserStore r =>
UserId
-> StoredUserHandleUpdate
-> Sem r (Either StoredUserUpdateError ())
updateUserHandleEither UserId
uid StoredUserHandleUpdate
update