module Wire.BlockListStore.Cassandra
  ( interpretBlockListStoreToCassandra,
  )
where

import Cassandra
import Imports
import Polysemy
import Wire.BlockListStore (BlockListStore (..))
import Wire.UserKeyStore

interpretBlockListStoreToCassandra ::
  forall r.
  (Member (Embed IO) r) =>
  ClientState ->
  InterpreterFor BlockListStore r
interpretBlockListStoreToCassandra :: forall (r :: EffectRow).
Member (Embed IO) r =>
ClientState -> InterpreterFor BlockListStore r
interpretBlockListStoreToCassandra ClientState
casClient =
  (forall (rInitial :: EffectRow) x.
 BlockListStore (Sem rInitial) x -> Sem r x)
-> Sem (BlockListStore : 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.
  BlockListStore (Sem rInitial) x -> Sem r x)
 -> Sem (BlockListStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    BlockListStore (Sem rInitial) x -> Sem r x)
-> Sem (BlockListStore : 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 @IO (IO x -> Sem r x)
-> (BlockListStore (Sem rInitial) x -> IO x)
-> BlockListStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> Client x -> IO x
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
casClient (Client x -> IO x)
-> (BlockListStore (Sem rInitial) x -> Client x)
-> BlockListStore (Sem rInitial) x
-> IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Insert EmailKey
uk -> EmailKey -> Client ()
forall (m :: * -> *). MonadClient m => EmailKey -> m ()
insert EmailKey
uk
      Exists EmailKey
uk -> EmailKey -> Client Bool
forall (m :: * -> *). MonadClient m => EmailKey -> m Bool
exists EmailKey
uk
      Delete EmailKey
uk -> EmailKey -> Client ()
forall (m :: * -> *). MonadClient m => EmailKey -> m ()
delete EmailKey
uk

--------------------------------------------------------------------------------
-- UserKey block listing

insert :: (MonadClient m) => EmailKey -> m ()
insert :: forall (m :: * -> *). MonadClient m => EmailKey -> m ()
insert EmailKey
uk = 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 (Identity Text) ()
-> QueryParams (Identity Text) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity Text) ()
keyInsert (Consistency -> Identity Text -> QueryParams (Identity Text)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Text -> Identity Text
forall a. a -> Identity a
Identity (Text -> Identity Text) -> Text -> Identity Text
forall a b. (a -> b) -> a -> b
$ EmailKey -> Text
emailKeyUniq EmailKey
uk))

exists :: (MonadClient m) => EmailKey -> m Bool
exists :: forall (m :: * -> *). MonadClient m => EmailKey -> m Bool
exists EmailKey
uk =
  (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Maybe Text -> Bool) -> Maybe Text -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust) (Maybe Text -> m Bool)
-> (Maybe (Identity Text) -> Maybe Text)
-> Maybe (Identity Text)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity Text -> Text) -> Maybe (Identity Text) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity Text -> Text
forall a. Identity a -> a
runIdentity
    (Maybe (Identity Text) -> m Bool)
-> m (Maybe (Identity Text)) -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RetrySettings
-> m (Maybe (Identity Text)) -> m (Maybe (Identity Text))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity Text) (Identity Text)
-> QueryParams (Identity Text) -> m (Maybe (Identity Text))
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 Text) (Identity Text)
keySelect (Consistency -> Identity Text -> QueryParams (Identity Text)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Text -> Identity Text
forall a. a -> Identity a
Identity (Text -> Identity Text) -> Text -> Identity Text
forall a b. (a -> b) -> a -> b
$ EmailKey -> Text
emailKeyUniq EmailKey
uk)))

delete :: (MonadClient m) => EmailKey -> m ()
delete :: forall (m :: * -> *). MonadClient m => EmailKey -> m ()
delete EmailKey
uk = 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 (Identity Text) ()
-> QueryParams (Identity Text) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity Text) ()
keyDelete (Consistency -> Identity Text -> QueryParams (Identity Text)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Text -> Identity Text
forall a. a -> Identity a
Identity (Text -> Identity Text) -> Text -> Identity Text
forall a b. (a -> b) -> a -> b
$ EmailKey -> Text
emailKeyUniq EmailKey
uk))

keyInsert :: PrepQuery W (Identity Text) ()
keyInsert :: PrepQuery W (Identity Text) ()
keyInsert = PrepQuery W (Identity Text) ()
"INSERT INTO blacklist (key) VALUES (?)"

keySelect :: PrepQuery R (Identity Text) (Identity Text)
keySelect :: PrepQuery R (Identity Text) (Identity Text)
keySelect = PrepQuery R (Identity Text) (Identity Text)
"SELECT key FROM blacklist WHERE key = ?"

keyDelete :: PrepQuery W (Identity Text) ()
keyDelete :: PrepQuery W (Identity Text) ()
keyDelete = PrepQuery W (Identity Text) ()
"DELETE FROM blacklist WHERE key = ?"