{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Yesod.Auth.Simple.Types where

import ClassyPrelude
import Data.Aeson
import qualified Text.Password.Strength as PW

newtype PasswordReq = PasswordReq { PasswordReq -> Text
unPasswordReq :: Text }

-- | `extraWords` are common words, likely in the application domain,
-- that should be noted in the zxcvbn password strength check. These
-- words will not be banned in passwords, but they will be noted as
-- less secure than they could have been otherwise.
data PasswordCheck = RuleBased { PasswordCheck -> Int
minChars :: Int }
                   | Zxcvbn { PasswordCheck -> Strength
minStrength :: PW.Strength
                            , PasswordCheck -> Vector Text
extraWords  :: Vector Text }

data PasswordStrength = GoodPassword PW.Strength
                      | BadPassword PW.Strength (Maybe Text)

instance ToJSON PasswordStrength where
  toJSON :: PasswordStrength -> Value
toJSON (GoodPassword Strength
stren) =
    [Pair] -> Value
object [Key
"isAcceptable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True, Key
"score" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Strength -> Int
forall a. Enum a => a -> Int
fromEnum Strength
stren]
  toJSON (BadPassword Strength
stren Maybe Text
mErr) =
    [Pair] -> Value
object [ Key
"isAcceptable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False
           , Key
"score" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Strength -> Int
forall a. Enum a => a -> Int
fromEnum Strength
stren
           , Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Text
mErr ]

instance FromJSON PasswordReq where
  parseJSON :: Value -> Parser PasswordReq
parseJSON = String
-> (Object -> Parser PasswordReq) -> Value -> Parser PasswordReq
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"req" ((Object -> Parser PasswordReq) -> Value -> Parser PasswordReq)
-> (Object -> Parser PasswordReq) -> Value -> Parser PasswordReq
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
password <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"password"
    PasswordReq -> Parser PasswordReq
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordReq -> Parser PasswordReq)
-> PasswordReq -> Parser PasswordReq
forall a b. (a -> b) -> a -> b
$ Text -> PasswordReq
PasswordReq Text
password

newtype Email = Email { Email -> Text
unEmail :: Text }
  deriving (Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
(Int -> Email -> ShowS)
-> (Email -> String) -> ([Email] -> ShowS) -> Show Email
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show, [Email] -> Encoding
[Email] -> Value
Email -> Encoding
Email -> Value
(Email -> Value)
-> (Email -> Encoding)
-> ([Email] -> Value)
-> ([Email] -> Encoding)
-> ToJSON Email
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Email] -> Encoding
$ctoEncodingList :: [Email] -> Encoding
toJSONList :: [Email] -> Value
$ctoJSONList :: [Email] -> Value
toEncoding :: Email -> Encoding
$ctoEncoding :: Email -> Encoding
toJSON :: Email -> Value
$ctoJSON :: Email -> Value
ToJSON, Value -> Parser [Email]
Value -> Parser Email
(Value -> Parser Email)
-> (Value -> Parser [Email]) -> FromJSON Email
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Email]
$cparseJSONList :: Value -> Parser [Email]
parseJSON :: Value -> Parser Email
$cparseJSON :: Value -> Parser Email
FromJSON)

instance Eq Email where
  Email Text
e1 == :: Email -> Email -> Bool
== Email Text
e2 = Text -> Text
forall t. Textual t => t -> t
toLower Text
e1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
forall t. Textual t => t -> t
toLower Text
e2

newtype Password = Password Text
  deriving(Password -> Password -> Bool
(Password -> Password -> Bool)
-> (Password -> Password -> Bool) -> Eq Password
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c== :: Password -> Password -> Bool
Eq, [Password] -> Encoding
[Password] -> Value
Password -> Encoding
Password -> Value
(Password -> Value)
-> (Password -> Encoding)
-> ([Password] -> Value)
-> ([Password] -> Encoding)
-> ToJSON Password
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Password] -> Encoding
$ctoEncodingList :: [Password] -> Encoding
toJSONList :: [Password] -> Value
$ctoJSONList :: [Password] -> Value
toEncoding :: Password -> Encoding
$ctoEncoding :: Password -> Encoding
toJSON :: Password -> Value
$ctoJSON :: Password -> Value
ToJSON, Value -> Parser [Password]
Value -> Parser Password
(Value -> Parser Password)
-> (Value -> Parser [Password]) -> FromJSON Password
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Password]
$cparseJSONList :: Value -> Parser [Password]
parseJSON :: Value -> Parser Password
$cparseJSON :: Value -> Parser Password
FromJSON)

instance Show Password where
  show :: Password -> String
show Password
_ = String
"<redacted>"

type VerUrl = Text