{-# LANGUAGE TemplateHaskell #-}

module Wire.VerificationCodeSubsystem where

import Data.ByteString.Conversion
import Data.Code
import Data.RetryAfter
import Data.UUID (UUID)
import Imports hiding (lookup)
import Polysemy
import Wire.API.Error
import Wire.API.Error.Brig qualified as E
import Wire.Error
import Wire.VerificationCode
import Wire.VerificationCodeGen

data VerificationCodeSubsystemError
  = VerificationCodeThrottled RetryAfter
  deriving (Int -> VerificationCodeSubsystemError -> ShowS
[VerificationCodeSubsystemError] -> ShowS
VerificationCodeSubsystemError -> String
(Int -> VerificationCodeSubsystemError -> ShowS)
-> (VerificationCodeSubsystemError -> String)
-> ([VerificationCodeSubsystemError] -> ShowS)
-> Show VerificationCodeSubsystemError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationCodeSubsystemError -> ShowS
showsPrec :: Int -> VerificationCodeSubsystemError -> ShowS
$cshow :: VerificationCodeSubsystemError -> String
show :: VerificationCodeSubsystemError -> String
$cshowList :: [VerificationCodeSubsystemError] -> ShowS
showList :: [VerificationCodeSubsystemError] -> ShowS
Show, VerificationCodeSubsystemError
-> VerificationCodeSubsystemError -> Bool
(VerificationCodeSubsystemError
 -> VerificationCodeSubsystemError -> Bool)
-> (VerificationCodeSubsystemError
    -> VerificationCodeSubsystemError -> Bool)
-> Eq VerificationCodeSubsystemError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationCodeSubsystemError
-> VerificationCodeSubsystemError -> Bool
== :: VerificationCodeSubsystemError
-> VerificationCodeSubsystemError -> Bool
$c/= :: VerificationCodeSubsystemError
-> VerificationCodeSubsystemError -> Bool
/= :: VerificationCodeSubsystemError
-> VerificationCodeSubsystemError -> Bool
Eq)

verificationCodeSubsystemErrorToHttpError :: VerificationCodeSubsystemError -> HttpError
verificationCodeSubsystemErrorToHttpError :: VerificationCodeSubsystemError -> HttpError
verificationCodeSubsystemErrorToHttpError = \case
  VerificationCodeThrottled RetryAfter
t ->
    Error -> () -> [Header] -> HttpError
forall a. ToJSON a => Error -> a -> [Header] -> HttpError
RichError
      (forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.VerificationCodeThrottled)
      ()
      [(HeaderName
"Retry-After", Int64 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (RetryAfter -> Int64
retryAfterSeconds RetryAfter
t))]

newtype CodeAlreadyExists = CodeAlreadyExists Code
  deriving (Int -> CodeAlreadyExists -> ShowS
[CodeAlreadyExists] -> ShowS
CodeAlreadyExists -> String
(Int -> CodeAlreadyExists -> ShowS)
-> (CodeAlreadyExists -> String)
-> ([CodeAlreadyExists] -> ShowS)
-> Show CodeAlreadyExists
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeAlreadyExists -> ShowS
showsPrec :: Int -> CodeAlreadyExists -> ShowS
$cshow :: CodeAlreadyExists -> String
show :: CodeAlreadyExists -> String
$cshowList :: [CodeAlreadyExists] -> ShowS
showList :: [CodeAlreadyExists] -> ShowS
Show, CodeAlreadyExists -> CodeAlreadyExists -> Bool
(CodeAlreadyExists -> CodeAlreadyExists -> Bool)
-> (CodeAlreadyExists -> CodeAlreadyExists -> Bool)
-> Eq CodeAlreadyExists
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeAlreadyExists -> CodeAlreadyExists -> Bool
== :: CodeAlreadyExists -> CodeAlreadyExists -> Bool
$c/= :: CodeAlreadyExists -> CodeAlreadyExists -> Bool
/= :: CodeAlreadyExists -> CodeAlreadyExists -> Bool
Eq)

data VerificationCodeSubsystem m a where
  CreateCode ::
    -- | The 'Gen'erator to use.
    VerificationCodeGen ->
    -- | The scope of the generated code.
    Scope ->
    -- | Maximum verification attempts.
    Retries ->
    -- | Time-to-live in seconds.
    Timeout ->
    -- | Associated account ID.
    Maybe UUID ->
    VerificationCodeSubsystem m (Either CodeAlreadyExists Code)
  CreateCodeOverwritePrevious ::
    -- | The 'Gen'erator to use.
    VerificationCodeGen ->
    -- | The scope of the generated code.
    Scope ->
    -- | Maximum verification attempts.
    Retries ->
    -- | Time-to-live in seconds.
    Timeout ->
    -- | Associated account ID.
    Maybe UUID ->
    VerificationCodeSubsystem m Code
  -- Returns the 'Code' iff verification suceeds.
  VerifyCode :: Key -> Scope -> Value -> VerificationCodeSubsystem m (Maybe Code)
  DeleteCode :: Key -> Scope -> VerificationCodeSubsystem m ()
  -- For internal endpoints
  InternalLookupCode :: Key -> Scope -> VerificationCodeSubsystem m (Maybe Code)

makeSem ''VerificationCodeSubsystem