{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Snap.Snaplet.Auth.Types where
import Control.Arrow
import Control.Monad.Trans
import Crypto.PasswordStore
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.Configurator as C
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Hashable (Hashable)
import Data.Time
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Typeable
import Snap.Snaplet
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
data Password = ClearText ByteString
| Encrypted ByteString
deriving (ReadPrec [Password]
ReadPrec Password
Int -> ReadS Password
ReadS [Password]
(Int -> ReadS Password)
-> ReadS [Password]
-> ReadPrec Password
-> ReadPrec [Password]
-> Read Password
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Password
readsPrec :: Int -> ReadS Password
$creadList :: ReadS [Password]
readList :: ReadS [Password]
$creadPrec :: ReadPrec Password
readPrec :: ReadPrec Password
$creadListPrec :: ReadPrec [Password]
readListPrec :: ReadPrec [Password]
Read, Int -> Password -> ShowS
[Password] -> ShowS
Password -> String
(Int -> Password -> ShowS)
-> (Password -> String) -> ([Password] -> ShowS) -> Show Password
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Password -> ShowS
showsPrec :: Int -> Password -> ShowS
$cshow :: Password -> String
show :: Password -> String
$cshowList :: [Password] -> ShowS
showList :: [Password] -> ShowS
Show, Eq Password
Eq Password =>
(Password -> Password -> Ordering)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Password)
-> (Password -> Password -> Password)
-> Ord Password
Password -> Password -> Bool
Password -> Password -> Ordering
Password -> Password -> Password
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 :: Password -> Password -> Ordering
compare :: Password -> Password -> Ordering
$c< :: Password -> Password -> Bool
< :: Password -> Password -> Bool
$c<= :: Password -> Password -> Bool
<= :: Password -> Password -> Bool
$c> :: Password -> Password -> Bool
> :: Password -> Password -> Bool
$c>= :: Password -> Password -> Bool
>= :: Password -> Password -> Bool
$cmax :: Password -> Password -> Password
max :: Password -> Password -> Password
$cmin :: Password -> Password -> Password
min :: Password -> Password -> Password
Ord, Password -> Password -> Bool
(Password -> Password -> Bool)
-> (Password -> Password -> Bool) -> Eq Password
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
/= :: Password -> Password -> Bool
Eq)
defaultStrength :: Int
defaultStrength :: Int
defaultStrength = Int
12
encrypt :: ByteString -> IO ByteString
encrypt :: ByteString -> IO ByteString
encrypt = (ByteString -> Int -> IO ByteString)
-> Int -> ByteString -> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Int -> IO ByteString
makePassword Int
defaultStrength
verify
:: ByteString
-> ByteString
-> Bool
verify :: ByteString -> ByteString -> Bool
verify = ByteString -> ByteString -> Bool
verifyPassword
encryptPassword :: Password -> IO Password
encryptPassword :: Password -> IO Password
encryptPassword p :: Password
p@(Encrypted {}) = Password -> IO Password
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Password
p
encryptPassword (ClearText ByteString
p) = ByteString -> Password
Encrypted (ByteString -> Password) -> IO ByteString -> IO Password
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> IO ByteString
encrypt ByteString
p
checkPassword :: Password -> Password -> Bool
checkPassword :: Password -> Password -> Bool
checkPassword (ClearText ByteString
pw) (Encrypted ByteString
pw') = ByteString -> ByteString -> Bool
verify ByteString
pw ByteString
pw'
checkPassword (ClearText ByteString
pw) (ClearText ByteString
pw') = ByteString
pw ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
pw'
checkPassword (Encrypted ByteString
pw) (Encrypted ByteString
pw') = ByteString
pw ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
pw'
checkPassword Password
_ Password
_ =
String -> Bool
forall a. HasCallStack => String -> a
error String
"checkPassword failed. Make sure you pass ClearText passwords"
data AuthFailure = AuthError String
| BackendError
| DuplicateLogin
| EncryptedPassword
| IncorrectPassword
| LockedOut UTCTime
| PasswordMissing
| UsernameMissing
| UserNotFound
deriving (ReadPrec [AuthFailure]
ReadPrec AuthFailure
Int -> ReadS AuthFailure
ReadS [AuthFailure]
(Int -> ReadS AuthFailure)
-> ReadS [AuthFailure]
-> ReadPrec AuthFailure
-> ReadPrec [AuthFailure]
-> Read AuthFailure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AuthFailure
readsPrec :: Int -> ReadS AuthFailure
$creadList :: ReadS [AuthFailure]
readList :: ReadS [AuthFailure]
$creadPrec :: ReadPrec AuthFailure
readPrec :: ReadPrec AuthFailure
$creadListPrec :: ReadPrec [AuthFailure]
readListPrec :: ReadPrec [AuthFailure]
Read, Eq AuthFailure
Eq AuthFailure =>
(AuthFailure -> AuthFailure -> Ordering)
-> (AuthFailure -> AuthFailure -> Bool)
-> (AuthFailure -> AuthFailure -> Bool)
-> (AuthFailure -> AuthFailure -> Bool)
-> (AuthFailure -> AuthFailure -> Bool)
-> (AuthFailure -> AuthFailure -> AuthFailure)
-> (AuthFailure -> AuthFailure -> AuthFailure)
-> Ord AuthFailure
AuthFailure -> AuthFailure -> Bool
AuthFailure -> AuthFailure -> Ordering
AuthFailure -> AuthFailure -> AuthFailure
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 :: AuthFailure -> AuthFailure -> Ordering
compare :: AuthFailure -> AuthFailure -> Ordering
$c< :: AuthFailure -> AuthFailure -> Bool
< :: AuthFailure -> AuthFailure -> Bool
$c<= :: AuthFailure -> AuthFailure -> Bool
<= :: AuthFailure -> AuthFailure -> Bool
$c> :: AuthFailure -> AuthFailure -> Bool
> :: AuthFailure -> AuthFailure -> Bool
$c>= :: AuthFailure -> AuthFailure -> Bool
>= :: AuthFailure -> AuthFailure -> Bool
$cmax :: AuthFailure -> AuthFailure -> AuthFailure
max :: AuthFailure -> AuthFailure -> AuthFailure
$cmin :: AuthFailure -> AuthFailure -> AuthFailure
min :: AuthFailure -> AuthFailure -> AuthFailure
Ord, AuthFailure -> AuthFailure -> Bool
(AuthFailure -> AuthFailure -> Bool)
-> (AuthFailure -> AuthFailure -> Bool) -> Eq AuthFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthFailure -> AuthFailure -> Bool
== :: AuthFailure -> AuthFailure -> Bool
$c/= :: AuthFailure -> AuthFailure -> Bool
/= :: AuthFailure -> AuthFailure -> Bool
Eq, Typeable)
instance Show AuthFailure where
show :: AuthFailure -> String
show (AuthError String
s) = String
s
show (AuthFailure
BackendError) = String
"Failed to store data in the backend."
show (AuthFailure
DuplicateLogin) = String
"This login already exists in the backend."
show (AuthFailure
EncryptedPassword) = String
"Cannot login with encrypted password."
show (AuthFailure
IncorrectPassword) = String
"The password provided was not valid."
show (LockedOut UTCTime
time) = String
"The login is locked out until " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
time
show (AuthFailure
PasswordMissing) = String
"No password provided."
show (AuthFailure
UsernameMissing) = String
"No username provided."
show (AuthFailure
UserNotFound) = String
"User not found in the backend."
newtype UserId = UserId { UserId -> Text
unUid :: Text }
deriving ( ReadPrec [UserId]
ReadPrec UserId
Int -> ReadS UserId
ReadS [UserId]
(Int -> ReadS UserId)
-> ReadS [UserId]
-> ReadPrec UserId
-> ReadPrec [UserId]
-> Read UserId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UserId
readsPrec :: Int -> ReadS UserId
$creadList :: ReadS [UserId]
readList :: ReadS [UserId]
$creadPrec :: ReadPrec UserId
readPrec :: ReadPrec UserId
$creadListPrec :: ReadPrec [UserId]
readListPrec :: ReadPrec [UserId]
Read, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserId -> ShowS
showsPrec :: Int -> UserId -> ShowS
$cshow :: UserId -> String
show :: UserId -> String
$cshowList :: [UserId] -> ShowS
showList :: [UserId] -> ShowS
Show, Eq UserId
Eq UserId =>
(UserId -> UserId -> Ordering)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> UserId)
-> (UserId -> UserId -> UserId)
-> Ord UserId
UserId -> UserId -> Bool
UserId -> UserId -> Ordering
UserId -> UserId -> UserId
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 :: UserId -> UserId -> Ordering
compare :: UserId -> UserId -> Ordering
$c< :: UserId -> UserId -> Bool
< :: UserId -> UserId -> Bool
$c<= :: UserId -> UserId -> Bool
<= :: UserId -> UserId -> Bool
$c> :: UserId -> UserId -> Bool
> :: UserId -> UserId -> Bool
$c>= :: UserId -> UserId -> Bool
>= :: UserId -> UserId -> Bool
$cmax :: UserId -> UserId -> UserId
max :: UserId -> UserId -> UserId
$cmin :: UserId -> UserId -> UserId
min :: UserId -> UserId -> UserId
Ord, UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
/= :: UserId -> UserId -> Bool
Eq, Value -> Parser [UserId]
Value -> Parser UserId
(Value -> Parser UserId)
-> (Value -> Parser [UserId]) -> FromJSON UserId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserId
parseJSON :: Value -> Parser UserId
$cparseJSONList :: Value -> Parser [UserId]
parseJSONList :: Value -> Parser [UserId]
FromJSON, [UserId] -> Value
[UserId] -> Encoding
UserId -> Value
UserId -> Encoding
(UserId -> Value)
-> (UserId -> Encoding)
-> ([UserId] -> Value)
-> ([UserId] -> Encoding)
-> ToJSON UserId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserId -> Value
toJSON :: UserId -> Value
$ctoEncoding :: UserId -> Encoding
toEncoding :: UserId -> Encoding
$ctoJSONList :: [UserId] -> Value
toJSONList :: [UserId] -> Value
$ctoEncodingList :: [UserId] -> Encoding
toEncodingList :: [UserId] -> Encoding
ToJSON, Eq UserId
Eq UserId =>
(Int -> UserId -> Int) -> (UserId -> Int) -> Hashable UserId
Int -> UserId -> Int
UserId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UserId -> Int
hashWithSalt :: Int -> UserId -> Int
$chash :: UserId -> Int
hash :: UserId -> Int
Hashable )
#if MIN_VERSION_aeson(1,0,0)
deriving instance FromJSONKey UserId
deriving instance ToJSONKey UserId
#endif
data Role = Role ByteString
deriving (ReadPrec [Role]
ReadPrec Role
Int -> ReadS Role
ReadS [Role]
(Int -> ReadS Role)
-> ReadS [Role] -> ReadPrec Role -> ReadPrec [Role] -> Read Role
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Role
readsPrec :: Int -> ReadS Role
$creadList :: ReadS [Role]
readList :: ReadS [Role]
$creadPrec :: ReadPrec Role
readPrec :: ReadPrec Role
$creadListPrec :: ReadPrec [Role]
readListPrec :: ReadPrec [Role]
Read, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Eq Role
Eq Role =>
(Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
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 :: Role -> Role -> Ordering
compare :: Role -> Role -> Ordering
$c< :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
>= :: Role -> Role -> Bool
$cmax :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
min :: Role -> Role -> Role
Ord, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq)
data AuthUser = AuthUser
{ AuthUser -> Maybe UserId
userId :: Maybe UserId
, AuthUser -> Text
userLogin :: Text
, AuthUser -> Maybe Text
userEmail :: Maybe Text
, AuthUser -> Maybe Password
userPassword :: Maybe Password
, AuthUser -> Maybe UTCTime
userActivatedAt :: Maybe UTCTime
, AuthUser -> Maybe UTCTime
userSuspendedAt :: Maybe UTCTime
, AuthUser -> Maybe Text
userRememberToken :: Maybe Text
, AuthUser -> Int
userLoginCount :: Int
, AuthUser -> Int
userFailedLoginCount :: Int
, AuthUser -> Maybe UTCTime
userLockedOutUntil :: Maybe UTCTime
, AuthUser -> Maybe UTCTime
userCurrentLoginAt :: Maybe UTCTime
, AuthUser -> Maybe UTCTime
userLastLoginAt :: Maybe UTCTime
, AuthUser -> Maybe ByteString
userCurrentLoginIp :: Maybe ByteString
, AuthUser -> Maybe ByteString
userLastLoginIp :: Maybe ByteString
, AuthUser -> Maybe UTCTime
userCreatedAt :: Maybe UTCTime
, AuthUser -> Maybe UTCTime
userUpdatedAt :: Maybe UTCTime
, AuthUser -> Maybe Text
userResetToken :: Maybe Text
, AuthUser -> Maybe UTCTime
userResetRequestedAt :: Maybe UTCTime
, AuthUser -> [Role]
userRoles :: [Role]
, AuthUser -> HashMap Text Value
userMeta :: HashMap Text Value
}
deriving (Int -> AuthUser -> ShowS
[AuthUser] -> ShowS
AuthUser -> String
(Int -> AuthUser -> ShowS)
-> (AuthUser -> String) -> ([AuthUser] -> ShowS) -> Show AuthUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthUser -> ShowS
showsPrec :: Int -> AuthUser -> ShowS
$cshow :: AuthUser -> String
show :: AuthUser -> String
$cshowList :: [AuthUser] -> ShowS
showList :: [AuthUser] -> ShowS
Show,AuthUser -> AuthUser -> Bool
(AuthUser -> AuthUser -> Bool)
-> (AuthUser -> AuthUser -> Bool) -> Eq AuthUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthUser -> AuthUser -> Bool
== :: AuthUser -> AuthUser -> Bool
$c/= :: AuthUser -> AuthUser -> Bool
/= :: AuthUser -> AuthUser -> Bool
Eq)
defAuthUser :: AuthUser
defAuthUser :: AuthUser
defAuthUser = AuthUser
{ userId :: Maybe UserId
userId = Maybe UserId
forall a. Maybe a
Nothing
, userLogin :: Text
userLogin = Text
""
, userEmail :: Maybe Text
userEmail = Maybe Text
forall a. Maybe a
Nothing
, userPassword :: Maybe Password
userPassword = Maybe Password
forall a. Maybe a
Nothing
, userActivatedAt :: Maybe UTCTime
userActivatedAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userSuspendedAt :: Maybe UTCTime
userSuspendedAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userRememberToken :: Maybe Text
userRememberToken = Maybe Text
forall a. Maybe a
Nothing
, userLoginCount :: Int
userLoginCount = Int
0
, userFailedLoginCount :: Int
userFailedLoginCount = Int
0
, userLockedOutUntil :: Maybe UTCTime
userLockedOutUntil = Maybe UTCTime
forall a. Maybe a
Nothing
, userCurrentLoginAt :: Maybe UTCTime
userCurrentLoginAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userLastLoginAt :: Maybe UTCTime
userLastLoginAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userCurrentLoginIp :: Maybe ByteString
userCurrentLoginIp = Maybe ByteString
forall a. Maybe a
Nothing
, userLastLoginIp :: Maybe ByteString
userLastLoginIp = Maybe ByteString
forall a. Maybe a
Nothing
, userCreatedAt :: Maybe UTCTime
userCreatedAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userUpdatedAt :: Maybe UTCTime
userUpdatedAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userResetToken :: Maybe Text
userResetToken = Maybe Text
forall a. Maybe a
Nothing
, userResetRequestedAt :: Maybe UTCTime
userResetRequestedAt = Maybe UTCTime
forall a. Maybe a
Nothing
, userRoles :: [Role]
userRoles = []
, userMeta :: HashMap Text Value
userMeta = HashMap Text Value
forall k v. HashMap k v
HM.empty
}
setPassword :: AuthUser -> ByteString -> IO AuthUser
setPassword :: AuthUser -> ByteString -> IO AuthUser
setPassword AuthUser
au ByteString
pass = do
Password
pw <- ByteString -> Password
Encrypted (ByteString -> Password) -> IO ByteString -> IO Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Int -> IO ByteString
makePassword ByteString
pass Int
defaultStrength
AuthUser -> IO AuthUser
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthUser -> IO AuthUser) -> AuthUser -> IO AuthUser
forall a b. (a -> b) -> a -> b
$! AuthUser
au { userPassword = Just pw }
data AuthSettings = AuthSettings {
AuthSettings -> Int
asMinPasswdLen :: Int
, AuthSettings -> ByteString
asRememberCookieName :: ByteString
, AuthSettings -> Maybe Int
asRememberPeriod :: Maybe Int
, AuthSettings -> Maybe (Int, NominalDiffTime)
asLockout :: Maybe (Int, NominalDiffTime)
, AuthSettings -> String
asSiteKey :: FilePath
}
defAuthSettings :: AuthSettings
defAuthSettings :: AuthSettings
defAuthSettings = AuthSettings {
asMinPasswdLen :: Int
asMinPasswdLen = Int
8
, asRememberCookieName :: ByteString
asRememberCookieName = ByteString
"_remember"
, asRememberPeriod :: Maybe Int
asRememberPeriod = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
24Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60)
, asLockout :: Maybe (Int, NominalDiffTime)
asLockout = Maybe (Int, NominalDiffTime)
forall a. Maybe a
Nothing
, asSiteKey :: String
asSiteKey = String
"site_key.txt"
}
authSettingsFromConfig :: Initializer b v AuthSettings
authSettingsFromConfig :: forall b v. Initializer b v AuthSettings
authSettingsFromConfig = do
Config
config <- Initializer b v Config
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v Config
getSnapletUserConfig
Maybe Int
minPasswordLen <- IO (Maybe Int) -> Initializer b v (Maybe Int)
forall a. IO a -> Initializer b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> Initializer b v (Maybe Int))
-> IO (Maybe Int) -> Initializer b v (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Config -> Text -> IO (Maybe Int)
forall a. Configured a => Config -> Text -> IO (Maybe a)
C.lookup Config
config Text
"minPasswordLen"
let pw :: AuthSettings -> AuthSettings
pw = (AuthSettings -> AuthSettings)
-> (Int -> AuthSettings -> AuthSettings)
-> Maybe Int
-> AuthSettings
-> AuthSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthSettings -> AuthSettings
forall a. a -> a
id (\Int
x AuthSettings
s -> AuthSettings
s { asMinPasswdLen = x }) Maybe Int
minPasswordLen
Maybe ByteString
rememberCookie <- IO (Maybe ByteString) -> Initializer b v (Maybe ByteString)
forall a. IO a -> Initializer b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> Initializer b v (Maybe ByteString))
-> IO (Maybe ByteString) -> Initializer b v (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Config -> Text -> IO (Maybe ByteString)
forall a. Configured a => Config -> Text -> IO (Maybe a)
C.lookup Config
config Text
"rememberCookie"
let rc :: AuthSettings -> AuthSettings
rc = (AuthSettings -> AuthSettings)
-> (ByteString -> AuthSettings -> AuthSettings)
-> Maybe ByteString
-> AuthSettings
-> AuthSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthSettings -> AuthSettings
forall a. a -> a
id (\ByteString
x AuthSettings
s -> AuthSettings
s { asRememberCookieName = x }) Maybe ByteString
rememberCookie
Maybe Int
rememberPeriod <- IO (Maybe Int) -> Initializer b v (Maybe Int)
forall a. IO a -> Initializer b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> Initializer b v (Maybe Int))
-> IO (Maybe Int) -> Initializer b v (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Config -> Text -> IO (Maybe Int)
forall a. Configured a => Config -> Text -> IO (Maybe a)
C.lookup Config
config Text
"rememberPeriod"
let rp :: AuthSettings -> AuthSettings
rp = (AuthSettings -> AuthSettings)
-> (Int -> AuthSettings -> AuthSettings)
-> Maybe Int
-> AuthSettings
-> AuthSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthSettings -> AuthSettings
forall a. a -> a
id (\Int
x AuthSettings
s -> AuthSettings
s { asRememberPeriod = Just x }) Maybe Int
rememberPeriod
Maybe (Int, Integer)
lockout <- IO (Maybe (Int, Integer)) -> Initializer b v (Maybe (Int, Integer))
forall a. IO a -> Initializer b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Int, Integer))
-> Initializer b v (Maybe (Int, Integer)))
-> IO (Maybe (Int, Integer))
-> Initializer b v (Maybe (Int, Integer))
forall a b. (a -> b) -> a -> b
$ Config -> Text -> IO (Maybe (Int, Integer))
forall a. Configured a => Config -> Text -> IO (Maybe a)
C.lookup Config
config Text
"lockout"
let lo :: AuthSettings -> AuthSettings
lo = (AuthSettings -> AuthSettings)
-> ((Int, Integer) -> AuthSettings -> AuthSettings)
-> Maybe (Int, Integer)
-> AuthSettings
-> AuthSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthSettings -> AuthSettings
forall a. a -> a
id (\(Int, Integer)
x AuthSettings
s -> AuthSettings
s { asLockout = Just (second fromInteger x) })
Maybe (Int, Integer)
lockout
Maybe String
siteKey <- IO (Maybe String) -> Initializer b v (Maybe String)
forall a. IO a -> Initializer b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> Initializer b v (Maybe String))
-> IO (Maybe String) -> Initializer b v (Maybe String)
forall a b. (a -> b) -> a -> b
$ Config -> Text -> IO (Maybe String)
forall a. Configured a => Config -> Text -> IO (Maybe a)
C.lookup Config
config Text
"siteKey"
let sk :: AuthSettings -> AuthSettings
sk = (AuthSettings -> AuthSettings)
-> (String -> AuthSettings -> AuthSettings)
-> Maybe String
-> AuthSettings
-> AuthSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthSettings -> AuthSettings
forall a. a -> a
id (\String
x AuthSettings
s -> AuthSettings
s { asSiteKey = x }) Maybe String
siteKey
AuthSettings -> Initializer b v AuthSettings
forall a. a -> Initializer b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthSettings -> Initializer b v AuthSettings)
-> AuthSettings -> Initializer b v AuthSettings
forall a b. (a -> b) -> a -> b
$ (AuthSettings -> AuthSettings
pw (AuthSettings -> AuthSettings)
-> (AuthSettings -> AuthSettings) -> AuthSettings -> AuthSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthSettings -> AuthSettings
rc (AuthSettings -> AuthSettings)
-> (AuthSettings -> AuthSettings) -> AuthSettings -> AuthSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthSettings -> AuthSettings
rp (AuthSettings -> AuthSettings)
-> (AuthSettings -> AuthSettings) -> AuthSettings -> AuthSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthSettings -> AuthSettings
lo (AuthSettings -> AuthSettings)
-> (AuthSettings -> AuthSettings) -> AuthSettings -> AuthSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthSettings -> AuthSettings
sk) AuthSettings
defAuthSettings
instance ToJSON AuthUser where
toJSON :: AuthUser -> Value
toJSON AuthUser
u = [Pair] -> Value
object
[ Key
"uid" Key -> Maybe UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UserId
userId AuthUser
u
, Key
"login" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Text
userLogin AuthUser
u
, Key
"email" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe Text
userEmail AuthUser
u
, Key
"pw" Key -> Maybe Password -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe Password
userPassword AuthUser
u
, Key
"activated_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userActivatedAt AuthUser
u
, Key
"suspended_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userSuspendedAt AuthUser
u
, Key
"remember_token" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe Text
userRememberToken AuthUser
u
, Key
"login_count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Int
userLoginCount AuthUser
u
, Key
"failed_login_count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Int
userFailedLoginCount AuthUser
u
, Key
"locked_until" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userLockedOutUntil AuthUser
u
, Key
"current_login_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userCurrentLoginAt AuthUser
u
, Key
"last_login_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userLastLoginAt AuthUser
u
, Key
"current_ip" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (AuthUser -> Maybe ByteString
userCurrentLoginIp AuthUser
u)
, Key
"last_ip" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (AuthUser -> Maybe ByteString
userLastLoginIp AuthUser
u)
, Key
"created_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userCreatedAt AuthUser
u
, Key
"updated_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userUpdatedAt AuthUser
u
, Key
"reset_token" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe Text
userResetToken AuthUser
u
, Key
"reset_requested_at" Key -> Maybe UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> Maybe UTCTime
userResetRequestedAt AuthUser
u
, Key
"roles" Key -> [Role] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> [Role]
userRoles AuthUser
u
, Key
"meta" Key -> HashMap Text Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AuthUser -> HashMap Text Value
userMeta AuthUser
u
]
instance FromJSON AuthUser where
parseJSON :: Value -> Parser AuthUser
parseJSON (Object Object
v) = Maybe UserId
-> Text
-> Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser
AuthUser
(Maybe UserId
-> Text
-> Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UserId)
-> Parser
(Text
-> Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe UserId)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uid"
Parser
(Text
-> Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser Text
-> Parser
(Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
Parser
(Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe Text)
-> Parser
(Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
Parser
(Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe Password)
-> Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Password)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pw"
Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"activated_at"
Parser
(Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"suspended_at"
Parser
(Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe Text)
-> Parser
(Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remember_token"
Parser
(Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser Int
-> Parser
(Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login_count"
Parser
(Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser Int
-> Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failed_login_count"
Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked_until"
Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current_login_at"
Parser
(Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_login_at"
Parser
(Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe ByteString)
-> Parser
(Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> Maybe ByteString)
-> Parser (Maybe Text) -> Parser (Maybe ByteString)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8) (Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current_ip")
Parser
(Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe ByteString)
-> Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> Maybe ByteString)
-> Parser (Maybe Text) -> Parser (Maybe ByteString)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8) (Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_ip")
Parser
(Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
Parser
(Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe Text
-> Maybe UTCTime -> [Role] -> HashMap Text Value -> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
Parser
(Maybe Text
-> Maybe UTCTime -> [Role] -> HashMap Text Value -> AuthUser)
-> Parser (Maybe Text)
-> Parser
(Maybe UTCTime -> [Role] -> HashMap Text Value -> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reset_token"
Parser (Maybe UTCTime -> [Role] -> HashMap Text Value -> AuthUser)
-> Parser (Maybe UTCTime)
-> Parser ([Role] -> HashMap Text Value -> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reset_requested_at"
Parser ([Role] -> HashMap Text Value -> AuthUser)
-> Parser [Role] -> Parser (HashMap Text Value -> AuthUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Role])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles" Parser (Maybe [Role]) -> [Role] -> Parser [Role]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
Parser (HashMap Text Value -> AuthUser)
-> Parser (HashMap Text Value) -> Parser AuthUser
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta"
parseJSON Value
_ = String -> Parser AuthUser
forall a. HasCallStack => String -> a
error String
"Unexpected JSON input"
instance ToJSON Password where
toJSON :: Password -> Value
toJSON (Encrypted ByteString
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
x
toJSON (ClearText ByteString
_) =
String -> Value
forall a. HasCallStack => String -> a
error String
"ClearText passwords can't be serialized into JSON"
instance FromJSON Password where
parseJSON :: Value -> Parser Password
parseJSON = (Text -> Password) -> Parser Text -> Parser Password
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Password
Encrypted (ByteString -> Password)
-> (Text -> ByteString) -> Text -> Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) (Parser Text -> Parser Password)
-> (Value -> Parser Text) -> Value -> Parser Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON Role where
toJSON :: Role -> Value
toJSON (Role ByteString
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
x
instance FromJSON Role where
parseJSON :: Value -> Parser Role
parseJSON = (Text -> Role) -> Parser Text -> Parser Role
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Role
Role (ByteString -> Role) -> (Text -> ByteString) -> Text -> Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) (Parser Text -> Parser Role)
-> (Value -> Parser Text) -> Value -> Parser Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON