{-# OPTIONS_GHC -fno-warn-orphans #-}

module Wire.PasswordStore.Cassandra (interpretPasswordStore) where

import Cassandra
import Data.Id
import Imports
import Polysemy
import Polysemy.Embed
import Wire.API.Password (Password)
import Wire.PasswordStore

interpretPasswordStore :: (Member (Embed IO) r) => ClientState -> InterpreterFor PasswordStore r
interpretPasswordStore :: forall (r :: EffectRow).
Member (Embed IO) r =>
ClientState -> InterpreterFor PasswordStore r
interpretPasswordStore ClientState
casClient =
  (forall (rInitial :: EffectRow) x.
 PasswordStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordStore : 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.
  PasswordStore (Sem rInitial) x -> Sem r x)
 -> Sem (PasswordStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    PasswordStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordStore : 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)
-> (PasswordStore (Sem rInitial) x -> Sem (Embed Client : r) x)
-> PasswordStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      UpsertHashedPassword UserId
uid Password
password -> 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)
-> Client x -> Sem (Embed Client : r) x
forall a b. (a -> b) -> a -> b
$ UserId -> Password -> Client ()
forall (m :: * -> *). MonadClient m => UserId -> Password -> m ()
updatePasswordImpl UserId
uid Password
password
      LookupHashedPassword UserId
uid -> 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)
-> Client x -> Sem (Embed Client : r) x
forall a b. (a -> b) -> a -> b
$ UserId -> Client (Maybe Password)
forall (m :: * -> *). MonadClient m => UserId -> m (Maybe Password)
lookupPasswordImpl UserId
uid
      LookupHashedProviderPassword ProviderId
pid -> 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)
-> Client x -> Sem (Embed Client : r) x
forall a b. (a -> b) -> a -> b
$ ProviderId -> Client (Maybe Password)
forall (m :: * -> *).
MonadClient m =>
ProviderId -> m (Maybe Password)
lookupProviderPasswordImpl ProviderId
pid

lookupProviderPasswordImpl :: (MonadClient m) => ProviderId -> m (Maybe Password)
lookupProviderPasswordImpl :: forall (m :: * -> *).
MonadClient m =>
ProviderId -> m (Maybe Password)
lookupProviderPasswordImpl ProviderId
u =
  (Identity (Maybe Password) -> Maybe Password
forall a. Identity a -> a
runIdentity =<<)
    (Maybe (Identity (Maybe Password)) -> Maybe Password)
-> m (Maybe (Identity (Maybe Password))) -> m (Maybe Password)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> m (Maybe (Identity (Maybe Password)))
-> m (Maybe (Identity (Maybe Password)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity ProviderId) (Identity (Maybe Password))
-> QueryParams (Identity ProviderId)
-> m (Maybe (Identity (Maybe Password)))
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 ProviderId) (Identity (Maybe Password))
providerPasswordSelect (Consistency
-> Identity ProviderId -> QueryParams (Identity ProviderId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (ProviderId -> Identity ProviderId
forall a. a -> Identity a
Identity ProviderId
u)))

lookupPasswordImpl :: (MonadClient m) => UserId -> m (Maybe Password)
lookupPasswordImpl :: forall (m :: * -> *). MonadClient m => UserId -> m (Maybe Password)
lookupPasswordImpl UserId
u =
  (Identity (Maybe Password) -> Maybe Password
forall a. Identity a -> a
runIdentity =<<)
    (Maybe (Identity (Maybe Password)) -> Maybe Password)
-> m (Maybe (Identity (Maybe Password))) -> m (Maybe Password)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> m (Maybe (Identity (Maybe Password)))
-> m (Maybe (Identity (Maybe Password)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (Identity (Maybe Password))
-> QueryParams (Identity UserId)
-> m (Maybe (Identity (Maybe Password)))
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 Password))
passwordSelect (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)))

updatePasswordImpl :: (MonadClient m) => UserId -> Password -> m ()
updatePasswordImpl :: forall (m :: * -> *). MonadClient m => UserId -> Password -> m ()
updatePasswordImpl UserId
u Password
p = do
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Password, UserId) ()
-> QueryParams (Password, UserId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Password, UserId) ()
userPasswordUpdate (Consistency -> (Password, UserId) -> QueryParams (Password, UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Password
p, UserId
u))

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

providerPasswordSelect :: PrepQuery R (Identity ProviderId) (Identity (Maybe Password))
providerPasswordSelect :: PrepQuery R (Identity ProviderId) (Identity (Maybe Password))
providerPasswordSelect =
  PrepQuery R (Identity ProviderId) (Identity (Maybe Password))
"SELECT password FROM provider WHERE id = ?"

passwordSelect :: PrepQuery R (Identity UserId) (Identity (Maybe Password))
passwordSelect :: PrepQuery R (Identity UserId) (Identity (Maybe Password))
passwordSelect = PrepQuery R (Identity UserId) (Identity (Maybe Password))
"SELECT password FROM user WHERE id = ?"

userPasswordUpdate :: PrepQuery W (Password, UserId) ()
userPasswordUpdate :: PrepQuery W (Password, UserId) ()
userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} PrepQuery W (Password, UserId) ()
"UPDATE user SET password = ? WHERE id = ?"