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 ?"

-- | Lookup a pending code.
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
        }

-- | Delete a code associated with the given key and scope.
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 ?"