module Wire.VerificationCode
  ( Code (..),
    Key (..),
    Scope (..),
    Value (..),
    KeyValuePair (..),
    Timeout (..),
    Retries (..),
    codeToKeyValuePair,
    scopeFromAction,
  )
where

import Cassandra hiding (Value)
import Data.Code
import Data.UUID (UUID)
import Imports hiding (lookup)
import Wire.API.User qualified as User
import Wire.API.User.Identity
import Wire.Arbitrary

-- Note [Unique keys]
--
-- We want unique, stable keys that we can associate the secret values with.
-- Using the plain natural identifiers (e.g. e-mail addresses or phone numbers)
-- has a few downsides:
--
--   * The keys are often placed in URLs for verification purposes,
--     giving them unnecessary exposure.
--   * If the keys are not opaque, it can be harder to change their
--     structure, possibly embedding additional information.
--   * Since the keys are often placed in URLs, they must only contain
--     URL-safe characters or otherwise require appropriate encoding.
--
-- Therefore we use the following simple construction:
--
--   * Compute the SHA-256 truncated to 120 bits of the plain, normalised,
--     utf8-encoded natural identifier (i.e. e-mail address or phone number).
--   * Apply URL-safe base64 encoding to yield the final key of length 20.
--
-- Truncation of SHA-2 outputs is a safe and common practice, only reducing
-- collision resistance (e.g. after 2^60 for truncated SHA-256/120 due to the
-- birthday paradox). Collisions have no security implications in this context;
-- at most it enables verification of one random e-mail address or phone
-- number via another, at least one of which must be accessible. It is only
-- important that keys be sufficiently unique and random collisions rare
-- while keeping the length reasonably short, so that keys may be used in
-- length-constrained contexts (e.g. SMS) or even be spelled out or typed.

--------------------------------------------------------------------------------
-- Code

data Code = Code
  { Code -> Key
codeKey :: !Key,
    Code -> Scope
codeScope :: !Scope,
    Code -> Value
codeValue :: !Value,
    -- | This field is actually used as number of allowed "tries" rather than
    -- "retries", so if a code has a retries = 1, verification can only be tried
    -- once, and it cannot actually be "re"-tried after that.
    Code -> Retries
codeRetries :: !Retries,
    Code -> Timeout
codeTTL :: !Timeout,
    Code -> EmailAddress
codeFor :: !EmailAddress,
    Code -> Maybe UUID
codeAccount :: !(Maybe UUID)
  }
  deriving (Code -> Code -> Bool
(Code -> Code -> Bool) -> (Code -> Code -> Bool) -> Eq Code
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Code -> Code -> Bool
== :: Code -> Code -> Bool
$c/= :: Code -> Code -> Bool
/= :: Code -> Code -> Bool
Eq, Int -> Code -> ShowS
[Code] -> ShowS
Code -> String
(Int -> Code -> ShowS)
-> (Code -> String) -> ([Code] -> ShowS) -> Show Code
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Code -> ShowS
showsPrec :: Int -> Code -> ShowS
$cshow :: Code -> String
show :: Code -> String
$cshowList :: [Code] -> ShowS
showList :: [Code] -> ShowS
Show)

scopeFromAction :: User.VerificationAction -> Scope
scopeFromAction :: VerificationAction -> Scope
scopeFromAction = \case
  VerificationAction
User.CreateScimToken -> Scope
CreateScimToken
  VerificationAction
User.Login -> Scope
AccountLogin
  VerificationAction
User.DeleteTeam -> Scope
DeleteTeam

codeToKeyValuePair :: Code -> KeyValuePair
codeToKeyValuePair :: Code -> KeyValuePair
codeToKeyValuePair Code
code = Key -> Value -> KeyValuePair
KeyValuePair Code
code.codeKey Code
code.codeValue

-- | The same 'Key' can exist with different 'Value's in different
-- 'Scope's at the same time.
data Scope
  = AccountDeletion
  | IdentityVerification
  | PasswordReset
  | AccountLogin
  | AccountApproval
  | CreateScimToken
  | DeleteTeam
  deriving (Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
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 :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$c< :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord, (forall x. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scope -> Rep Scope x
from :: forall x. Scope -> Rep Scope x
$cto :: forall x. Rep Scope x -> Scope
to :: forall x. Rep Scope x -> Scope
Generic)
  deriving (Gen Scope
Gen Scope -> (Scope -> [Scope]) -> Arbitrary Scope
Scope -> [Scope]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Scope
arbitrary :: Gen Scope
$cshrink :: Scope -> [Scope]
shrink :: Scope -> [Scope]
Arbitrary) via GenericUniform Scope

instance Cql Scope where
  ctype :: Tagged Scope ColumnType
ctype = ColumnType -> Tagged Scope ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
IntColumn

  toCql :: Scope -> Value
toCql Scope
AccountDeletion = Int32 -> Value
CqlInt Int32
1
  toCql Scope
IdentityVerification = Int32 -> Value
CqlInt Int32
2
  toCql Scope
PasswordReset = Int32 -> Value
CqlInt Int32
3
  toCql Scope
AccountLogin = Int32 -> Value
CqlInt Int32
4
  toCql Scope
AccountApproval = Int32 -> Value
CqlInt Int32
5
  toCql Scope
CreateScimToken = Int32 -> Value
CqlInt Int32
6
  toCql Scope
DeleteTeam = Int32 -> Value
CqlInt Int32
7

  fromCql :: Value -> Either String Scope
fromCql (CqlInt Int32
1) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
AccountDeletion
  fromCql (CqlInt Int32
2) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
IdentityVerification
  fromCql (CqlInt Int32
3) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
PasswordReset
  fromCql (CqlInt Int32
4) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
AccountLogin
  fromCql (CqlInt Int32
5) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
AccountApproval
  fromCql (CqlInt Int32
6) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
CreateScimToken
  fromCql (CqlInt Int32
7) = Scope -> Either String Scope
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope
DeleteTeam
  fromCql Value
_ = String -> Either String Scope
forall a b. a -> Either a b
Left String
"fromCql: Scope: int expected"

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

instance Cql Retries where
  ctype :: Tagged Retries ColumnType
ctype = ColumnType -> Tagged Retries ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
IntColumn
  toCql :: Retries -> Value
toCql = Int32 -> Value
CqlInt (Int32 -> Value) -> (Retries -> Int32) -> Retries -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int32) -> (Retries -> Word8) -> Retries -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Retries -> Word8
numRetries
  fromCql :: Value -> Either String Retries
fromCql (CqlInt Int32
n) = Retries -> Either String Retries
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Retries
Retries (Int32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n))
  fromCql Value
_ = String -> Either String Retries
forall a b. a -> Either a b
Left String
"fromCql: Retries: int expected"