module Wire.VerificationCodeSubsystem.Interpreter where

import Data.Code
import Data.RetryAfter (RetryAfter)
import Data.UUID
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Wire.Arbitrary
import Wire.Sem.Random
import Wire.VerificationCode
import Wire.VerificationCodeGen
import Wire.VerificationCodeStore as Store hiding (DeleteCode)
import Wire.VerificationCodeSubsystem

interpretVerificationCodeSubsystem ::
  ( Member VerificationCodeStore r,
    Member Random r,
    Member (Error VerificationCodeSubsystemError) r,
    Member (Input VerificationCodeThrottleTTL) r
  ) =>
  InterpreterFor VerificationCodeSubsystem r
interpretVerificationCodeSubsystem :: forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
InterpreterFor VerificationCodeSubsystem r
interpretVerificationCodeSubsystem = (forall (rInitial :: EffectRow) x.
 VerificationCodeSubsystem (Sem rInitial) x -> Sem r x)
-> Sem (VerificationCodeSubsystem : 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.
  VerificationCodeSubsystem (Sem rInitial) x -> Sem r x)
 -> Sem (VerificationCodeSubsystem : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    VerificationCodeSubsystem (Sem rInitial) x -> Sem r x)
-> Sem (VerificationCodeSubsystem : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  CreateCode VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId -> VerificationCodeGen
-> Scope
-> Retries
-> Timeout
-> Maybe UUID
-> Sem r (Either CodeAlreadyExists Code)
forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
VerificationCodeGen
-> Scope
-> Retries
-> Timeout
-> Maybe UUID
-> Sem r (Either CodeAlreadyExists Code)
createCodeImpl VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId
  CreateCodeOverwritePrevious VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId -> VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
createCodeOverwritePreviousImpl VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId
  VerifyCode Key
key Scope
scope Value
val -> Key -> Scope -> Value -> Sem r (Maybe Code)
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Value -> Sem r (Maybe Code)
verifyCodeImpl Key
key Scope
scope Value
val
  DeleteCode Key
key Scope
scope -> Key -> Scope -> Sem r ()
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Sem r ()
Store.deleteCode Key
key Scope
scope
  InternalLookupCode Key
key Scope
scope -> Key -> Scope -> Sem r (Maybe Code)
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Sem r (Maybe Code)
Store.lookupCode Key
key Scope
scope

newtype VerificationCodeThrottleTTL = VerificationCodeThrottleTTL Word
  deriving (Int -> VerificationCodeThrottleTTL -> ShowS
[VerificationCodeThrottleTTL] -> ShowS
VerificationCodeThrottleTTL -> String
(Int -> VerificationCodeThrottleTTL -> ShowS)
-> (VerificationCodeThrottleTTL -> String)
-> ([VerificationCodeThrottleTTL] -> ShowS)
-> Show VerificationCodeThrottleTTL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationCodeThrottleTTL -> ShowS
showsPrec :: Int -> VerificationCodeThrottleTTL -> ShowS
$cshow :: VerificationCodeThrottleTTL -> String
show :: VerificationCodeThrottleTTL -> String
$cshowList :: [VerificationCodeThrottleTTL] -> ShowS
showList :: [VerificationCodeThrottleTTL] -> ShowS
Show, VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
(VerificationCodeThrottleTTL
 -> VerificationCodeThrottleTTL -> Bool)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> Bool)
-> Eq VerificationCodeThrottleTTL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
== :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
$c/= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
/= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
Eq, Gen VerificationCodeThrottleTTL
Gen VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL])
-> Arbitrary VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen VerificationCodeThrottleTTL
arbitrary :: Gen VerificationCodeThrottleTTL
$cshrink :: VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
shrink :: VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
Arbitrary, Integer -> VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
(VerificationCodeThrottleTTL
 -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (Integer -> VerificationCodeThrottleTTL)
-> Num VerificationCodeThrottleTTL
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
+ :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$c- :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
- :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$c* :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
* :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cnegate :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
negate :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cabs :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
abs :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$csignum :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
signum :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cfromInteger :: Integer -> VerificationCodeThrottleTTL
fromInteger :: Integer -> VerificationCodeThrottleTTL
Num, Int -> VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> Int
VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> [VerificationCodeThrottleTTL]
(VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (Int -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL -> Int)
-> (VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL])
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL])
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL])
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL
    -> [VerificationCodeThrottleTTL])
