{-# LANGUAGE RecordWildCards #-}
module Wire.PasswordResetCodeStore.Cassandra
( passwordResetCodeStoreToCassandra,
interpretClientToIO,
)
where
import Cassandra
import Data.Id
import Data.Text (pack)
import Data.Text.Ascii
import Data.Time.Clock
import Imports
import OpenSSL.BN (randIntegerZeroToNMinusOne)
import OpenSSL.Random (randBytes)
import Polysemy
import Text.Printf
import Wire.API.User.Password
import Wire.PasswordResetCodeStore
passwordResetCodeStoreToCassandra ::
forall m r a.
(MonadClient m, Member (Embed m) r) =>
Sem (PasswordResetCodeStore ': r) a ->
Sem r a
passwordResetCodeStoreToCassandra :: forall (m :: * -> *) (r :: EffectRow) a.
(MonadClient m, Member (Embed m) r) =>
Sem (PasswordResetCodeStore : r) a -> Sem r a
passwordResetCodeStoreToCassandra =
(forall (rInitial :: EffectRow) x.
PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordResetCodeStore : 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.
PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordResetCodeStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordResetCodeStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed @m
(m x -> Sem r x)
-> (PasswordResetCodeStore (Sem rInitial) x -> m x)
-> PasswordResetCodeStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
PasswordResetCodeStore (Sem rInitial) x
GenerateEmailCode -> m x
m PasswordResetCode
forall (m :: * -> *). MonadIO m => m PasswordResetCode
genEmailCode
PasswordResetCodeStore (Sem rInitial) x
GeneratePhoneCode -> m x
m PasswordResetCode
forall (m :: * -> *). MonadIO m => m PasswordResetCode
genPhoneCode
CodeSelect PasswordResetKey
prk ->
((Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> x)
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> x)
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x)
-> (((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe)
-> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> x)
-> ((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe)
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe)
-> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> x
((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe)
-> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> Maybe (PRQueryData Maybe)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe
toRecord
(m (Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x)
-> (PasswordResetKey
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> PasswordResetKey
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetrySettings
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1
(m (Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> (PasswordResetKey
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> PasswordResetKey
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery
R
(Identity PasswordResetKey)
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> QueryParams (Identity PasswordResetKey)
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
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 PasswordResetKey)
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery
(QueryParams (Identity PasswordResetKey)
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> (PasswordResetKey -> QueryParams (Identity PasswordResetKey))
-> PasswordResetKey
-> m (Maybe
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
(Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey))
-> (PasswordResetKey -> Identity PasswordResetKey)
-> PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordResetKey -> Identity PasswordResetKey
forall a. a -> Identity a
Identity
(PasswordResetKey -> m x) -> PasswordResetKey -> m x
forall a b. (a -> b) -> a -> b
$ PasswordResetKey
prk
CodeInsert PasswordResetKey
prk (PRQueryData PasswordResetCode
prc UserId
uid Identity Int32
n Identity UTCTime
ut) Int32
ttl ->
RetrySettings -> m x -> m x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5
(m x -> m x)
-> ((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x)
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery
W
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
()
-> QueryParams
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery
W
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
()
codeInsertQuery
(QueryParams
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x)
-> ((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> QueryParams
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32))
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> QueryParams
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x)
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
-> m x
forall a b. (a -> b) -> a -> b
$ (PasswordResetKey
prk, PasswordResetCode
prc, UserId
uid, Identity Int32 -> Int32
forall a. Identity a -> a
runIdentity Identity Int32
n, Identity UTCTime -> UTCTime
forall a. Identity a -> a
runIdentity Identity UTCTime
ut, Int32
ttl)
CodeDelete PasswordResetKey
prk -> PasswordResetKey -> m ()
forall (m :: * -> *). MonadClient m => PasswordResetKey -> m ()
codeDeleteImpl PasswordResetKey
prk
where
toRecord ::
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime) ->
PRQueryData Maybe
toRecord :: (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe
toRecord (PasswordResetCode
prqdCode, UserId
prqdUser, Maybe Int32
prqdRetries, Maybe UTCTime
prqdTimeout) =
PRQueryData {Maybe Int32
Maybe UTCTime
UserId
PasswordResetCode
prqdCode :: PasswordResetCode
prqdUser :: UserId
prqdRetries :: Maybe Int32
prqdTimeout :: Maybe UTCTime
$sel:prqdCode:PRQueryData :: PasswordResetCode
$sel:prqdUser:PRQueryData :: UserId
$sel:prqdRetries:PRQueryData :: Maybe Int32
$sel:prqdTimeout:PRQueryData :: Maybe UTCTime
..}
genEmailCode :: (MonadIO m) => m PasswordResetCode
genEmailCode :: forall (m :: * -> *). MonadIO m => m PasswordResetCode
genEmailCode = AsciiBase64Url -> PasswordResetCode
PasswordResetCode (AsciiBase64Url -> PasswordResetCode)
-> (ByteString -> AsciiBase64Url)
-> ByteString
-> PasswordResetCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiBase64Url
encodeBase64Url (ByteString -> PasswordResetCode)
-> m ByteString -> m PasswordResetCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ByteString
randBytes Int
24)
genPhoneCode :: (MonadIO m) => m PasswordResetCode
genPhoneCode :: forall (m :: * -> *). MonadIO m => m PasswordResetCode
genPhoneCode =
AsciiBase64Url -> PasswordResetCode
PasswordResetCode (AsciiBase64Url -> PasswordResetCode)
-> (Integer -> AsciiBase64Url) -> Integer -> PasswordResetCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AsciiBase64Url
forall c. AsciiChars c => Text -> AsciiText c
unsafeFromText (Text -> AsciiBase64Url)
-> (Integer -> Text) -> Integer -> AsciiBase64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%06d"
(Integer -> PasswordResetCode) -> m Integer -> m PasswordResetCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Integer -> IO Integer
randIntegerZeroToNMinusOne Integer
1000000)
codeDeleteImpl :: (MonadClient m) => PasswordResetKey -> m ()
codeDeleteImpl :: forall (m :: * -> *). MonadClient m => PasswordResetKey -> m ()
codeDeleteImpl PasswordResetKey
prk =
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5
(m () -> m ())
-> (PasswordResetKey -> m ()) -> PasswordResetKey -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery W (Identity PasswordResetKey) ()
-> QueryParams (Identity PasswordResetKey) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery
(QueryParams (Identity PasswordResetKey) -> m ())
-> (PasswordResetKey -> QueryParams (Identity PasswordResetKey))
-> PasswordResetKey
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
(Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey))
-> (PasswordResetKey -> Identity PasswordResetKey)
-> PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordResetKey -> Identity PasswordResetKey
forall a. a -> Identity a
Identity
(PasswordResetKey -> m ()) -> PasswordResetKey -> m ()
forall a b. (a -> b) -> a -> b
$ PasswordResetKey
prk
interpretClientToIO ::
(Member (Final IO) r) =>
ClientState ->
Sem (Embed Cassandra.Client ': r) a ->
Sem r a
interpretClientToIO :: forall (r :: EffectRow) a.
Member (Final IO) r =>
ClientState -> Sem (Embed Client : r) a -> Sem r a
interpretClientToIO ClientState
ctx = (forall (rInitial :: EffectRow) x.
Embed Client (Sem rInitial) x -> Sem r x)
-> Sem (Embed Client : 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.
Embed Client (Sem rInitial) x -> Sem r x)
-> Sem (Embed Client : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
Embed Client (Sem rInitial) x -> Sem r x)
-> Sem (Embed Client : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
Embed Client x
action -> forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal @IO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ ClientState -> Client x -> IO x
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
ctx Client x
action
codeSelectQuery :: PrepQuery R (Identity PasswordResetKey) (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery :: PrepQuery
R
(Identity PasswordResetKey)
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery = PrepQuery
R
(Identity PasswordResetKey)
(PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
"SELECT code, user, retries, timeout FROM password_reset WHERE key = ?"
codeInsertQuery :: PrepQuery W (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime, Int32) ()
codeInsertQuery :: PrepQuery
W
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
()
codeInsertQuery = PrepQuery
W
(PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
Int32)
()
"INSERT INTO password_reset (key, code, user, retries, timeout) VALUES (?, ?, ?, ?, ?) USING TTL ?"
codeDeleteQuery :: PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery :: PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery = PrepQuery W (Identity PasswordResetKey) ()
"DELETE FROM password_reset WHERE key = ?"