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