-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE RecordWildCards #-}

module Wire.PasswordResetCodeStore.Cassandra
  ( passwordResetCodeStoreToCassandra,
    interpretClientToIO,
  )
where

import Cassandra
import Data.Id
import Data.Text (pack)
import Data.Text.Ascii
import Data.Time.Clock
import Imports
import OpenSSL.BN (randIntegerZeroToNMinusOne)
import OpenSSL.Random (randBytes)
import Polysemy
import Text.Printf
import Wire.API.User.Password
import Wire.PasswordResetCodeStore

passwordResetCodeStoreToCassandra ::
  forall m r a.
  (MonadClient m, Member (Embed m) r) =>
  Sem (PasswordResetCodeStore ': r) a ->
  Sem r a
passwordResetCodeStoreToCassandra :: forall (m :: * -> *) (r :: EffectRow) a.
(MonadClient m, Member (Embed m) r) =>
Sem (PasswordResetCodeStore : r) a -> Sem r a
passwordResetCodeStoreToCassandra =
  (forall (rInitial :: EffectRow) x.
 PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordResetCodeStore : 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.
  PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
 -> Sem (PasswordResetCodeStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    PasswordResetCodeStore (Sem rInitial) x -> Sem r x)
-> Sem (PasswordResetCodeStore : 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 @m
      (m x -> Sem r x)
-> (PasswordResetCodeStore (Sem rInitial) x -> m x)
-> PasswordResetCodeStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        PasswordResetCodeStore (Sem rInitial) x
GenerateEmailCode -> m x
m PasswordResetCode
forall (m :: * -> *). MonadIO m => m PasswordResetCode
genEmailCode
        PasswordResetCodeStore (Sem rInitial) x
GeneratePhoneCode -> m x
m PasswordResetCode
forall (m :: * -> *). MonadIO m => m PasswordResetCode
genPhoneCode
        CodeSelect PasswordResetKey
prk ->
          ((Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
 -> x)
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
  -> x)
 -> m (Maybe
         (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
 -> m x)
-> (((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
     -> PRQueryData Maybe)
    -> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
    -> x)
-> ((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
    -> PRQueryData Maybe)
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
 -> PRQueryData Maybe)
-> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> x
((PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
 -> PRQueryData Maybe)
-> Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> Maybe (PRQueryData Maybe)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe
toRecord
            (m (Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
 -> m x)
-> (PasswordResetKey
    -> m (Maybe
            (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> PasswordResetKey
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetrySettings
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1
            (m (Maybe (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
 -> m (Maybe
         (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> (PasswordResetKey
    -> m (Maybe
            (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> PasswordResetKey
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery
  R
  (Identity PasswordResetKey)
  (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> QueryParams (Identity PasswordResetKey)
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
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 PasswordResetKey)
  (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery
            (QueryParams (Identity PasswordResetKey)
 -> m (Maybe
         (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)))
-> (PasswordResetKey -> QueryParams (Identity PasswordResetKey))
-> PasswordResetKey
-> m (Maybe
        (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
            (Identity PasswordResetKey
 -> QueryParams (Identity PasswordResetKey))
-> (PasswordResetKey -> Identity PasswordResetKey)
-> PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordResetKey -> Identity PasswordResetKey
forall a. a -> Identity a
Identity
            (PasswordResetKey -> m x) -> PasswordResetKey -> m x
forall a b. (a -> b) -> a -> b
$ PasswordResetKey
prk
        CodeInsert PasswordResetKey
prk (PRQueryData PasswordResetCode
prc UserId
uid Identity Int32
n Identity UTCTime
ut) Int32
ttl ->
          RetrySettings -> m x -> m x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5
            (m x -> m x)
-> ((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
     Int32)
    -> m x)
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
    Int32)
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery
  W
  (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
   Int32)
  ()
-> QueryParams
     (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
      Int32)
-> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery
  W
  (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
   Int32)
  ()
codeInsertQuery
            (QueryParams
   (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
    Int32)
 -> m x)
-> ((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
     Int32)
    -> QueryParams
         (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
          Int32))
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
    Int32)
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
    Int32)
-> QueryParams
     (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
      Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
            ((PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
  Int32)
 -> m x)
-> (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
    Int32)
-> m x
forall a b. (a -> b) -> a -> b
$ (PasswordResetKey
prk, PasswordResetCode
prc, UserId
uid, Identity Int32 -> Int32
forall a. Identity a -> a
runIdentity Identity Int32
n, Identity UTCTime -> UTCTime
forall a. Identity a -> a
runIdentity Identity UTCTime
ut, Int32
ttl)
        CodeDelete PasswordResetKey
prk -> PasswordResetKey -> m ()
forall (m :: * -> *). MonadClient m => PasswordResetKey -> m ()
codeDeleteImpl PasswordResetKey
prk
  where
    toRecord ::
      (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime) ->
      PRQueryData Maybe
    toRecord :: (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
-> PRQueryData Maybe
toRecord (PasswordResetCode
prqdCode, UserId
prqdUser, Maybe Int32
prqdRetries, Maybe UTCTime
prqdTimeout) =
      PRQueryData {Maybe Int32
Maybe UTCTime
UserId
PasswordResetCode
prqdCode :: PasswordResetCode
prqdUser :: UserId
prqdRetries :: Maybe Int32
prqdTimeout :: Maybe UTCTime
$sel:prqdCode:PRQueryData :: PasswordResetCode
$sel:prqdUser:PRQueryData :: UserId
$sel:prqdRetries:PRQueryData :: Maybe Int32
$sel:prqdTimeout:PRQueryData :: Maybe UTCTime
..}

genEmailCode :: (MonadIO m) => m PasswordResetCode
genEmailCode :: forall (m :: * -> *). MonadIO m => m PasswordResetCode
genEmailCode = AsciiBase64Url -> PasswordResetCode
PasswordResetCode (AsciiBase64Url -> PasswordResetCode)
-> (ByteString -> AsciiBase64Url)
-> ByteString
-> PasswordResetCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiBase64Url
encodeBase64Url (ByteString -> PasswordResetCode)
-> m ByteString -> m PasswordResetCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ByteString
randBytes Int
24)

genPhoneCode :: (MonadIO m) => m PasswordResetCode
genPhoneCode :: forall (m :: * -> *). MonadIO m => m PasswordResetCode
genPhoneCode =
  AsciiBase64Url -> PasswordResetCode
PasswordResetCode (AsciiBase64Url -> PasswordResetCode)
-> (Integer -> AsciiBase64Url) -> Integer -> PasswordResetCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AsciiBase64Url
forall c. AsciiChars c => Text -> AsciiText c
unsafeFromText (Text -> AsciiBase64Url)
-> (Integer -> Text) -> Integer -> AsciiBase64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%06d"
    (Integer -> PasswordResetCode) -> m Integer -> m PasswordResetCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Integer -> IO Integer
randIntegerZeroToNMinusOne Integer
1000000)

-- FUTUREWORK(fisx,elland): this should be replaced by a method in a
-- future auth subsystem
codeDeleteImpl :: (MonadClient m) => PasswordResetKey -> m ()
codeDeleteImpl :: forall (m :: * -> *). MonadClient m => PasswordResetKey -> m ()
codeDeleteImpl PasswordResetKey
prk =
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5
    (m () -> m ())
-> (PasswordResetKey -> m ()) -> PasswordResetKey -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery W (Identity PasswordResetKey) ()
-> QueryParams (Identity PasswordResetKey) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery
    (QueryParams (Identity PasswordResetKey) -> m ())
-> (PasswordResetKey -> QueryParams (Identity PasswordResetKey))
-> PasswordResetKey
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Consistency
-> Identity PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum
    (Identity PasswordResetKey
 -> QueryParams (Identity PasswordResetKey))
-> (PasswordResetKey -> Identity PasswordResetKey)
-> PasswordResetKey
-> QueryParams (Identity PasswordResetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordResetKey -> Identity PasswordResetKey
forall a. a -> Identity a
Identity
    (PasswordResetKey -> m ()) -> PasswordResetKey -> m ()
forall a b. (a -> b) -> a -> b
$ PasswordResetKey
prk

interpretClientToIO ::
  (Member (Final IO) r) =>
  ClientState ->
  Sem (Embed Cassandra.Client ': r) a ->
  Sem r a
interpretClientToIO :: forall (r :: EffectRow) a.
Member (Final IO) r =>
ClientState -> Sem (Embed Client : r) a -> Sem r a
interpretClientToIO ClientState
ctx = (forall (rInitial :: EffectRow) x.
 Embed Client (Sem rInitial) x -> Sem r x)
-> Sem (Embed Client : 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.
  Embed Client (Sem rInitial) x -> Sem r x)
 -> Sem (Embed Client : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Embed Client (Sem rInitial) x -> Sem r x)
-> Sem (Embed Client : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Embed Client x
action -> forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal @IO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ ClientState -> Client x -> IO x
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
ctx Client x
action

---------------------------------------------------------------------------------
-- Queries

codeSelectQuery :: PrepQuery R (Identity PasswordResetKey) (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery :: PrepQuery
  R
  (Identity PasswordResetKey)
  (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
codeSelectQuery = PrepQuery
  R
  (Identity PasswordResetKey)
  (PasswordResetCode, UserId, Maybe Int32, Maybe UTCTime)
"SELECT code, user, retries, timeout FROM password_reset WHERE key = ?"

codeInsertQuery :: PrepQuery W (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime, Int32) ()
codeInsertQuery :: PrepQuery
  W
  (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
   Int32)
  ()
codeInsertQuery = PrepQuery
  W
  (PasswordResetKey, PasswordResetCode, UserId, Int32, UTCTime,
   Int32)
  ()
"INSERT INTO password_reset (key, code, user, retries, timeout) VALUES (?, ?, ?, ?, ?) USING TTL ?"

codeDeleteQuery :: PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery :: PrepQuery W (Identity PasswordResetKey) ()
codeDeleteQuery = PrepQuery W (Identity PasswordResetKey) ()
"DELETE FROM password_reset WHERE key = ?"