-> Enum VerificationCodeThrottleTTL
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
succ :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cpred :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
pred :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$ctoEnum :: Int -> VerificationCodeThrottleTTL
toEnum :: Int -> VerificationCodeThrottleTTL
$cfromEnum :: VerificationCodeThrottleTTL -> Int
fromEnum :: VerificationCodeThrottleTTL -> Int
$cenumFrom :: VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
enumFrom :: VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
$cenumFromThen :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
enumFromThen :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
$cenumFromTo :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
enumFromTo :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> [VerificationCodeThrottleTTL]
$cenumFromThenTo :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> [VerificationCodeThrottleTTL]
enumFromThenTo :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> [VerificationCodeThrottleTTL]
Enum, Eq VerificationCodeThrottleTTL
Eq VerificationCodeThrottleTTL =>
(VerificationCodeThrottleTTL
 -> VerificationCodeThrottleTTL -> Ordering)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> Bool)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> Bool)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> Bool)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> Bool)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> Ord VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> Ordering
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> Ordering
compare :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> Ordering
$c< :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
< :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
$c<= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
<= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
$c> :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
> :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
$c>= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
>= :: VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL -> Bool
$cmax :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
max :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cmin :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
min :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
Ord, Num VerificationCodeThrottleTTL
Ord VerificationCodeThrottleTTL
(Num VerificationCodeThrottleTTL,
 Ord VerificationCodeThrottleTTL) =>
(VerificationCodeThrottleTTL -> Rational)
-> Real VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: VerificationCodeThrottleTTL -> Rational
toRational :: VerificationCodeThrottleTTL -> Rational
Real, Enum VerificationCodeThrottleTTL
Real VerificationCodeThrottleTTL
(Real VerificationCodeThrottleTTL,
 Enum VerificationCodeThrottleTTL) =>
(VerificationCodeThrottleTTL
 -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL)
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL
    -> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL))
-> (VerificationCodeThrottleTTL
    -> VerificationCodeThrottleTTL
    -> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL))
-> (VerificationCodeThrottleTTL -> Integer)
-> Integral VerificationCodeThrottleTTL
VerificationCodeThrottleTTL -> Integer
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL)
VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
quot :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$crem :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
rem :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cdiv :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
div :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cmod :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
mod :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL -> VerificationCodeThrottleTTL
$cquotRem :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL)
quotRem :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL)
$cdivMod :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL)
divMod :: VerificationCodeThrottleTTL
-> VerificationCodeThrottleTTL
-> (VerificationCodeThrottleTTL, VerificationCodeThrottleTTL)
$ctoInteger :: VerificationCodeThrottleTTL -> Integer
toInteger :: VerificationCodeThrottleTTL -> Integer
Integral)

createCodeImpl ::
  ( Member VerificationCodeStore r,
    Member Random r,
    Member (Error VerificationCodeSubsystemError) r,
    Member (Input VerificationCodeThrottleTTL) r
  ) =>
  VerificationCodeGen ->
  Scope ->
  Retries ->
  Timeout ->
  Maybe UUID ->
  Sem r (Either CodeAlreadyExists Code)
createCodeImpl :: forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
VerificationCodeGen
-> Scope
-> Retries
-> Timeout
-> Maybe UUID
-> Sem r (Either CodeAlreadyExists Code)
createCodeImpl VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId =
  Key -> Scope -> Sem r (Maybe Code)
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Sem r (Maybe Code)
lookupCode VerificationCodeGen
gen.genKey Scope
scope Sem r (Maybe Code)
-> (Maybe Code -> Sem r (Either CodeAlreadyExists Code))
-> Sem r (Either CodeAlreadyExists Code)
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Code
c -> Either CodeAlreadyExists Code
-> Sem r (Either CodeAlreadyExists Code)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CodeAlreadyExists Code
 -> Sem r (Either CodeAlreadyExists Code))
