module Wire.ActivationCodeStore.Cassandra where

import Cassandra
import Data.Id
import Data.Text.Ascii qualified as Ascii
import Data.Text.Encoding qualified as T
import Imports
import OpenSSL.EVP.Digest
import Polysemy
import Polysemy.Embed
import Wire.API.User.Activation
import Wire.ActivationCodeStore
import Wire.UserKeyStore (EmailKey, emailKeyUniq)

interpretActivationCodeStoreToCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor ActivationCodeStore r
interpretActivationCodeStoreToCassandra :: forall (r :: EffectRow).
Member (Embed IO) r =>
ClientState -> InterpreterFor ActivationCodeStore r
interpretActivationCodeStoreToCassandra ClientState
casClient =
  (forall (rInitial :: EffectRow) x.
 ActivationCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (ActivationCodeStore : 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.
  ActivationCodeStore (Sem rInitial) x -> Sem r x)
 -> Sem (ActivationCodeStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    ActivationCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (ActivationCodeStore : 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)
-> (ActivationCodeStore (Sem rInitial) x
    -> Sem (Embed Client : r) x)
-> ActivationCodeStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      LookupActivationCode EmailKey
ek -> Client x -> Sem (Embed Client : r) x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed do
        IO ActivationKey -> Client ActivationKey
forall a. IO a -> Client a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EmailKey -> IO ActivationKey
mkActivationKey EmailKey
ek)
          Client ActivationKey -> (ActivationKey -> Client x) -> Client x
forall a b. Client a -> (a -> Client b) -> Client b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RetrySettings -> Client x -> Client x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (Client x -> Client x)
-> (ActivationKey -> Client x) -> ActivationKey -> Client x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery R (Identity ActivationKey) (Maybe UserId, ActivationCode)
-> QueryParams (Identity ActivationKey)
-> Client (Maybe (Maybe UserId, ActivationCode))
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 ActivationKey) (Maybe UserId, ActivationCode)
cql (QueryParams (Identity ActivationKey) -> Client x)
-> (ActivationKey -> QueryParams (Identity ActivationKey))
-> ActivationKey
-> Client x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> Identity ActivationKey -> QueryParams (Identity ActivationKey)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Identity ActivationKey -> QueryParams (Identity ActivationKey))
-> (ActivationKey -> Identity ActivationKey)
-> ActivationKey
-> QueryParams (Identity ActivationKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActivationKey -> Identity ActivationKey
forall a. a -> Identity a
Identity
  where
    cql :: PrepQuery R (Identity ActivationKey) (Maybe UserId, ActivationCode)
    cql :: PrepQuery R (Identity ActivationKey) (Maybe UserId, ActivationCode)
cql =
      [sql| 
      SELECT user, code FROM activation_keys WHERE key = ?
      |]

mkActivationKey :: EmailKey -> IO ActivationKey
mkActivationKey :: EmailKey -> IO ActivationKey
mkActivationKey EmailKey
k = do
  Just Digest
d <- String -> IO (Maybe Digest)
getDigestByName String
"SHA256"
  ActivationKey -> IO ActivationKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
    AsciiBase64Url -> ActivationKey
ActivationKey
      (AsciiBase64Url -> ActivationKey)
-> (Text -> AsciiBase64Url) -> Text -> ActivationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiBase64Url
Ascii.encodeBase64Url
      (ByteString -> AsciiBase64Url)
-> (Text -> ByteString) -> Text -> AsciiBase64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest -> ByteString -> ByteString
digestBS Digest
d
      (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
      (Text -> ActivationKey) -> Text -> ActivationKey
forall a b. (a -> b) -> a -> b
$ EmailKey -> Text
emailKeyUniq EmailKey
k