module Wire.VerificationCodeStore.Cassandra where
import Cassandra hiding (Value)
import Data.RetryAfter
import Data.UUID
import Imports
import Polysemy
import Polysemy.Embed
import Wire.API.User.Identity
import Wire.VerificationCode
import Wire.VerificationCodeStore
interpretVerificationCodeStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor VerificationCodeStore r
interpretVerificationCodeStoreCassandra :: forall (r :: EffectRow).
Member (Embed IO) r =>
ClientState -> InterpreterFor VerificationCodeStore r
interpretVerificationCodeStoreCassandra ClientState
casClient =
(forall (rInitial :: EffectRow) x.
VerificationCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (VerificationCodeStore : 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.
VerificationCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (VerificationCodeStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
VerificationCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (VerificationCodeStore : 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)
-> (VerificationCodeStore (Sem rInitial) x
-> Sem (Embed Client : r) x)
-> VerificationCodeStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
InsertCode Code
code -> 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
$ Code -> Client ()
forall (m :: * -> *). MonadClient m => Code -> m ()
insertCodeImpl Code
code
LookupCode Key
key Scope
scope -> 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
$ Key -> Scope -> Client (Maybe Code)
forall (m :: * -> *).
MonadClient m =>
Key -> Scope -> m (Maybe Code)
lookupCodeImpl Key
key Scope
scope
DeleteCode Key
key Scope
scope -> 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
$ Key -> Scope -> Client ()
forall (m :: * -> *). MonadClient m => Key -> Scope -> m ()
deleteCodeImpl Key
key Scope
scope
InsertThrottle Key
key Scope
scope Word
ttl -> 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
$ Key -> Scope -> Word -> Client ()
forall (m :: * -> *). MonadClient m => Key -> Scope -> Word -> m ()
insertThrottleImpl Key
key Scope
scope Word
ttl
LookupThrottle Key
key Scope
scope -> 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
$ Key -> Scope -> Client (Maybe RetryAfter)
forall (m :: * -> *).
MonadClient m =>
Key -> Scope -> m (Maybe RetryAfter)
lookupThrottleImpl Key
key Scope
scope
insertCodeImpl :: (MonadClient m) => Code -> m ()
insertCodeImpl :: forall (m :: * -> *). MonadClient m => Code -> m ()
insertCodeImpl Code
c = do
let k :: Key
k = Code -> Key
codeKey Code
c
let s :: Scope
s = Code -> Scope
codeScope Code
c
let v :: Value
v = Code -> Value
codeValue Code
c
let r :: Retries
r = Retries -> Retries
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Code -> Retries
codeRetries Code
c)
let a :: Maybe UUID
a = Code -> Maybe UUID
codeAccount Code
c
let e :: EmailAddress
e = Code -> EmailAddress
codeFor Code
c
let t :: Int32
t = Timeout -> Int32
forall b. Integral b => Timeout -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Code -> Timeout
codeTTL Code
c)
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery
W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
-> QueryParams
(Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32)
-> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery
W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
cql (Consistency
-> (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32)
-> QueryParams
(Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s, Value
v, Retries
r, EmailAddress
e, Maybe UUID
a, Int32
t)))
where
cql :: PrepQuery W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
cql :: PrepQuery
W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
cql =
PrepQuery
W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
"INSERT INTO vcodes (key, scope, value, retries, email, account) \
\VALUES (?, ?, ?, ?, ?, ?) USING TTL ?"
lookupCodeImpl :: (MonadClient m) => Key -> Scope -> m (Maybe Code)
lookupCodeImpl :: forall (m :: * -> *).
MonadClient m =>
Key -> Scope -> m (Maybe Code)
lookupCodeImpl Key
k Scope
s = (Value, Int32, Retries, EmailAddress, Maybe UUID) -> Code
toCode ((Value, Int32, Retries, EmailAddress, Maybe UUID) -> Code)
-> m (Maybe (Value, Int32, Retries, EmailAddress, Maybe UUID))
-> m (Maybe Code)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings
-> m (Maybe (Value, Int32, Retries, EmailAddress, Maybe UUID))
-> m (Maybe (Value, Int32, Retries, EmailAddress, Maybe UUID))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
R (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
-> QueryParams (Key, Scope)
-> m (Maybe (Value, Int32, Retries, EmailAddress, Maybe UUID))
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 (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
cql (Consistency -> (Key, Scope) -> QueryParams (Key, Scope)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s)))
where
cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
cql :: PrepQuery
R (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
cql =
PrepQuery
R (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
"SELECT value, ttl(value), retries, email, account \
\FROM vcodes WHERE key = ? AND scope = ?"
toCode :: (Value, Int32, Retries, EmailAddress, Maybe UUID) -> Code
toCode :: (Value, Int32, Retries, EmailAddress, Maybe UUID) -> Code
toCode (Value
val, Int32
ttl, Retries
retries, EmailAddress
email, Maybe UUID
account) =
Code
{ $sel:codeKey:Code :: Key
codeKey = Key
k,
$sel:codeScope:Code :: Scope
codeScope = Scope
s,
$sel:codeValue:Code :: Value
codeValue = Value
val,
$sel:codeTTL:Code :: Timeout
codeTTL = NominalDiffTime -> Timeout
Timeout (Int32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ttl),
$sel:codeRetries:Code :: Retries
codeRetries = Retries
retries,
$sel:codeFor:Code :: EmailAddress
codeFor = EmailAddress
email,
$sel:codeAccount:Code :: Maybe UUID
codeAccount = Maybe UUID
account
}
deleteCodeImpl :: (MonadClient m) => Key -> Scope -> m ()
deleteCodeImpl :: forall (m :: * -> *). MonadClient m => Key -> Scope -> m ()
deleteCodeImpl Key
k Scope
s = 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 (Key, Scope) () -> QueryParams (Key, Scope) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Key, Scope) ()
cql (Consistency -> (Key, Scope) -> QueryParams (Key, Scope)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s))
where
cql :: PrepQuery W (Key, Scope) ()
cql :: PrepQuery W (Key, Scope) ()
cql = PrepQuery W (Key, Scope) ()
"DELETE FROM vcodes WHERE key = ? AND scope = ?"
lookupThrottleImpl :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter)
lookupThrottleImpl :: forall (m :: * -> *).
MonadClient m =>
Key -> Scope -> m (Maybe RetryAfter)
lookupThrottleImpl Key
k Scope
s = do
(Identity Int32 -> RetryAfter)
-> Maybe (Identity Int32) -> Maybe RetryAfter
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int64 -> RetryAfter
RetryAfter (Int64 -> RetryAfter)
-> (Identity Int32 -> Int64) -> Identity Int32 -> RetryAfter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64)
-> (Identity Int32 -> Int32) -> Identity Int32 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Int32 -> Int32
forall a. Identity a -> a
runIdentity) (Maybe (Identity Int32) -> Maybe RetryAfter)
-> m (Maybe (Identity Int32)) -> m (Maybe RetryAfter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> m (Maybe (Identity Int32)) -> m (Maybe (Identity Int32))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Key, Scope) (Identity Int32)
-> QueryParams (Key, Scope) -> m (Maybe (Identity Int32))
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 (Key, Scope) (Identity Int32)
cql (Consistency -> (Key, Scope) -> QueryParams (Key, Scope)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s)))
where
cql :: PrepQuery R (Key, Scope) (Identity Int32)
cql :: PrepQuery R (Key, Scope) (Identity Int32)
cql =
PrepQuery R (Key, Scope) (Identity Int32)
"SELECT ttl(initial_delay) \
\FROM vcodes_throttle WHERE key = ? AND scope = ?"
insertThrottleImpl :: (MonadClient m) => Key -> Scope -> Word -> m ()
insertThrottleImpl :: forall (m :: * -> *). MonadClient m => Key -> Scope -> Word -> m ()
insertThrottleImpl Key
k Scope
s Word
t = do
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Key, Scope, Int32, Int32) ()
-> QueryParams (Key, Scope, Int32, Int32) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Key, Scope, Int32, Int32) ()
cql (Consistency
-> (Key, Scope, Int32, Int32)
-> QueryParams (Key, Scope, Int32, Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s, Word -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t, Word -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)))
where
cql :: PrepQuery W (Key, Scope, Int32, Int32) ()
cql :: PrepQuery W (Key, Scope, Int32, Int32) ()
cql =
PrepQuery W (Key, Scope, Int32, Int32) ()
"INSERT INTO vcodes_throttle (key, scope, initial_delay) \
\VALUES (?, ?, ?) USING TTL ?"