-> (CodeAlreadyExists -> Either CodeAlreadyExists Code)
-> CodeAlreadyExists
-> Sem r (Either CodeAlreadyExists Code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeAlreadyExists -> Either CodeAlreadyExists Code
forall a b. a -> Either a b
Left (CodeAlreadyExists -> Sem r (Either CodeAlreadyExists Code))
-> CodeAlreadyExists -> Sem r (Either CodeAlreadyExists Code)
forall a b. (a -> b) -> a -> b
$ Code -> CodeAlreadyExists
CodeAlreadyExists Code
c
    Maybe Code
Nothing ->
      Code -> Either CodeAlreadyExists Code
forall a b. b -> Either a b
Right (Code -> Either CodeAlreadyExists Code)
-> Sem r Code -> Sem r (Either CodeAlreadyExists Code)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
createCodeOverwritePreviousImpl VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId

createCodeOverwritePreviousImpl ::
  ( Member VerificationCodeStore r,
    Member Random r,
    Member (Error VerificationCodeSubsystemError) r,
    Member (Input VerificationCodeThrottleTTL) r
  ) =>
  VerificationCodeGen ->
  Scope ->
  Retries ->
  Timeout ->
  Maybe UUID ->
  Sem r Code
createCodeOverwritePreviousImpl :: forall (r :: EffectRow).
(Member VerificationCodeStore r, Member Random r,
 Member (Error VerificationCodeSubsystemError) r,
 Member (Input VerificationCodeThrottleTTL) r) =>
VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
createCodeOverwritePreviousImpl VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId = do
  Code
code <- VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
forall (r :: EffectRow).
Member Random r =>
VerificationCodeGen
-> Scope -> Retries -> Timeout -> Maybe UUID -> Sem r Code
generateVerificationCode VerificationCodeGen
gen Scope
scope Retries
retries Timeout
timeout Maybe UUID
mId
  Sem r Code
-> (RetryAfter -> Sem r Code) -> Maybe RetryAfter -> Sem r Code
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Code -> Sem r Code
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Code
code) (VerificationCodeSubsystemError -> Sem r Code
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (VerificationCodeSubsystemError -> Sem r Code)
-> (RetryAfter -> VerificationCodeSubsystemError)
-> RetryAfter
-> Sem r Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetryAfter -> VerificationCodeSubsystemError
VerificationCodeThrottled) (Maybe RetryAfter -> Sem r Code)
-> Sem r (Maybe RetryAfter) -> Sem r Code
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Code -> Sem r (Maybe RetryAfter)
forall (r :: EffectRow).
(Member VerificationCodeStore r,
 Member (Input VerificationCodeThrottleTTL) r) =>
Code -> Sem r (Maybe RetryAfter)
insert Code
code

insert ::
  ( Member VerificationCodeStore r,
    Member (Input VerificationCodeThrottleTTL) r
  ) =>
  Code ->
  Sem r (Maybe RetryAfter)
insert :: forall (r :: EffectRow).
(Member VerificationCodeStore r,
 Member (Input VerificationCodeThrottleTTL) r) =>
Code -> Sem r (Maybe RetryAfter)
insert Code
code = do
  VerificationCodeThrottleTTL Word
ttl <- Sem r VerificationCodeThrottleTTL
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  Maybe RetryAfter
mRetryAfter <- Key -> Scope -> Sem r (Maybe RetryAfter)
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Sem r (Maybe RetryAfter)
lookupThrottle (Code -> Key
codeKey Code
code) (Code -> Scope
codeScope Code
code)
  case Maybe RetryAfter
mRetryAfter of
    Just RetryAfter
ra -> Maybe RetryAfter -> Sem r (Maybe RetryAfter)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RetryAfter -> Maybe RetryAfter
forall a. a -> Maybe a
Just RetryAfter
ra)
    Maybe RetryAfter
Nothing -> do
      Key -> Scope -> Word -> Sem r ()
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Word -> Sem r ()
insertThrottle Code
code.codeKey Code
code.codeScope Word
ttl
      Code -> Sem r ()
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Code -> Sem r ()
insertCode Code
code
      Maybe RetryAfter -> Sem r (Maybe RetryAfter)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RetryAfter
forall a. Maybe a
Nothing

-- | Lookup and verify the code for the given key and scope
-- against the given value.
verifyCodeImpl :: (Member VerificationCodeStore r) => Key -> Scope -> Value -> Sem r (Maybe Code)
verifyCodeImpl :: forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Value -> Sem r (Maybe Code)
verifyCodeImpl Key
k Scope
s Value
v = Key -> Scope -> Sem r (Maybe Code)
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Key -> Scope -> Sem r (Maybe Code)
lookupCode Key
k Scope
s Sem r (Maybe Code)
-> (Maybe Code -> Sem r (Maybe Code)) -> Sem r (Maybe Code)
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sem r (Maybe Code)
-> (Code -> Sem r (Maybe Code)) -> Maybe Code -> Sem r (Maybe Code)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Code -> Sem r (Maybe Code)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Code
forall a. Maybe a
Nothing) Code -> Sem r (Maybe Code)
continue
  where
    continue :: Code -> Sem r (Maybe Code)
continue Code
c
      | Code -> Value
codeValue Code
c Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
v Bool -> Bool -> Bool
&& Code -> Retries
codeRetries Code
c Retries -> Retries -> Bool
forall a. Ord a => a -> a -> Bool
> Retries
0 = Maybe Code -> Sem r (Maybe Code)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code -> Maybe Code
forall a. a -> Maybe a
Just Code
c)
      | Code -> Retries
codeRetries Code
c Retries -> Retries -> Bool
forall a. Ord a => a -> a -> Bool
> Retries
0 = do
          Code -> Sem r ()
forall (r :: EffectRow).
Member VerificationCodeStore r =>
Code -> Sem r ()
insertCode (Code
c {codeRetries = codeRetries c - 1})
          Maybe Code -> Sem r (Maybe Code)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Code
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Code -> Sem r (Maybe Code)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Code
forall a. Maybe a
Nothing