{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TemplateHaskell, TypeFamilies, TypeSynonymInstances, OverloadedStrings, StandaloneDeriving #-}
module Happstack.Authenticate.Password.Core where

import Control.Applicative ((<$>), optional)
import Control.Monad.Trans (MonadIO(..))
import Control.Lens  ((?~), (^.), (.=), (?=), assign, makeLenses, set, use, view, over)
import Control.Lens.At (at)
import qualified Crypto.PasswordStore as PasswordStore
import Crypto.PasswordStore          (genSaltIO, exportSalt, makePassword)
import Data.Acid          (AcidState, Query, Update, closeAcidState, makeAcidic)
import Data.Acid.Advanced (query', update')
import Data.Acid.Local    (createCheckpointAndClose, openLocalStateFrom)
import qualified Data.Aeson as Aeson
import Data.Aeson         (Value(..), Object(..), Result(..), decode, encode, fromJSON)
import Data.Aeson.Types   (ToJSON(..), FromJSON(..), Options(fieldLabelModifier), defaultOptions, genericToJSON, genericParseJSON)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as B
import Data.Data (Data, Typeable)
import qualified Data.HashMap.Strict as HashMap
import           Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe         (fromMaybe, fromJust)
import Data.Monoid        ((<>), mempty)
import Data.SafeCopy (SafeCopy, Migrate(..), base, extension, deriveSafeCopy)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy     as LT
import Data.Time.Clock.POSIX          (getPOSIXTime)
import Data.UserId (UserId)
import GHC.Generics (Generic)
import Happstack.Authenticate.Core (AuthenticationHandler, AuthenticationMethod(..), AuthenticateState(..), AuthenticateConfig, usernameAcceptable, requireEmail, AuthenticateURL, CoreError(..), CreateUser(..), Email(..), unEmail, GetUserByUserId(..), GetUserByUsername(..), HappstackAuthenticateI18N(..), SharedSecret(..), SimpleAddress(..), User(..), Username(..), GetSharedSecret(..), addTokenCookie, createUserCallback, email, getToken, getOrGenSharedSecret, jsonOptions, userId, username, systemFromAddress, systemReplyToAddress, systemSendmailPath, toJSONSuccess, toJSONResponse, toJSONError, tokenUser)
import Happstack.Authenticate.Password.URL (AccountURL(..))
import Happstack.Server
import HSP.JMacro
import Language.Javascript.JMacro
import Network.HTTP.Types              (toQuery, renderQuery)
import Network.Mail.Mime               (Address(..), Mail(..), simpleMail', renderMail', renderSendMail, renderSendMailCustom, sendmail)
import System.FilePath                 (combine)
import qualified Text.Email.Validate   as Email
import Text.Shakespeare.I18N           (RenderMessage(..), Lang, mkMessageFor)
import qualified Web.JWT               as JWT
import Web.JWT                         (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, intDate, secondsSinceEpoch, verify)
#if MIN_VERSION_jwt(0,8,0)
import Web.JWT                         (ClaimsMap(..), hmacSecret)
#else
import Web.JWT                         (secret)
#endif
import Web.Routes
import Web.Routes.TH

#if MIN_VERSION_jwt(0,8,0)
#else
unClaimsMap = id
#endif

------------------------------------------------------------------------------
-- PasswordConfig
------------------------------------------------------------------------------

data PasswordConfig = PasswordConfig
    { PasswordConfig -> Text
_resetLink :: Text
    , PasswordConfig -> Text
_domain :: Text
    , PasswordConfig -> Text -> Maybe Text
_passwordAcceptable :: Text -> Maybe Text
    }
    deriving (Typeable, (forall x. PasswordConfig -> Rep PasswordConfig x)
-> (forall x. Rep PasswordConfig x -> PasswordConfig)
-> Generic PasswordConfig
forall x. Rep PasswordConfig x -> PasswordConfig
forall x. PasswordConfig -> Rep PasswordConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PasswordConfig x -> PasswordConfig
$cfrom :: forall x. PasswordConfig -> Rep PasswordConfig x
Generic)
makeLenses ''PasswordConfig

------------------------------------------------------------------------------
-- PasswordError
------------------------------------------------------------------------------

data PasswordError
  = NotAuthenticated
  | NotAuthorized
  | InvalidUsername
  | InvalidPassword
  | InvalidUsernamePassword
  | NoEmailAddress
  | MissingResetToken
  | InvalidResetToken
  | PasswordMismatch
  | UnacceptablePassword { PasswordError -> Text
passwordErrorMessageMsg :: Text }
  | CoreError { PasswordError -> CoreError
passwordErrorMessageE :: CoreError }
    deriving (PasswordError -> PasswordError -> Bool
(PasswordError -> PasswordError -> Bool)
-> (PasswordError -> PasswordError -> Bool) -> Eq PasswordError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordError -> PasswordError -> Bool
$c/= :: PasswordError -> PasswordError -> Bool
== :: PasswordError -> PasswordError -> Bool
$c== :: PasswordError -> PasswordError -> Bool
Eq, Eq PasswordError
Eq PasswordError
-> (PasswordError -> PasswordError -> Ordering)
-> (PasswordError -> PasswordError -> Bool)
-> (PasswordError -> PasswordError -> Bool)
-> (PasswordError -> PasswordError -> Bool)
-> (PasswordError -> PasswordError -> Bool)
-> (PasswordError -> PasswordError -> PasswordError)
-> (PasswordError -> PasswordError -> PasswordError)
-> Ord PasswordError
PasswordError -> PasswordError -> Bool
PasswordError -> PasswordError -> Ordering
PasswordError -> PasswordError -> PasswordError
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
min :: PasswordError -> PasswordError -> PasswordError
$cmin :: PasswordError -> PasswordError -> PasswordError
max :: PasswordError -> PasswordError -> PasswordError
$cmax :: PasswordError -> PasswordError -> PasswordError
>= :: PasswordError -> PasswordError -> Bool
$c>= :: PasswordError -> PasswordError -> Bool
> :: PasswordError -> PasswordError -> Bool
$c> :: PasswordError -> PasswordError -> Bool
<= :: PasswordError -> PasswordError -> Bool
$c<= :: PasswordError -> PasswordError -> Bool
< :: PasswordError -> PasswordError -> Bool
$c< :: PasswordError -> PasswordError -> Bool
compare :: PasswordError -> PasswordError -> Ordering
$ccompare :: PasswordError -> PasswordError -> Ordering
$cp1Ord :: Eq PasswordError
Ord, ReadPrec [PasswordError]
ReadPrec PasswordError
Int -> ReadS PasswordError
ReadS [PasswordError]
(Int -> ReadS PasswordError)
-> ReadS [PasswordError]
-> ReadPrec PasswordError
-> ReadPrec [PasswordError]
-> Read PasswordError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordError]
$creadListPrec :: ReadPrec [PasswordError]
readPrec :: ReadPrec PasswordError
$creadPrec :: ReadPrec PasswordError
readList :: ReadS [PasswordError]
$creadList :: ReadS [PasswordError]
readsPrec :: Int -> ReadS PasswordError
$creadsPrec :: Int -> ReadS PasswordError
Read, Int -> PasswordError -> ShowS
[PasswordError] -> ShowS
PasswordError -> String
(Int -> PasswordError -> ShowS)
-> (PasswordError -> String)
-> ([PasswordError] -> ShowS)
-> Show PasswordError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordError] -> ShowS
$cshowList :: [PasswordError] -> ShowS
show :: PasswordError -> String
$cshow :: PasswordError -> String
showsPrec :: Int -> PasswordError -> ShowS
$cshowsPrec :: Int -> PasswordError -> ShowS
Show, Typeable PasswordError
DataType
Constr
Typeable PasswordError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PasswordError -> c PasswordError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PasswordError)
-> (PasswordError -> Constr)
-> (PasswordError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PasswordError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PasswordError))
-> ((forall b. Data b => b -> b) -> PasswordError -> PasswordError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PasswordError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PasswordError -> r)
-> (forall u. (forall d. Data d => d -> u) -> PasswordError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PasswordError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError)
-> Data PasswordError
PasswordError -> DataType
PasswordError -> Constr
(forall b. Data b => b -> b) -> PasswordError -> PasswordError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordError -> c PasswordError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PasswordError -> u
forall u. (forall d. Data d => d -> u) -> PasswordError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordError -> c PasswordError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PasswordError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordError)
$cCoreError :: Constr
$cUnacceptablePassword :: Constr
$cPasswordMismatch :: Constr
$cInvalidResetToken :: Constr
$cMissingResetToken :: Constr
$cNoEmailAddress :: Constr
$cInvalidUsernamePassword :: Constr
$cInvalidPassword :: Constr
$cInvalidUsername :: Constr
$cNotAuthorized :: Constr
$cNotAuthenticated :: Constr
$tPasswordError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
gmapMp :: (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
gmapM :: (forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PasswordError -> m PasswordError
gmapQi :: Int -> (forall d. Data d => d -> u) -> PasswordError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PasswordError -> u
gmapQ :: (forall d. Data d => d -> u) -> PasswordError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PasswordError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordError -> r
gmapT :: (forall b. Data b => b -> b) -> PasswordError -> PasswordError
$cgmapT :: (forall b. Data b => b -> b) -> PasswordError -> PasswordError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PasswordError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PasswordError)
dataTypeOf :: PasswordError -> DataType
$cdataTypeOf :: PasswordError -> DataType
toConstr :: PasswordError -> Constr
$ctoConstr :: PasswordError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordError -> c PasswordError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordError -> c PasswordError
$cp1Data :: Typeable PasswordError
Data, Typeable, (forall x. PasswordError -> Rep PasswordError x)
-> (forall x. Rep PasswordError x -> PasswordError)
-> Generic PasswordError
forall x. Rep PasswordError x -> PasswordError
forall x. PasswordError -> Rep PasswordError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PasswordError x -> PasswordError
$cfrom :: forall x. PasswordError -> Rep PasswordError x
Generic)
instance ToJSON   PasswordError where toJSON :: PasswordError -> Value
toJSON    = Options -> PasswordError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON PasswordError where parseJSON :: Value -> Parser PasswordError
parseJSON = Options -> Value -> Parser PasswordError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

instance ToJExpr PasswordError where
    toJExpr :: PasswordError -> JExpr
toJExpr = Value -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Value -> JExpr)
-> (PasswordError -> Value) -> PasswordError -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordError -> Value
forall a. ToJSON a => a -> Value
toJSON

mkMessageFor "HappstackAuthenticateI18N" "PasswordError" "messages/password/error" ("en")

------------------------------------------------------------------------------
-- HashedPass
------------------------------------------------------------------------------

newtype HashedPass = HashedPass { HashedPass -> ByteString
_unHashedPass :: ByteString }
    deriving (HashedPass -> HashedPass -> Bool
(HashedPass -> HashedPass -> Bool)
-> (HashedPass -> HashedPass -> Bool) -> Eq HashedPass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashedPass -> HashedPass -> Bool
$c/= :: HashedPass -> HashedPass -> Bool
== :: HashedPass -> HashedPass -> Bool
$c== :: HashedPass -> HashedPass -> Bool
Eq, Eq HashedPass
Eq HashedPass
-> (HashedPass -> HashedPass -> Ordering)
-> (HashedPass -> HashedPass -> Bool)
-> (HashedPass -> HashedPass -> Bool)
-> (HashedPass -> HashedPass -> Bool)
-> (HashedPass -> HashedPass -> Bool)
-> (HashedPass -> HashedPass -> HashedPass)
-> (HashedPass -> HashedPass -> HashedPass)
-> Ord HashedPass
HashedPass -> HashedPass -> Bool
HashedPass -> HashedPass -> Ordering
HashedPass -> HashedPass -> HashedPass
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
min :: HashedPass -> HashedPass -> HashedPass
$cmin :: HashedPass -> HashedPass -> HashedPass
max :: HashedPass -> HashedPass -> HashedPass
$cmax :: HashedPass -> HashedPass -> HashedPass
>= :: HashedPass -> HashedPass -> Bool
$c>= :: HashedPass -> HashedPass -> Bool
> :: HashedPass -> HashedPass -> Bool
$c> :: HashedPass -> HashedPass -> Bool
<= :: HashedPass -> HashedPass -> Bool
$c<= :: HashedPass -> HashedPass -> Bool
< :: HashedPass -> HashedPass -> Bool
$c< :: HashedPass -> HashedPass -> Bool
compare :: HashedPass -> HashedPass -> Ordering
$ccompare :: HashedPass -> HashedPass -> Ordering
$cp1Ord :: Eq HashedPass
Ord, ReadPrec [HashedPass]
ReadPrec HashedPass
Int -> ReadS HashedPass
ReadS [HashedPass]
(Int -> ReadS HashedPass)
-> ReadS [HashedPass]
-> ReadPrec HashedPass
-> ReadPrec [HashedPass]
-> Read HashedPass
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HashedPass]
$creadListPrec :: ReadPrec [HashedPass]
readPrec :: ReadPrec HashedPass
$creadPrec :: ReadPrec HashedPass
readList :: ReadS [HashedPass]
$creadList :: ReadS [HashedPass]
readsPrec :: Int -> ReadS HashedPass
$creadsPrec :: Int -> ReadS HashedPass
Read, Int -> HashedPass -> ShowS
[HashedPass] -> ShowS
HashedPass -> String
(Int -> HashedPass -> ShowS)
-> (HashedPass -> String)
-> ([HashedPass] -> ShowS)
-> Show HashedPass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashedPass] -> ShowS
$cshowList :: [HashedPass] -> ShowS
show :: HashedPass -> String
$cshow :: HashedPass -> String
showsPrec :: Int -> HashedPass -> ShowS
$cshowsPrec :: Int -> HashedPass -> ShowS
Show, Typeable HashedPass
DataType
Constr
Typeable HashedPass
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> HashedPass -> c HashedPass)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HashedPass)
-> (HashedPass -> Constr)
-> (HashedPass -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HashedPass))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c HashedPass))
-> ((forall b. Data b => b -> b) -> HashedPass -> HashedPass)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HashedPass -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HashedPass -> r)
-> (forall u. (forall d. Data d => d -> u) -> HashedPass -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HashedPass -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass)
-> Data HashedPass
HashedPass -> DataType
HashedPass -> Constr
(forall b. Data b => b -> b) -> HashedPass -> HashedPass
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashedPass -> c HashedPass
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HashedPass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HashedPass -> u
forall u. (forall d. Data d => d -> u) -> HashedPass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HashedPass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashedPass -> c HashedPass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HashedPass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HashedPass)
$cHashedPass :: Constr
$tHashedPass :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
gmapMp :: (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
gmapM :: (forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HashedPass -> m HashedPass
gmapQi :: Int -> (forall d. Data d => d -> u) -> HashedPass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HashedPass -> u
gmapQ :: (forall d. Data d => d -> u) -> HashedPass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HashedPass -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HashedPass -> r
gmapT :: (forall b. Data b => b -> b) -> HashedPass -> HashedPass
$cgmapT :: (forall b. Data b => b -> b) -> HashedPass -> HashedPass
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HashedPass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HashedPass)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c HashedPass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HashedPass)
dataTypeOf :: HashedPass -> DataType
$cdataTypeOf :: HashedPass -> DataType
toConstr :: HashedPass -> Constr
$ctoConstr :: HashedPass -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HashedPass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HashedPass
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashedPass -> c HashedPass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashedPass -> c HashedPass
$cp1Data :: Typeable HashedPass
Data, Typeable, (forall x. HashedPass -> Rep HashedPass x)
-> (forall x. Rep HashedPass x -> HashedPass) -> Generic HashedPass
forall x. Rep HashedPass x -> HashedPass
forall x. HashedPass -> Rep HashedPass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HashedPass x -> HashedPass
$cfrom :: forall x. HashedPass -> Rep HashedPass x
Generic)
deriveSafeCopy 1 'base ''HashedPass
makeLenses ''HashedPass

-- | hash a password string
mkHashedPass :: (Functor m, MonadIO m) =>
                Text         -- ^ password in plain text
             -> m HashedPass -- ^ salted and hashed
mkHashedPass :: Text -> m HashedPass
mkHashedPass Text
pass = ByteString -> HashedPass
HashedPass (ByteString -> HashedPass) -> m ByteString -> m HashedPass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> IO ByteString
makePassword (Text -> ByteString
Text.encodeUtf8 Text
pass) Int
12)

-- | verify a password
verifyHashedPass :: Text       -- ^ password in plain text
                 -> HashedPass -- ^ hashed version of password
                 -> Bool
verifyHashedPass :: Text -> HashedPass -> Bool
verifyHashedPass Text
passwd (HashedPass ByteString
hashedPass) =
    ByteString -> ByteString -> Bool
PasswordStore.verifyPassword (Text -> ByteString
Text.encodeUtf8 Text
passwd) ByteString
hashedPass

------------------------------------------------------------------------------
-- PasswordState
------------------------------------------------------------------------------

data PasswordState = PasswordState
    { PasswordState -> Map UserId HashedPass
_passwords :: Map UserId HashedPass
    }
    deriving (PasswordState -> PasswordState -> Bool
(PasswordState -> PasswordState -> Bool)
-> (PasswordState -> PasswordState -> Bool) -> Eq PasswordState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordState -> PasswordState -> Bool
$c/= :: PasswordState -> PasswordState -> Bool
== :: PasswordState -> PasswordState -> Bool
$c== :: PasswordState -> PasswordState -> Bool
Eq, Eq PasswordState
Eq PasswordState
-> (PasswordState -> PasswordState -> Ordering)
-> (PasswordState -> PasswordState -> Bool)
-> (PasswordState -> PasswordState -> Bool)
-> (PasswordState -> PasswordState -> Bool)
-> (PasswordState -> PasswordState -> Bool)
-> (PasswordState -> PasswordState -> PasswordState)
-> (PasswordState -> PasswordState -> PasswordState)
-> Ord PasswordState
PasswordState -> PasswordState -> Bool
PasswordState -> PasswordState -> Ordering
PasswordState -> PasswordState -> PasswordState
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
min :: PasswordState -> PasswordState -> PasswordState
$cmin :: PasswordState -> PasswordState -> PasswordState
max :: PasswordState -> PasswordState -> PasswordState
$cmax :: PasswordState -> PasswordState -> PasswordState
>= :: PasswordState -> PasswordState -> Bool
$c>= :: PasswordState -> PasswordState -> Bool
> :: PasswordState -> PasswordState -> Bool
$c> :: PasswordState -> PasswordState -> Bool
<= :: PasswordState -> PasswordState -> Bool
$c<= :: PasswordState -> PasswordState -> Bool
< :: PasswordState -> PasswordState -> Bool
$c< :: PasswordState -> PasswordState -> Bool
compare :: PasswordState -> PasswordState -> Ordering
$ccompare :: PasswordState -> PasswordState -> Ordering
$cp1Ord :: Eq PasswordState
Ord, ReadPrec [PasswordState]
ReadPrec PasswordState
Int -> ReadS PasswordState
ReadS [PasswordState]
(Int -> ReadS PasswordState)
-> ReadS [PasswordState]
-> ReadPrec PasswordState
-> ReadPrec [PasswordState]
-> Read PasswordState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordState]
$creadListPrec :: ReadPrec [PasswordState]
readPrec :: ReadPrec PasswordState
$creadPrec :: ReadPrec PasswordState
readList :: ReadS [PasswordState]
$creadList :: ReadS [PasswordState]
readsPrec :: Int -> ReadS PasswordState
$creadsPrec :: Int -> ReadS PasswordState
Read, Int -> PasswordState -> ShowS
[PasswordState] -> ShowS
PasswordState -> String
(Int -> PasswordState -> ShowS)
-> (PasswordState -> String)
-> ([PasswordState] -> ShowS)
-> Show PasswordState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordState] -> ShowS
$cshowList :: [PasswordState] -> ShowS
show :: PasswordState -> String
$cshow :: PasswordState -> String
showsPrec :: Int -> PasswordState -> ShowS
$cshowsPrec :: Int -> PasswordState -> ShowS
Show, Typeable PasswordState
DataType
Constr
Typeable PasswordState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PasswordState -> c PasswordState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PasswordState)
-> (PasswordState -> Constr)
-> (PasswordState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PasswordState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PasswordState))
-> ((forall b. Data b => b -> b) -> PasswordState -> PasswordState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PasswordState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PasswordState -> r)
-> (forall u. (forall d. Data d => d -> u) -> PasswordState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PasswordState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState)
-> Data PasswordState
PasswordState -> DataType
PasswordState -> Constr
(forall b. Data b => b -> b) -> PasswordState -> PasswordState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordState -> c PasswordState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordState
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PasswordState -> u
forall u. (forall d. Data d => d -> u) -> PasswordState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordState -> c PasswordState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PasswordState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordState)
$cPasswordState :: Constr
$tPasswordState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
gmapMp :: (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
gmapM :: (forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PasswordState -> m PasswordState
gmapQi :: Int -> (forall d. Data d => d -> u) -> PasswordState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PasswordState -> u
gmapQ :: (forall d. Data d => d -> u) -> PasswordState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PasswordState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PasswordState -> r
gmapT :: (forall b. Data b => b -> b) -> PasswordState -> PasswordState
$cgmapT :: (forall b. Data b => b -> b) -> PasswordState -> PasswordState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PasswordState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PasswordState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PasswordState)
dataTypeOf :: PasswordState -> DataType
$cdataTypeOf :: PasswordState -> DataType
toConstr :: PasswordState -> Constr
$ctoConstr :: PasswordState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PasswordState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordState -> c PasswordState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PasswordState -> c PasswordState
$cp1Data :: Typeable PasswordState
Data, Typeable, (forall x. PasswordState -> Rep PasswordState x)
-> (forall x. Rep PasswordState x -> PasswordState)
-> Generic PasswordState
forall x. Rep PasswordState x -> PasswordState
forall x. PasswordState -> Rep PasswordState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PasswordState x -> PasswordState
$cfrom :: forall x. PasswordState -> Rep PasswordState x
Generic)
deriveSafeCopy 1 'base ''PasswordState
makeLenses ''PasswordState

initialPasswordState :: PasswordState
initialPasswordState :: PasswordState
initialPasswordState = PasswordState :: Map UserId HashedPass -> PasswordState
PasswordState
    { _passwords :: Map UserId HashedPass
_passwords      = Map UserId HashedPass
forall k a. Map k a
Map.empty
    }

------------------------------------------------------------------------------
-- AcidState PasswordState queries/updates
------------------------------------------------------------------------------

-- | set the password for 'UserId'
setPassword :: UserId     -- ^ UserId
            -> HashedPass -- ^ the hashed password
            -> Update PasswordState ()
setPassword :: UserId -> HashedPass -> Update PasswordState ()
setPassword UserId
userId HashedPass
hashedPass =
    (Map UserId HashedPass -> Identity (Map UserId HashedPass))
-> PasswordState -> Identity PasswordState
Iso' PasswordState (Map UserId HashedPass)
passwords ((Map UserId HashedPass -> Identity (Map UserId HashedPass))
 -> PasswordState -> Identity PasswordState)
-> ((Maybe HashedPass -> Identity (Maybe HashedPass))
    -> Map UserId HashedPass -> Identity (Map UserId HashedPass))
-> (Maybe HashedPass -> Identity (Maybe HashedPass))
-> PasswordState
-> Identity PasswordState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map UserId HashedPass)
-> Lens'
     (Map UserId HashedPass) (Maybe (IxValue (Map UserId HashedPass)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map UserId HashedPass)
UserId
userId ((Maybe HashedPass -> Identity (Maybe HashedPass))
 -> PasswordState -> Identity PasswordState)
-> HashedPass -> Update PasswordState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= HashedPass
hashedPass

-- | delete the password for 'UserId'
deletePassword :: UserId     -- ^ UserId
            -> Update PasswordState ()
deletePassword :: UserId -> Update PasswordState ()
deletePassword UserId
userId =
    (Map UserId HashedPass -> Identity (Map UserId HashedPass))
-> PasswordState -> Identity PasswordState
Iso' PasswordState (Map UserId HashedPass)
passwords ((Map UserId HashedPass -> Identity (Map UserId HashedPass))
 -> PasswordState -> Identity PasswordState)
-> ((Maybe HashedPass -> Identity (Maybe HashedPass))
    -> Map UserId HashedPass -> Identity (Map UserId HashedPass))
-> (Maybe HashedPass -> Identity (Maybe HashedPass))
-> PasswordState
-> Identity PasswordState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map UserId HashedPass)
-> Lens'
     (Map UserId HashedPass) (Maybe (IxValue (Map UserId HashedPass)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map UserId HashedPass)
UserId
userId ((Maybe HashedPass -> Identity (Maybe HashedPass))
 -> PasswordState -> Identity PasswordState)
-> Maybe HashedPass -> Update PasswordState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe HashedPass
forall a. Maybe a
Nothing

-- | verify that the supplied password matches the stored hashed password for 'UserId'
verifyPasswordForUserId :: UserId -- ^ UserId
                        -> Text   -- ^ plain-text password
                        -> Query PasswordState Bool
verifyPasswordForUserId :: UserId -> Text -> Query PasswordState Bool
verifyPasswordForUserId UserId
userId Text
plainPassword =
    do Maybe HashedPass
mHashed <- Getting (Maybe HashedPass) PasswordState (Maybe HashedPass)
-> Query PasswordState (Maybe HashedPass)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map UserId HashedPass
 -> Const (Maybe HashedPass) (Map UserId HashedPass))
-> PasswordState -> Const (Maybe HashedPass) PasswordState
Iso' PasswordState (Map UserId HashedPass)
passwords ((Map UserId HashedPass
  -> Const (Maybe HashedPass) (Map UserId HashedPass))
 -> PasswordState -> Const (Maybe HashedPass) PasswordState)
-> ((Maybe HashedPass
     -> Const (Maybe HashedPass) (Maybe HashedPass))
    -> Map UserId HashedPass
    -> Const (Maybe HashedPass) (Map UserId HashedPass))
-> Getting (Maybe HashedPass) PasswordState (Maybe HashedPass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map UserId HashedPass)
-> Lens'
     (Map UserId HashedPass) (Maybe (IxValue (Map UserId HashedPass)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map UserId HashedPass)
UserId
userId)
       case Maybe HashedPass
mHashed of
         Maybe HashedPass
Nothing       -> Bool -> Query PasswordState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         (Just HashedPass
hashed) -> Bool -> Query PasswordState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HashedPass -> Bool
verifyHashedPass Text
plainPassword HashedPass
hashed)

makeAcidic ''PasswordState
    [ 'setPassword
    , 'deletePassword
    , 'verifyPasswordForUserId
    ]

------------------------------------------------------------------------------
-- Functions
------------------------------------------------------------------------------

-- | verify that the supplied username/password is valid
verifyPassword :: (MonadIO m) =>
                  AcidState AuthenticateState
               -> AcidState PasswordState
               -> Username
               -> Text
               -> m Bool
verifyPassword :: AcidState AuthenticateState
-> AcidState PasswordState -> Username -> Text -> m Bool
verifyPassword AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState Username
username Text
password =
    do Maybe User
mUser <- AcidState (EventState GetUserByUsername)
-> GetUserByUsername -> m (EventResult GetUserByUsername)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState GetUserByUsername)
AcidState AuthenticateState
authenticateState (Username -> GetUserByUsername
GetUserByUsername Username
username)
       case Maybe User
mUser of
         Maybe User
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         (Just User
user) ->
             AcidState (EventState VerifyPasswordForUserId)
-> VerifyPasswordForUserId
-> m (EventResult VerifyPasswordForUserId)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState VerifyPasswordForUserId)
AcidState PasswordState
passwordState (UserId -> Text -> VerifyPasswordForUserId
VerifyPasswordForUserId (Getting UserId User UserId -> User -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId User UserId
Lens' User UserId
userId User
user) Text
password)

------------------------------------------------------------------------------
-- API
------------------------------------------------------------------------------

data UserPass = UserPass
    { UserPass -> Username
_user     :: Username
    , UserPass -> Text
_password :: Text
    }
    deriving (UserPass -> UserPass -> Bool
(UserPass -> UserPass -> Bool)
-> (UserPass -> UserPass -> Bool) -> Eq UserPass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPass -> UserPass -> Bool
$c/= :: UserPass -> UserPass -> Bool
== :: UserPass -> UserPass -> Bool
$c== :: UserPass -> UserPass -> Bool
Eq, Eq UserPass
Eq UserPass
-> (UserPass -> UserPass -> Ordering)
-> (UserPass -> UserPass -> Bool)
-> (UserPass -> UserPass -> Bool)
-> (UserPass -> UserPass -> Bool)
-> (UserPass -> UserPass -> Bool)
-> (UserPass -> UserPass -> UserPass)
-> (UserPass -> UserPass -> UserPass)
-> Ord UserPass
UserPass -> UserPass -> Bool
UserPass -> UserPass -> Ordering
UserPass -> UserPass -> UserPass
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
min :: UserPass -> UserPass -> UserPass
$cmin :: UserPass -> UserPass -> UserPass
max :: UserPass -> UserPass -> UserPass
$cmax :: UserPass -> UserPass -> UserPass
>= :: UserPass -> UserPass -> Bool
$c>= :: UserPass -> UserPass -> Bool
> :: UserPass -> UserPass -> Bool
$c> :: UserPass -> UserPass -> Bool
<= :: UserPass -> UserPass -> Bool
$c<= :: UserPass -> UserPass -> Bool
< :: UserPass -> UserPass -> Bool
$c< :: UserPass -> UserPass -> Bool
compare :: UserPass -> UserPass -> Ordering
$ccompare :: UserPass -> UserPass -> Ordering
$cp1Ord :: Eq UserPass
Ord, ReadPrec [UserPass]
ReadPrec UserPass
Int -> ReadS UserPass
ReadS [UserPass]
(Int -> ReadS UserPass)
-> ReadS [UserPass]
-> ReadPrec UserPass
-> ReadPrec [UserPass]
-> Read UserPass
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserPass]
$creadListPrec :: ReadPrec [UserPass]
readPrec :: ReadPrec UserPass
$creadPrec :: ReadPrec UserPass
readList :: ReadS [UserPass]
$creadList :: ReadS [UserPass]
readsPrec :: Int -> ReadS UserPass
$creadsPrec :: Int -> ReadS UserPass
Read, Int -> UserPass -> ShowS
[UserPass] -> ShowS
UserPass -> String
(Int -> UserPass -> ShowS)
-> (UserPass -> String) -> ([UserPass] -> ShowS) -> Show UserPass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPass] -> ShowS
$cshowList :: [UserPass] -> ShowS
show :: UserPass -> String
$cshow :: UserPass -> String
showsPrec :: Int -> UserPass -> ShowS
$cshowsPrec :: Int -> UserPass -> ShowS
Show, Typeable UserPass
DataType
Constr
Typeable UserPass
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UserPass -> c UserPass)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UserPass)
-> (UserPass -> Constr)
-> (UserPass -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UserPass))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserPass))
-> ((forall b. Data b => b -> b) -> UserPass -> UserPass)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UserPass -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UserPass -> r)
-> (forall u. (forall d. Data d => d -> u) -> UserPass -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UserPass -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UserPass -> m UserPass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserPass -> m UserPass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserPass -> m UserPass)
-> Data UserPass
UserPass -> DataType
UserPass -> Constr
(forall b. Data b => b -> b) -> UserPass -> UserPass
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserPass -> c UserPass
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserPass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UserPass -> u
forall u. (forall d. Data d => d -> u) -> UserPass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserPass -> m UserPass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserPass -> m UserPass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserPass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserPass -> c UserPass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserPass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserPass)
$cUserPass :: Constr
$tUserPass :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UserPass -> m UserPass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserPass -> m UserPass
gmapMp :: (forall d. Data d => d -> m d) -> UserPass -> m UserPass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserPass -> m UserPass
gmapM :: (forall d. Data d => d -> m d) -> UserPass -> m UserPass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserPass -> m UserPass
gmapQi :: Int -> (forall d. Data d => d -> u) -> UserPass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserPass -> u
gmapQ :: (forall d. Data d => d -> u) -> UserPass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserPass -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserPass -> r
gmapT :: (forall b. Data b => b -> b) -> UserPass -> UserPass
$cgmapT :: (forall b. Data b => b -> b) -> UserPass -> UserPass
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserPass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserPass)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UserPass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserPass)
dataTypeOf :: UserPass -> DataType
$cdataTypeOf :: UserPass -> DataType
toConstr :: UserPass -> Constr
$ctoConstr :: UserPass -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserPass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserPass
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserPass -> c UserPass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserPass -> c UserPass
$cp1Data :: Typeable UserPass
Data, Typeable, (forall x. UserPass -> Rep UserPass x)
-> (forall x. Rep UserPass x -> UserPass) -> Generic UserPass
forall x. Rep UserPass x -> UserPass
forall x. UserPass -> Rep UserPass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserPass x -> UserPass
$cfrom :: forall x. UserPass -> Rep UserPass x
Generic)
makeLenses ''UserPass
instance ToJSON   UserPass where toJSON :: UserPass -> Value
toJSON    = Options -> UserPass -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON UserPass where parseJSON :: Value -> Parser UserPass
parseJSON = Options -> Value -> Parser UserPass
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

instance ToJExpr UserPass where
    toJExpr :: UserPass -> JExpr
toJExpr = Value -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Value -> JExpr) -> (UserPass -> Value) -> UserPass -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserPass -> Value
forall a. ToJSON a => a -> Value
toJSON

------------------------------------------------------------------------------
-- token
------------------------------------------------------------------------------

token :: (Happstack m) =>
         AcidState AuthenticateState
      -> AuthenticateConfig
      -> AcidState PasswordState
      -> m Response
token :: AcidState AuthenticateState
-> AuthenticateConfig -> AcidState PasswordState -> m Response
token AcidState AuthenticateState
authenticateState AuthenticateConfig
authenticateConfig AcidState PasswordState
passwordState =
  do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
     ~(Just (Body Tag
body)) <- Request -> m (Maybe RqBody)
forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
takeRequestBody (Request -> m (Maybe RqBody)) -> m Request -> m (Maybe RqBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
     case Tag -> Maybe UserPass
forall a. FromJSON a => Tag -> Maybe a
Aeson.decode Tag
body of
       Maybe UserPass
Nothing   -> Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ PasswordError -> Response
forall e.
RenderMessage HappstackAuthenticateI18N e =>
e -> Response
toJSONError (CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed)
       (Just (UserPass Username
username Text
password)) ->
         do Maybe User
mUser <- AcidState (EventState GetUserByUsername)
-> GetUserByUsername -> m (EventResult GetUserByUsername)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState GetUserByUsername)
AcidState AuthenticateState
authenticateState (Username -> GetUserByUsername
GetUserByUsername Username
username)
            case Maybe User
mUser of
              Maybe User
Nothing -> Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ PasswordError -> Response
forall e.
RenderMessage HappstackAuthenticateI18N e =>
e -> Response
toJSONError PasswordError
InvalidPassword
              (Just User
u) ->
                do Bool
valid <- AcidState (EventState VerifyPasswordForUserId)
-> VerifyPasswordForUserId
-> m (EventResult VerifyPasswordForUserId)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState VerifyPasswordForUserId)
AcidState PasswordState
passwordState (UserId -> Text -> VerifyPasswordForUserId
VerifyPasswordForUserId (User
u User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId) Text
password)
                   if Bool -> Bool
not Bool
valid
                     then Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
unauthorized (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ PasswordError -> Response
forall e.
RenderMessage HappstackAuthenticateI18N e =>
e -> Response
toJSONError PasswordError
InvalidUsernamePassword
                     else do Text
token <- AcidState AuthenticateState -> AuthenticateConfig -> User -> m Text
forall (m :: * -> *).
Happstack m =>
AcidState AuthenticateState -> AuthenticateConfig -> User -> m Text
addTokenCookie AcidState AuthenticateState
authenticateState AuthenticateConfig
authenticateConfig User
u
                             Int -> Response -> m Response
forall (m :: * -> *) b. FilterMonad Response m => Int -> b -> m b
resp Int
201 (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Value -> Response
forall a. ToJSON a => a -> Response
toJSONSuccess (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text
"token", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
token)]) -- toResponseBS "application/json" $ encode $ Object $ HashMap.fromList [("token", toJSON token)]

------------------------------------------------------------------------------
-- account
------------------------------------------------------------------------------

-- | JSON record for new account data
data NewAccountData = NewAccountData
    { NewAccountData -> User
_naUser            :: User
    , NewAccountData -> Text
_naPassword        :: Text
    , NewAccountData -> Text
_naPasswordConfirm :: Text
    }
    deriving (NewAccountData -> NewAccountData -> Bool
(NewAccountData -> NewAccountData -> Bool)
-> (NewAccountData -> NewAccountData -> Bool) -> Eq NewAccountData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewAccountData -> NewAccountData -> Bool
$c/= :: NewAccountData -> NewAccountData -> Bool
== :: NewAccountData -> NewAccountData -> Bool
$c== :: NewAccountData -> NewAccountData -> Bool
Eq, Eq NewAccountData
Eq NewAccountData
-> (NewAccountData -> NewAccountData -> Ordering)
-> (NewAccountData -> NewAccountData -> Bool)
-> (NewAccountData -> NewAccountData -> Bool)
-> (NewAccountData -> NewAccountData -> Bool)
-> (NewAccountData -> NewAccountData -> Bool)
-> (NewAccountData -> NewAccountData -> NewAccountData)
-> (NewAccountData -> NewAccountData -> NewAccountData)
-> Ord NewAccountData
NewAccountData -> NewAccountData -> Bool
NewAccountData -> NewAccountData -> Ordering
NewAccountData -> NewAccountData -> NewAccountData
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
min :: NewAccountData -> NewAccountData -> NewAccountData
$cmin :: NewAccountData -> NewAccountData -> NewAccountData
max :: NewAccountData -> NewAccountData -> NewAccountData
$cmax :: NewAccountData -> NewAccountData -> NewAccountData
>= :: NewAccountData -> NewAccountData -> Bool
$c>= :: NewAccountData -> NewAccountData -> Bool
> :: NewAccountData -> NewAccountData -> Bool
$c> :: NewAccountData -> NewAccountData -> Bool
<= :: NewAccountData -> NewAccountData -> Bool
$c<= :: NewAccountData -> NewAccountData -> Bool
< :: NewAccountData -> NewAccountData -> Bool
$c< :: NewAccountData -> NewAccountData -> Bool
compare :: NewAccountData -> NewAccountData -> Ordering
$ccompare :: NewAccountData -> NewAccountData -> Ordering
$cp1Ord :: Eq NewAccountData
Ord, ReadPrec [NewAccountData]
ReadPrec NewAccountData
Int -> ReadS NewAccountData
ReadS [NewAccountData]
(Int -> ReadS NewAccountData)
-> ReadS [NewAccountData]
-> ReadPrec NewAccountData
-> ReadPrec [NewAccountData]
-> Read NewAccountData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NewAccountData]
$creadListPrec :: ReadPrec [NewAccountData]
readPrec :: ReadPrec NewAccountData
$creadPrec :: ReadPrec NewAccountData
readList :: ReadS [NewAccountData]
$creadList :: ReadS [NewAccountData]
readsPrec :: Int -> ReadS NewAccountData
$creadsPrec :: Int -> ReadS NewAccountData
Read, Int -> NewAccountData -> ShowS
[NewAccountData] -> ShowS
NewAccountData -> String
(Int -> NewAccountData -> ShowS)
-> (NewAccountData -> String)
-> ([NewAccountData] -> ShowS)
-> Show NewAccountData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewAccountData] -> ShowS
$cshowList :: [NewAccountData] -> ShowS
show :: NewAccountData -> String
$cshow :: NewAccountData -> String
showsPrec :: Int -> NewAccountData -> ShowS
$cshowsPrec :: Int -> NewAccountData -> ShowS
Show, Typeable NewAccountData
DataType
Constr
Typeable NewAccountData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NewAccountData -> c NewAccountData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NewAccountData)
-> (NewAccountData -> Constr)
-> (NewAccountData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NewAccountData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NewAccountData))
-> ((forall b. Data b => b -> b)
    -> NewAccountData -> NewAccountData)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NewAccountData -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NewAccountData -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> NewAccountData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NewAccountData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> NewAccountData -> m NewAccountData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NewAccountData -> m NewAccountData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NewAccountData -> m NewAccountData)
-> Data NewAccountData
NewAccountData -> DataType
NewAccountData -> Constr
(forall b. Data b => b -> b) -> NewAccountData -> NewAccountData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewAccountData -> c NewAccountData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewAccountData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> NewAccountData -> u
forall u. (forall d. Data d => d -> u) -> NewAccountData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewAccountData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewAccountData -> c NewAccountData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewAccountData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NewAccountData)
$cNewAccountData :: Constr
$tNewAccountData :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
gmapMp :: (forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
gmapM :: (forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NewAccountData -> m NewAccountData
gmapQi :: Int -> (forall d. Data d => d -> u) -> NewAccountData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NewAccountData -> u
gmapQ :: (forall d. Data d => d -> u) -> NewAccountData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NewAccountData -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewAccountData -> r
gmapT :: (forall b. Data b => b -> b) -> NewAccountData -> NewAccountData
$cgmapT :: (forall b. Data b => b -> b) -> NewAccountData -> NewAccountData
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NewAccountData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NewAccountData)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NewAccountData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewAccountData)
dataTypeOf :: NewAccountData -> DataType
$cdataTypeOf :: NewAccountData -> DataType
toConstr :: NewAccountData -> Constr
$ctoConstr :: NewAccountData -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewAccountData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewAccountData
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewAccountData -> c NewAccountData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewAccountData -> c NewAccountData
$cp1Data :: Typeable NewAccountData
Data, Typeable, (forall x. NewAccountData -> Rep NewAccountData x)
-> (forall x. Rep NewAccountData x -> NewAccountData)
-> Generic NewAccountData
forall x. Rep NewAccountData x -> NewAccountData
forall x. NewAccountData -> Rep NewAccountData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewAccountData x -> NewAccountData
$cfrom :: forall x. NewAccountData -> Rep NewAccountData x
Generic)
makeLenses ''NewAccountData
instance ToJSON   NewAccountData where toJSON :: NewAccountData -> Value
toJSON    = Options -> NewAccountData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON NewAccountData where parseJSON :: Value -> Parser NewAccountData
parseJSON = Options -> Value -> Parser NewAccountData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

-- | JSON record for change password data
data ChangePasswordData = ChangePasswordData
    { ChangePasswordData -> Text
_cpOldPassword        :: Text
    , ChangePasswordData -> Text
_cpNewPassword        :: Text
    , ChangePasswordData -> Text
_cpNewPasswordConfirm :: Text
    }
    deriving (ChangePasswordData -> ChangePasswordData -> Bool
(ChangePasswordData -> ChangePasswordData -> Bool)
-> (ChangePasswordData -> ChangePasswordData -> Bool)
-> Eq ChangePasswordData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangePasswordData -> ChangePasswordData -> Bool
$c/= :: ChangePasswordData -> ChangePasswordData -> Bool
== :: ChangePasswordData -> ChangePasswordData -> Bool
$c== :: ChangePasswordData -> ChangePasswordData -> Bool
Eq, Eq ChangePasswordData
Eq ChangePasswordData
-> (ChangePasswordData -> ChangePasswordData -> Ordering)
-> (ChangePasswordData -> ChangePasswordData -> Bool)
-> (ChangePasswordData -> ChangePasswordData -> Bool)
-> (ChangePasswordData -> ChangePasswordData -> Bool)
-> (ChangePasswordData -> ChangePasswordData -> Bool)
-> (ChangePasswordData -> ChangePasswordData -> ChangePasswordData)
-> (ChangePasswordData -> ChangePasswordData -> ChangePasswordData)
-> Ord ChangePasswordData
ChangePasswordData -> ChangePasswordData -> Bool
ChangePasswordData -> ChangePasswordData -> Ordering
ChangePasswordData -> ChangePasswordData -> ChangePasswordData
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
min :: ChangePasswordData -> ChangePasswordData -> ChangePasswordData
$cmin :: ChangePasswordData -> ChangePasswordData -> ChangePasswordData
max :: ChangePasswordData -> ChangePasswordData -> ChangePasswordData
$cmax :: ChangePasswordData -> ChangePasswordData -> ChangePasswordData
>= :: ChangePasswordData -> ChangePasswordData -> Bool
$c>= :: ChangePasswordData -> ChangePasswordData -> Bool
> :: ChangePasswordData -> ChangePasswordData -> Bool
$c> :: ChangePasswordData -> ChangePasswordData -> Bool
<= :: ChangePasswordData -> ChangePasswordData -> Bool
$c<= :: ChangePasswordData -> ChangePasswordData -> Bool
< :: ChangePasswordData -> ChangePasswordData -> Bool
$c< :: ChangePasswordData -> ChangePasswordData -> Bool
compare :: ChangePasswordData -> ChangePasswordData -> Ordering
$ccompare :: ChangePasswordData -> ChangePasswordData -> Ordering
$cp1Ord :: Eq ChangePasswordData
Ord, ReadPrec [ChangePasswordData]
ReadPrec ChangePasswordData
Int -> ReadS ChangePasswordData
ReadS [ChangePasswordData]
(Int -> ReadS ChangePasswordData)
-> ReadS [ChangePasswordData]
-> ReadPrec ChangePasswordData
-> ReadPrec [ChangePasswordData]
-> Read ChangePasswordData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangePasswordData]
$creadListPrec :: ReadPrec [ChangePasswordData]
readPrec :: ReadPrec ChangePasswordData
$creadPrec :: ReadPrec ChangePasswordData
readList :: ReadS [ChangePasswordData]
$creadList :: ReadS [ChangePasswordData]
readsPrec :: Int -> ReadS ChangePasswordData
$creadsPrec :: Int -> ReadS ChangePasswordData
Read, Int -> ChangePasswordData -> ShowS
[ChangePasswordData] -> ShowS
ChangePasswordData -> String
(Int -> ChangePasswordData -> ShowS)
-> (ChangePasswordData -> String)
-> ([ChangePasswordData] -> ShowS)
-> Show ChangePasswordData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangePasswordData] -> ShowS
$cshowList :: [ChangePasswordData] -> ShowS
show :: ChangePasswordData -> String
$cshow :: ChangePasswordData -> String
showsPrec :: Int -> ChangePasswordData -> ShowS
$cshowsPrec :: Int -> ChangePasswordData -> ShowS
Show, Typeable ChangePasswordData
DataType
Constr
Typeable ChangePasswordData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ChangePasswordData
    -> c ChangePasswordData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChangePasswordData)
-> (ChangePasswordData -> Constr)
-> (ChangePasswordData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChangePasswordData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChangePasswordData))
-> ((forall b. Data b => b -> b)
    -> ChangePasswordData -> ChangePasswordData)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChangePasswordData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ChangePasswordData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChangePasswordData -> m ChangePasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChangePasswordData -> m ChangePasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChangePasswordData -> m ChangePasswordData)
-> Data ChangePasswordData
ChangePasswordData -> DataType
ChangePasswordData -> Constr
(forall b. Data b => b -> b)
-> ChangePasswordData -> ChangePasswordData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChangePasswordData
-> c ChangePasswordData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangePasswordData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ChangePasswordData -> u
forall u. (forall d. Data d => d -> u) -> ChangePasswordData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangePasswordData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChangePasswordData
-> c ChangePasswordData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChangePasswordData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChangePasswordData)
$cChangePasswordData :: Constr
$tChangePasswordData :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
gmapMp :: (forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
gmapM :: (forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChangePasswordData -> m ChangePasswordData
gmapQi :: Int -> (forall d. Data d => d -> u) -> ChangePasswordData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChangePasswordData -> u
gmapQ :: (forall d. Data d => d -> u) -> ChangePasswordData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ChangePasswordData -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangePasswordData -> r
gmapT :: (forall b. Data b => b -> b)
-> ChangePasswordData -> ChangePasswordData
$cgmapT :: (forall b. Data b => b -> b)
-> ChangePasswordData -> ChangePasswordData
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChangePasswordData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChangePasswordData)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ChangePasswordData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChangePasswordData)
dataTypeOf :: ChangePasswordData -> DataType
$cdataTypeOf :: ChangePasswordData -> DataType
toConstr :: ChangePasswordData -> Constr
$ctoConstr :: ChangePasswordData -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangePasswordData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangePasswordData
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChangePasswordData
-> c ChangePasswordData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ChangePasswordData
-> c ChangePasswordData
$cp1Data :: Typeable ChangePasswordData
Data, Typeable, (forall x. ChangePasswordData -> Rep ChangePasswordData x)
-> (forall x. Rep ChangePasswordData x -> ChangePasswordData)
-> Generic ChangePasswordData
forall x. Rep ChangePasswordData x -> ChangePasswordData
forall x. ChangePasswordData -> Rep ChangePasswordData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangePasswordData x -> ChangePasswordData
$cfrom :: forall x. ChangePasswordData -> Rep ChangePasswordData x
Generic)
makeLenses ''ChangePasswordData
instance ToJSON   ChangePasswordData where toJSON :: ChangePasswordData -> Value
toJSON    = Options -> ChangePasswordData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON ChangePasswordData where parseJSON :: Value -> Parser ChangePasswordData
parseJSON = Options -> Value -> Parser ChangePasswordData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

-- | account handler
account :: (Happstack m) =>
           AcidState AuthenticateState
        -> AcidState PasswordState
        -> AuthenticateConfig
        -> PasswordConfig
        -> Maybe (UserId, AccountURL)
        -> m (Either PasswordError UserId)
-- handle new account creation via POST to \/account
-- FIXME: check that password and password confirmation match
account :: AcidState AuthenticateState
-> AcidState PasswordState
-> AuthenticateConfig
-> PasswordConfig
-> Maybe (UserId, AccountURL)
-> m (Either PasswordError UserId)
account AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState AuthenticateConfig
authenticateConfig PasswordConfig
passwordConfig Maybe (UserId, AccountURL)
Nothing =
  do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
     ~(Just (Body Tag
body)) <- Request -> m (Maybe RqBody)
forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
takeRequestBody (Request -> m (Maybe RqBody)) -> m Request -> m (Maybe RqBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
     case Tag -> Maybe NewAccountData
forall a. FromJSON a => Tag -> Maybe a
Aeson.decode Tag
body of
       Maybe NewAccountData
Nothing               -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError UserId)
-> PasswordError -> Either PasswordError UserId
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed)
       (Just NewAccountData
newAccount) ->
           case (AuthenticateConfig
authenticateConfig AuthenticateConfig
-> Getting
     (Username -> Maybe CoreError)
     AuthenticateConfig
     (Username -> Maybe CoreError)
-> Username
-> Maybe CoreError
forall s a. s -> Getting a s a -> a
^. Getting
  (Username -> Maybe CoreError)
  AuthenticateConfig
  (Username -> Maybe CoreError)
Lens' AuthenticateConfig (Username -> Maybe CoreError)
usernameAcceptable) (NewAccountData
newAccount NewAccountData -> Getting User NewAccountData User -> User
forall s a. s -> Getting a s a -> a
^. Getting User NewAccountData User
Lens' NewAccountData User
naUser User -> Getting Username User Username -> Username
forall s a. s -> Getting a s a -> a
^. Getting Username User Username
Lens' User Username
username) of
             (Just CoreError
e) -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (CoreError -> PasswordError
CoreError CoreError
e)
             Maybe CoreError
Nothing ->
                 case Bool -> Maybe Email -> Maybe PasswordError
validEmail (AuthenticateConfig
authenticateConfig AuthenticateConfig -> Getting Bool AuthenticateConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AuthenticateConfig Bool
Lens' AuthenticateConfig Bool
requireEmail) (NewAccountData
newAccount NewAccountData -> Getting User NewAccountData User -> User
forall s a. s -> Getting a s a -> a
^. Getting User NewAccountData User
Lens' NewAccountData User
naUser User -> Getting (Maybe Email) User (Maybe Email) -> Maybe Email
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Email) User (Maybe Email)
Lens' User (Maybe Email)
email) of
                   (Just PasswordError
e) -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
e
                   Maybe PasswordError
Nothing ->
                         if (NewAccountData
newAccount NewAccountData -> Getting Text NewAccountData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text NewAccountData Text
Lens' NewAccountData Text
naPassword Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= NewAccountData
newAccount NewAccountData -> Getting Text NewAccountData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text NewAccountData Text
Lens' NewAccountData Text
naPasswordConfirm)
                         then Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
PasswordMismatch
                         else case (PasswordConfig
passwordConfig PasswordConfig
-> Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
-> Text
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
Lens' PasswordConfig (Text -> Maybe Text)
passwordAcceptable) (NewAccountData
newAccount NewAccountData -> Getting Text NewAccountData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text NewAccountData Text
Lens' NewAccountData Text
naPassword) of
                                (Just Text
passwdError) -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (Text -> PasswordError
UnacceptablePassword Text
passwdError)
                                Maybe Text
Nothing -> do
                                  Either CoreError User
eUser <- AcidState (EventState CreateUser)
-> CreateUser -> m (EventResult CreateUser)
forall event (m :: * -> *).
(UpdateEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
update' AcidState (EventState CreateUser)
AcidState AuthenticateState
authenticateState (User -> CreateUser
CreateUser (User -> CreateUser) -> User -> CreateUser
forall a b. (a -> b) -> a -> b
$ NewAccountData -> User
_naUser NewAccountData
newAccount)
                                  case Either CoreError User
eUser of
                                    (Left CoreError
e) -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (CoreError -> PasswordError
CoreError CoreError
e)
                                    (Right User
user) -> do
                                       HashedPass
hashed <- Text -> m HashedPass
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Text -> m HashedPass
mkHashedPass (NewAccountData -> Text
_naPassword NewAccountData
newAccount)
                                       AcidState (EventState SetPassword)
-> SetPassword -> m (EventResult SetPassword)
forall event (m :: * -> *).
(UpdateEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
update' AcidState (EventState SetPassword)
AcidState PasswordState
passwordState (UserId -> HashedPass -> SetPassword
SetPassword (User
user User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId) HashedPass
hashed)
                                       case (AuthenticateConfig
authenticateConfig AuthenticateConfig
-> Getting
     (Maybe (User -> IO ())) AuthenticateConfig (Maybe (User -> IO ()))
-> Maybe (User -> IO ())
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (User -> IO ())) AuthenticateConfig (Maybe (User -> IO ()))
Lens' AuthenticateConfig (Maybe (User -> IO ()))
createUserCallback) of
                                         Maybe (User -> IO ())
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                         (Just User -> IO ()
callback) -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ User -> IO ()
callback User
user
                                       Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ (UserId -> Either PasswordError UserId
forall a b. b -> Either a b
Right (User
user User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId))
    where
      validEmail :: Bool -> Maybe Email -> Maybe PasswordError
      validEmail :: Bool -> Maybe Email -> Maybe PasswordError
validEmail Bool
required Maybe Email
mEmail =
          case (Bool
required, Maybe Email
mEmail) of
            (Bool
True, Maybe Email
Nothing) -> PasswordError -> Maybe PasswordError
forall a. a -> Maybe a
Just (PasswordError -> Maybe PasswordError)
-> PasswordError -> Maybe PasswordError
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
InvalidEmail
            (Bool
False, Just (Email Text
"")) -> Maybe PasswordError
forall a. Maybe a
Nothing
            (Bool
False, Maybe Email
Nothing) -> Maybe PasswordError
forall a. Maybe a
Nothing
            (Bool
_, Just Email
email) -> if ByteString -> Bool
Email.isValid (Text -> ByteString
Text.encodeUtf8 (Email
email Email -> Getting Text Email Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Email Text
Iso' Email Text
unEmail)) then Maybe PasswordError
forall a. Maybe a
Nothing else PasswordError -> Maybe PasswordError
forall a. a -> Maybe a
Just (PasswordError -> Maybe PasswordError)
-> PasswordError -> Maybe PasswordError
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
InvalidEmail

--  handle updates to '/account/<userId>/*'
account AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState AuthenticateConfig
authenticateConfig PasswordConfig
passwordConfig (Just (UserId
uid, AccountURL
url)) =
  case AccountURL
url of
    AccountURL
Password ->
      do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
         Maybe (Token, JWT VerifiedJWT)
mUser <- AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
forall (m :: * -> *).
Happstack m =>
AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
getToken AcidState AuthenticateState
authenticateState
         case Maybe (Token, JWT VerifiedJWT)
mUser of
           Maybe (Token, JWT VerifiedJWT)
Nothing     -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
unauthorized (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
NotAuthenticated)
           (Just (Token
token, JWT VerifiedJWT
_)) ->
             -- here we could have fancier policies that allow super-users to change passwords
             if ((Token
token Token -> Getting User Token User -> User
forall s a. s -> Getting a s a -> a
^. Getting User Token User
Lens' Token User
tokenUser User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId) UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
uid)
              then Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
NotAuthorized)
              else do Maybe RqBody
mBody <- Request -> m (Maybe RqBody)
forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
takeRequestBody (Request -> m (Maybe RqBody)) -> m Request -> m (Maybe RqBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
                      case Maybe RqBody
mBody of
                        Maybe RqBody
Nothing     -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError UserId)
-> PasswordError -> Either PasswordError UserId
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed)
                        ~(Just (Body Tag
body)) ->
                          case Tag -> Maybe ChangePasswordData
forall a. FromJSON a => Tag -> Maybe a
Aeson.decode Tag
body of
                            Maybe ChangePasswordData
Nothing -> do -- liftIO $ print body
                                          Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError UserId)
-> PasswordError -> Either PasswordError UserId
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed)
                            (Just ChangePasswordData
changePassword) ->
                              do Bool
b <- AcidState AuthenticateState
-> AcidState PasswordState -> Username -> Text -> m Bool
forall (m :: * -> *).
MonadIO m =>
AcidState AuthenticateState
-> AcidState PasswordState -> Username -> Text -> m Bool
verifyPassword AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState (Token
token Token -> Getting User Token User -> User
forall s a. s -> Getting a s a -> a
^. Getting User Token User
Lens' Token User
tokenUser User -> Getting Username User Username -> Username
forall s a. s -> Getting a s a -> a
^. Getting Username User Username
Lens' User Username
username) (ChangePasswordData
changePassword ChangePasswordData -> Getting Text ChangePasswordData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ChangePasswordData Text
Lens' ChangePasswordData Text
cpOldPassword)
                                 if Bool -> Bool
not Bool
b
                                   then Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
InvalidPassword)
                                   else if (ChangePasswordData
changePassword ChangePasswordData -> Getting Text ChangePasswordData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ChangePasswordData Text
Lens' ChangePasswordData Text
cpNewPassword Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ChangePasswordData
changePassword ChangePasswordData -> Getting Text ChangePasswordData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ChangePasswordData Text
Lens' ChangePasswordData Text
cpNewPasswordConfirm)
                                        then Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left PasswordError
PasswordMismatch)
                                        else case (PasswordConfig
passwordConfig PasswordConfig
-> Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
-> Text
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
Lens' PasswordConfig (Text -> Maybe Text)
passwordAcceptable) (ChangePasswordData
changePassword ChangePasswordData -> Getting Text ChangePasswordData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ChangePasswordData Text
Lens' ChangePasswordData Text
cpNewPassword) of
                                               (Just Text
e) -> Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (PasswordError -> Either PasswordError UserId
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError UserId)
-> PasswordError -> Either PasswordError UserId
forall a b. (a -> b) -> a -> b
$ Text -> PasswordError
UnacceptablePassword Text
e)
                                               Maybe Text
Nothing -> do
                                                   HashedPass
pw <- Text -> m HashedPass
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Text -> m HashedPass
mkHashedPass (ChangePasswordData
changePassword ChangePasswordData -> Getting Text ChangePasswordData Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ChangePasswordData Text
Lens' ChangePasswordData Text
cpNewPassword)
                                                   AcidState (EventState SetPassword)
-> SetPassword -> m (EventResult SetPassword)
forall event (m :: * -> *).
(UpdateEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
update' AcidState (EventState SetPassword)
AcidState PasswordState
passwordState (UserId -> HashedPass -> SetPassword
SetPassword UserId
uid HashedPass
pw)
                                                   Either PasswordError UserId -> m (Either PasswordError UserId)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError UserId -> m (Either PasswordError UserId))
-> Either PasswordError UserId -> m (Either PasswordError UserId)
forall a b. (a -> b) -> a -> b
$ (UserId -> Either PasswordError UserId
forall a b. b -> Either a b
Right UserId
uid)

------------------------------------------------------------------------------
-- passwordReset
------------------------------------------------------------------------------

-- | JSON record for new account data
data RequestResetPasswordData = RequestResetPasswordData
    { RequestResetPasswordData -> Username
_rrpUsername :: Username
    }
    deriving (RequestResetPasswordData -> RequestResetPasswordData -> Bool
(RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> (RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> Eq RequestResetPasswordData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c/= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
== :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c== :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
Eq, Eq RequestResetPasswordData
Eq RequestResetPasswordData
-> (RequestResetPasswordData
    -> RequestResetPasswordData -> Ordering)
-> (RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> (RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> (RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> (RequestResetPasswordData -> RequestResetPasswordData -> Bool)
-> (RequestResetPasswordData
    -> RequestResetPasswordData -> RequestResetPasswordData)
-> (RequestResetPasswordData
    -> RequestResetPasswordData -> RequestResetPasswordData)
-> Ord RequestResetPasswordData
RequestResetPasswordData -> RequestResetPasswordData -> Bool
RequestResetPasswordData -> RequestResetPasswordData -> Ordering
RequestResetPasswordData
-> RequestResetPasswordData -> RequestResetPasswordData
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
min :: RequestResetPasswordData
-> RequestResetPasswordData -> RequestResetPasswordData
$cmin :: RequestResetPasswordData
-> RequestResetPasswordData -> RequestResetPasswordData
max :: RequestResetPasswordData
-> RequestResetPasswordData -> RequestResetPasswordData
$cmax :: RequestResetPasswordData
-> RequestResetPasswordData -> RequestResetPasswordData
>= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c>= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
> :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c> :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
<= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c<= :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
< :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
$c< :: RequestResetPasswordData -> RequestResetPasswordData -> Bool
compare :: RequestResetPasswordData -> RequestResetPasswordData -> Ordering
$ccompare :: RequestResetPasswordData -> RequestResetPasswordData -> Ordering
$cp1Ord :: Eq RequestResetPasswordData
Ord, ReadPrec [RequestResetPasswordData]
ReadPrec RequestResetPasswordData
Int -> ReadS RequestResetPasswordData
ReadS [RequestResetPasswordData]
(Int -> ReadS RequestResetPasswordData)
-> ReadS [RequestResetPasswordData]
-> ReadPrec RequestResetPasswordData
-> ReadPrec [RequestResetPasswordData]
-> Read RequestResetPasswordData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestResetPasswordData]
$creadListPrec :: ReadPrec [RequestResetPasswordData]
readPrec :: ReadPrec RequestResetPasswordData
$creadPrec :: ReadPrec RequestResetPasswordData
readList :: ReadS [RequestResetPasswordData]
$creadList :: ReadS [RequestResetPasswordData]
readsPrec :: Int -> ReadS RequestResetPasswordData
$creadsPrec :: Int -> ReadS RequestResetPasswordData
Read, Int -> RequestResetPasswordData -> ShowS
[RequestResetPasswordData] -> ShowS
RequestResetPasswordData -> String
(Int -> RequestResetPasswordData -> ShowS)
-> (RequestResetPasswordData -> String)
-> ([RequestResetPasswordData] -> ShowS)
-> Show RequestResetPasswordData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestResetPasswordData] -> ShowS
$cshowList :: [RequestResetPasswordData] -> ShowS
show :: RequestResetPasswordData -> String
$cshow :: RequestResetPasswordData -> String
showsPrec :: Int -> RequestResetPasswordData -> ShowS
$cshowsPrec :: Int -> RequestResetPasswordData -> ShowS
Show, Typeable RequestResetPasswordData
DataType
Constr
Typeable RequestResetPasswordData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RequestResetPasswordData
    -> c RequestResetPasswordData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RequestResetPasswordData)
-> (RequestResetPasswordData -> Constr)
-> (RequestResetPasswordData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RequestResetPasswordData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RequestResetPasswordData))
-> ((forall b. Data b => b -> b)
    -> RequestResetPasswordData -> RequestResetPasswordData)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RequestResetPasswordData
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RequestResetPasswordData
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RequestResetPasswordData -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RequestResetPasswordData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RequestResetPasswordData -> m RequestResetPasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RequestResetPasswordData -> m RequestResetPasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RequestResetPasswordData -> m RequestResetPasswordData)
-> Data RequestResetPasswordData
RequestResetPasswordData -> DataType
RequestResetPasswordData -> Constr
(forall b. Data b => b -> b)
-> RequestResetPasswordData -> RequestResetPasswordData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RequestResetPasswordData
-> c RequestResetPasswordData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestResetPasswordData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RequestResetPasswordData -> u
forall u.
(forall d. Data d => d -> u) -> RequestResetPasswordData -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestResetPasswordData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RequestResetPasswordData
-> c RequestResetPasswordData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestResetPasswordData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestResetPasswordData)
$cRequestResetPasswordData :: Constr
$tRequestResetPasswordData :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
gmapMp :: (forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
gmapM :: (forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RequestResetPasswordData -> m RequestResetPasswordData
gmapQi :: Int
-> (forall d. Data d => d -> u) -> RequestResetPasswordData -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RequestResetPasswordData -> u
gmapQ :: (forall d. Data d => d -> u) -> RequestResetPasswordData -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RequestResetPasswordData -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RequestResetPasswordData
-> r
gmapT :: (forall b. Data b => b -> b)
-> RequestResetPasswordData -> RequestResetPasswordData
$cgmapT :: (forall b. Data b => b -> b)
-> RequestResetPasswordData -> RequestResetPasswordData
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestResetPasswordData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestResetPasswordData)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RequestResetPasswordData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestResetPasswordData)
dataTypeOf :: RequestResetPasswordData -> DataType
$cdataTypeOf :: RequestResetPasswordData -> DataType
toConstr :: RequestResetPasswordData -> Constr
$ctoConstr :: RequestResetPasswordData -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestResetPasswordData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestResetPasswordData
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RequestResetPasswordData
-> c RequestResetPasswordData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RequestResetPasswordData
-> c RequestResetPasswordData
$cp1Data :: Typeable RequestResetPasswordData
Data, Typeable, (forall x.
 RequestResetPasswordData -> Rep RequestResetPasswordData x)
-> (forall x.
    Rep RequestResetPasswordData x -> RequestResetPasswordData)
-> Generic RequestResetPasswordData
forall x.
Rep RequestResetPasswordData x -> RequestResetPasswordData
forall x.
RequestResetPasswordData -> Rep RequestResetPasswordData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestResetPasswordData x -> RequestResetPasswordData
$cfrom :: forall x.
RequestResetPasswordData -> Rep RequestResetPasswordData x
Generic)
makeLenses ''RequestResetPasswordData
instance ToJSON   RequestResetPasswordData where toJSON :: RequestResetPasswordData -> Value
toJSON    = Options -> RequestResetPasswordData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON RequestResetPasswordData where parseJSON :: Value -> Parser RequestResetPasswordData
parseJSON = Options -> Value -> Parser RequestResetPasswordData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

-- | request reset password
passwordRequestReset :: (Happstack m) =>
                        AuthenticateConfig
                     -> PasswordConfig
                     -> AcidState AuthenticateState
                     -> AcidState PasswordState
                     -> m (Either PasswordError Text)
passwordRequestReset :: AuthenticateConfig
-> PasswordConfig
-> AcidState AuthenticateState
-> AcidState PasswordState
-> m (Either PasswordError Text)
passwordRequestReset AuthenticateConfig
authenticateConfig PasswordConfig
passwordConfig AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState =
  do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
     ~(Just (Body Tag
body)) <- Request -> m (Maybe RqBody)
forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
takeRequestBody (Request -> m (Maybe RqBody)) -> m Request -> m (Maybe RqBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
     case Tag -> Maybe RequestResetPasswordData
forall a. FromJSON a => Tag -> Maybe a
Aeson.decode Tag
body of
       Maybe RequestResetPasswordData
Nothing   -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError Text)
-> PasswordError -> Either PasswordError Text
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed
       (Just (RequestResetPasswordData Username
username)) ->
         do Maybe User
mUser <- AcidState (EventState GetUserByUsername)
-> GetUserByUsername -> m (EventResult GetUserByUsername)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState GetUserByUsername)
AcidState AuthenticateState
authenticateState (Username -> GetUserByUsername
GetUserByUsername Username
username)
            case Maybe User
mUser of
              Maybe User
Nothing     -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
notFound (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left PasswordError
InvalidUsername
              (Just User
user) ->
                case User
user User -> Getting (Maybe Email) User (Maybe Email) -> Maybe Email
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Email) User (Maybe Email)
Lens' User (Maybe Email)
email of
                  Maybe Email
Nothing -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left PasswordError
NoEmailAddress
                  (Just Email
toEm) ->
                    do Text
resetToken <- AcidState AuthenticateState -> User -> m Text
forall (m :: * -> *).
MonadIO m =>
AcidState AuthenticateState -> User -> m Text
issueResetToken AcidState AuthenticateState
authenticateState User
user
                       let resetLink' :: Text
resetLink' = Text -> Text -> Text
resetTokenLink (PasswordConfig
passwordConfig PasswordConfig -> Getting Text PasswordConfig Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text PasswordConfig Text
Lens' PasswordConfig Text
resetLink) Text
resetToken
                       -- liftIO $ Text.putStrLn resetLink' -- FIXME: don't print to stdout
                       let from :: SimpleAddress
from = SimpleAddress -> Maybe SimpleAddress -> SimpleAddress
forall a. a -> Maybe a -> a
fromMaybe (Maybe Text -> Email -> SimpleAddress
SimpleAddress Maybe Text
forall a. Maybe a
Nothing (Text -> Email
Email (Text
"no-reply@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (PasswordConfig
passwordConfig PasswordConfig -> Getting Text PasswordConfig Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text PasswordConfig Text
Lens' PasswordConfig Text
domain)))) (AuthenticateConfig
authenticateConfig AuthenticateConfig
-> Getting
     (Maybe SimpleAddress) AuthenticateConfig (Maybe SimpleAddress)
-> Maybe SimpleAddress
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe SimpleAddress) AuthenticateConfig (Maybe SimpleAddress)
Lens' AuthenticateConfig (Maybe SimpleAddress)
systemFromAddress)
                       Maybe String
-> Email -> SimpleAddress -> Maybe SimpleAddress -> Text -> m ()
forall (m :: * -> *).
MonadIO m =>
Maybe String
-> Email -> SimpleAddress -> Maybe SimpleAddress -> Text -> m ()
sendResetEmail (AuthenticateConfig
authenticateConfig AuthenticateConfig
-> Getting (Maybe String) AuthenticateConfig (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) AuthenticateConfig (Maybe String)
Lens' AuthenticateConfig (Maybe String)
systemSendmailPath) Email
toEm SimpleAddress
from (AuthenticateConfig
authenticateConfig AuthenticateConfig
-> Getting
     (Maybe SimpleAddress) AuthenticateConfig (Maybe SimpleAddress)
-> Maybe SimpleAddress
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe SimpleAddress) AuthenticateConfig (Maybe SimpleAddress)
Lens' AuthenticateConfig (Maybe SimpleAddress)
systemReplyToAddress) Text
resetLink'
                       Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either PasswordError Text
forall a b. b -> Either a b
Right Text
"password reset request email sent.") -- FIXME: I18N

-- | generate a reset token for a UserId
resetTokenForUserId :: Text -> AcidState AuthenticateState -> AcidState PasswordState -> UserId -> IO (Either PasswordError Text)
resetTokenForUserId :: Text
-> AcidState AuthenticateState
-> AcidState PasswordState
-> UserId
-> IO (Either PasswordError Text)
resetTokenForUserId Text
resetLink AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState UserId
userId =
  do Maybe User
mUser <- AcidState (EventState GetUserByUserId)
-> GetUserByUserId -> IO (EventResult GetUserByUserId)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState GetUserByUserId)
AcidState AuthenticateState
authenticateState (UserId -> GetUserByUserId
GetUserByUserId UserId
userId)
     case Maybe User
mUser of
       Maybe User
Nothing     -> Either PasswordError Text -> IO (Either PasswordError Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PasswordError Text -> IO (Either PasswordError Text))
-> Either PasswordError Text -> IO (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left (CoreError -> PasswordError
CoreError CoreError
InvalidUserId)
       (Just User
user) ->
         do Text
resetToken <- AcidState AuthenticateState -> User -> IO Text
forall (m :: * -> *).
MonadIO m =>
AcidState AuthenticateState -> User -> m Text
issueResetToken AcidState AuthenticateState
authenticateState User
user
            Either PasswordError Text -> IO (Either PasswordError Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PasswordError Text -> IO (Either PasswordError Text))
-> Either PasswordError Text -> IO (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either PasswordError Text
forall a b. b -> Either a b
Right (Text -> Either PasswordError Text)
-> Text -> Either PasswordError Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
resetTokenLink Text
resetLink Text
resetToken

-- | create a link for a reset token
resetTokenLink :: Text -- ^ base URI
               -> Text -- ^ reset token
               -> Text
resetTokenLink :: Text -> Text -> Text
resetTokenLink Text
baseURI Text
resetToken = Text
baseURI Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> ByteString
renderQuery Bool
True (Query -> ByteString) -> Query -> ByteString
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Query
forall a. QueryLike a => a -> Query
toQuery [(Text
"reset_token"::Text, Text
resetToken)])

-- | issueResetToken
issueResetToken :: (MonadIO m) =>
                   AcidState AuthenticateState
                -> User
                -> m Text
issueResetToken :: AcidState AuthenticateState -> User -> m Text
issueResetToken AcidState AuthenticateState
authenticateState User
user =
  do SharedSecret
ssecret <- AcidState AuthenticateState -> UserId -> m SharedSecret
forall (m :: * -> *).
MonadIO m =>
AcidState AuthenticateState -> UserId -> m SharedSecret
getOrGenSharedSecret AcidState AuthenticateState
authenticateState (User
user User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId)
     -- FIXME: add expiration time
     POSIXTime
now <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
     let claims :: JWTClaimsSet
claims = JWTClaimsSet :: Maybe StringOrURI
-> Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe IntDate
-> Maybe IntDate
-> Maybe IntDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet
JWT.JWTClaimsSet
                        { iss :: Maybe StringOrURI
JWT.iss = Maybe StringOrURI
forall a. Maybe a
Nothing
                        , sub :: Maybe StringOrURI
JWT.sub = Maybe StringOrURI
forall a. Maybe a
Nothing
                        , aud :: Maybe (Either StringOrURI [StringOrURI])
JWT.aud = Maybe (Either StringOrURI [StringOrURI])
forall a. Maybe a
Nothing
                        , exp :: Maybe IntDate
JWT.exp = POSIXTime -> Maybe IntDate
intDate (POSIXTime -> Maybe IntDate) -> POSIXTime -> Maybe IntDate
forall a b. (a -> b) -> a -> b
$ POSIXTime
now POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
60
                        , nbf :: Maybe IntDate
JWT.nbf = Maybe IntDate
forall a. Maybe a
Nothing
                        , iat :: Maybe IntDate
JWT.iat = Maybe IntDate
forall a. Maybe a
Nothing
                        , jti :: Maybe StringOrURI
JWT.jti = Maybe StringOrURI
forall a. Maybe a
Nothing
                        , unregisteredClaims :: ClaimsMap
JWT.unregisteredClaims =
#if MIN_VERSION_jwt(0,8,0)
                            Map Text Value -> ClaimsMap
JWT.ClaimsMap (Map Text Value -> ClaimsMap) -> Map Text Value -> ClaimsMap
forall a b. (a -> b) -> a -> b
$
#endif
                               Text -> Value -> Map Text Value
forall k a. k -> a -> Map k a
Map.singleton Text
"reset-password" (User -> Value
forall a. ToJSON a => a -> Value
toJSON User
user)
                        }
#if MIN_VERSION_jwt(0,10,0)
     Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Signer -> JOSEHeader -> JWTClaimsSet -> Text
encodeSigned (Text -> Signer
hmacSecret (Text -> Signer) -> Text -> Signer
forall a b. (a -> b) -> a -> b
$ SharedSecret -> Text
_unSharedSecret SharedSecret
ssecret) JOSEHeader
forall a. Monoid a => a
mempty JWTClaimsSet
claims
#elif MIN_VERSION_jwt(0,9,0)
     return $ encodeSigned (hmacSecret $ _unSharedSecret ssecret) claims
#else
     return $ encodeSigned HS256 (secret $ _unSharedSecret ssecret) claims
#endif

-- FIXME: I18N
-- FIXME: call renderSendMail
sendResetEmail :: (MonadIO m) =>
                  Maybe FilePath
               -> Email
               -> SimpleAddress
               -> Maybe SimpleAddress
               -> Text
               -> m ()
sendResetEmail :: Maybe String
-> Email -> SimpleAddress -> Maybe SimpleAddress -> Text -> m ()
sendResetEmail Maybe String
mSendmailPath (Email Text
toEm) (SimpleAddress Maybe Text
fromNm (Email Text
fromEm)) Maybe SimpleAddress
mReplyTo Text
resetLink = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  do let mail :: Mail
mail = Maybe SimpleAddress -> Mail -> Mail
addReplyTo Maybe SimpleAddress
mReplyTo (Mail -> Mail) -> Mail -> Mail
forall a b. (a -> b) -> a -> b
$ Address -> Address -> Text -> Text -> Mail
simpleMail' (Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing Text
toEm)  (Maybe Text -> Text -> Address
Address Maybe Text
fromNm Text
fromEm) Text
"Reset Password Request" (Text -> Text
LT.fromStrict Text
resetLink)
     case Maybe String
mSendmailPath of
       Maybe String
Nothing -> Mail -> IO ()
renderSendMail Mail
mail
       (Just String
sendmailPath) -> String -> [String] -> Mail -> IO ()
renderSendMailCustom String
sendmailPath [String
"-t"] Mail
mail
  where
    addReplyTo :: Maybe SimpleAddress -> Mail -> Mail
    addReplyTo :: Maybe SimpleAddress -> Mail -> Mail
addReplyTo Maybe SimpleAddress
Nothing Mail
m = Mail
m
    addReplyTo (Just (SimpleAddress Maybe Text
rplyToNm Email
rplyToEm)) Mail
m =
      let m' :: Mail
m' = Mail
m { mailHeaders :: Headers
mailHeaders = (Mail -> Headers
mailHeaders Mail
m) } in Mail
m'

-- | JSON record for new account data
data ResetPasswordData = ResetPasswordData
    { ResetPasswordData -> Text
_rpPassword        :: Text
    , ResetPasswordData -> Text
_rpPasswordConfirm :: Text
    , ResetPasswordData -> Text
_rpResetToken      :: Text
    }
    deriving (ResetPasswordData -> ResetPasswordData -> Bool
(ResetPasswordData -> ResetPasswordData -> Bool)
-> (ResetPasswordData -> ResetPasswordData -> Bool)
-> Eq ResetPasswordData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetPasswordData -> ResetPasswordData -> Bool
$c/= :: ResetPasswordData -> ResetPasswordData -> Bool
== :: ResetPasswordData -> ResetPasswordData -> Bool
$c== :: ResetPasswordData -> ResetPasswordData -> Bool
Eq, Eq ResetPasswordData
Eq ResetPasswordData
-> (ResetPasswordData -> ResetPasswordData -> Ordering)
-> (ResetPasswordData -> ResetPasswordData -> Bool)
-> (ResetPasswordData -> ResetPasswordData -> Bool)
-> (ResetPasswordData -> ResetPasswordData -> Bool)
-> (ResetPasswordData -> ResetPasswordData -> Bool)
-> (ResetPasswordData -> ResetPasswordData -> ResetPasswordData)
-> (ResetPasswordData -> ResetPasswordData -> ResetPasswordData)
-> Ord ResetPasswordData
ResetPasswordData -> ResetPasswordData -> Bool
ResetPasswordData -> ResetPasswordData -> Ordering
ResetPasswordData -> ResetPasswordData -> ResetPasswordData
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
min :: ResetPasswordData -> ResetPasswordData -> ResetPasswordData
$cmin :: ResetPasswordData -> ResetPasswordData -> ResetPasswordData
max :: ResetPasswordData -> ResetPasswordData -> ResetPasswordData
$cmax :: ResetPasswordData -> ResetPasswordData -> ResetPasswordData
>= :: ResetPasswordData -> ResetPasswordData -> Bool
$c>= :: ResetPasswordData -> ResetPasswordData -> Bool
> :: ResetPasswordData -> ResetPasswordData -> Bool
$c> :: ResetPasswordData -> ResetPasswordData -> Bool
<= :: ResetPasswordData -> ResetPasswordData -> Bool
$c<= :: ResetPasswordData -> ResetPasswordData -> Bool
< :: ResetPasswordData -> ResetPasswordData -> Bool
$c< :: ResetPasswordData -> ResetPasswordData -> Bool
compare :: ResetPasswordData -> ResetPasswordData -> Ordering
$ccompare :: ResetPasswordData -> ResetPasswordData -> Ordering
$cp1Ord :: Eq ResetPasswordData
Ord, ReadPrec [ResetPasswordData]
ReadPrec ResetPasswordData
Int -> ReadS ResetPasswordData
ReadS [ResetPasswordData]
(Int -> ReadS ResetPasswordData)
-> ReadS [ResetPasswordData]
-> ReadPrec ResetPasswordData
-> ReadPrec [ResetPasswordData]
-> Read ResetPasswordData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetPasswordData]
$creadListPrec :: ReadPrec [ResetPasswordData]
readPrec :: ReadPrec ResetPasswordData
$creadPrec :: ReadPrec ResetPasswordData
readList :: ReadS [ResetPasswordData]
$creadList :: ReadS [ResetPasswordData]
readsPrec :: Int -> ReadS ResetPasswordData
$creadsPrec :: Int -> ReadS ResetPasswordData
Read, Int -> ResetPasswordData -> ShowS
[ResetPasswordData] -> ShowS
ResetPasswordData -> String
(Int -> ResetPasswordData -> ShowS)
-> (ResetPasswordData -> String)
-> ([ResetPasswordData] -> ShowS)
-> Show ResetPasswordData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetPasswordData] -> ShowS
$cshowList :: [ResetPasswordData] -> ShowS
show :: ResetPasswordData -> String
$cshow :: ResetPasswordData -> String
showsPrec :: Int -> ResetPasswordData -> ShowS
$cshowsPrec :: Int -> ResetPasswordData -> ShowS
Show, Typeable ResetPasswordData
DataType
Constr
Typeable ResetPasswordData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ResetPasswordData
    -> c ResetPasswordData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ResetPasswordData)
-> (ResetPasswordData -> Constr)
-> (ResetPasswordData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ResetPasswordData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ResetPasswordData))
-> ((forall b. Data b => b -> b)
    -> ResetPasswordData -> ResetPasswordData)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ResetPasswordData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResetPasswordData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ResetPasswordData -> m ResetPasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ResetPasswordData -> m ResetPasswordData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ResetPasswordData -> m ResetPasswordData)
-> Data ResetPasswordData
ResetPasswordData -> DataType
ResetPasswordData -> Constr
(forall b. Data b => b -> b)
-> ResetPasswordData -> ResetPasswordData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPasswordData -> c ResetPasswordData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPasswordData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ResetPasswordData -> u
forall u. (forall d. Data d => d -> u) -> ResetPasswordData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPasswordData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPasswordData -> c ResetPasswordData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetPasswordData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPasswordData)
$cResetPasswordData :: Constr
$tResetPasswordData :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
gmapMp :: (forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
gmapM :: (forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ResetPasswordData -> m ResetPasswordData
gmapQi :: Int -> (forall d. Data d => d -> u) -> ResetPasswordData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ResetPasswordData -> u
gmapQ :: (forall d. Data d => d -> u) -> ResetPasswordData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ResetPasswordData -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPasswordData -> r
gmapT :: (forall b. Data b => b -> b)
-> ResetPasswordData -> ResetPasswordData
$cgmapT :: (forall b. Data b => b -> b)
-> ResetPasswordData -> ResetPasswordData
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPasswordData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPasswordData)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ResetPasswordData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetPasswordData)
dataTypeOf :: ResetPasswordData -> DataType
$cdataTypeOf :: ResetPasswordData -> DataType
toConstr :: ResetPasswordData -> Constr
$ctoConstr :: ResetPasswordData -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPasswordData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPasswordData
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPasswordData -> c ResetPasswordData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPasswordData -> c ResetPasswordData
$cp1Data :: Typeable ResetPasswordData
Data, Typeable, (forall x. ResetPasswordData -> Rep ResetPasswordData x)
-> (forall x. Rep ResetPasswordData x -> ResetPasswordData)
-> Generic ResetPasswordData
forall x. Rep ResetPasswordData x -> ResetPasswordData
forall x. ResetPasswordData -> Rep ResetPasswordData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetPasswordData x -> ResetPasswordData
$cfrom :: forall x. ResetPasswordData -> Rep ResetPasswordData x
Generic)
makeLenses ''ResetPasswordData
instance ToJSON   ResetPasswordData where toJSON :: ResetPasswordData -> Value
toJSON    = Options -> ResetPasswordData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON    Options
jsonOptions
instance FromJSON ResetPasswordData where parseJSON :: Value -> Parser ResetPasswordData
parseJSON = Options -> Value -> Parser ResetPasswordData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

passwordReset :: (Happstack m) =>
                 AcidState AuthenticateState
              -> AcidState PasswordState
              -> PasswordConfig
              -> m (Either PasswordError Text)
passwordReset :: AcidState AuthenticateState
-> AcidState PasswordState
-> PasswordConfig
-> m (Either PasswordError Text)
passwordReset AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState PasswordConfig
passwordConfig =
  do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
     ~(Just (Body Tag
body)) <- Request -> m (Maybe RqBody)
forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
takeRequestBody (Request -> m (Maybe RqBody)) -> m Request -> m (Maybe RqBody)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
     case Tag -> Maybe ResetPasswordData
forall a. FromJSON a => Tag -> Maybe a
Aeson.decode Tag
body of
       Maybe ResetPasswordData
Nothing -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
badRequest (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError Text)
-> PasswordError -> Either PasswordError Text
forall a b. (a -> b) -> a -> b
$ CoreError -> PasswordError
CoreError CoreError
JSONDecodeFailed
       (Just (ResetPasswordData Text
password Text
passwordConfirm Text
resetToken)) ->
         do Maybe (User, JWT VerifiedJWT)
mUser <- AcidState AuthenticateState
-> Text -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *).
MonadIO m =>
AcidState AuthenticateState
-> Text -> m (Maybe (User, JWT VerifiedJWT))
decodeAndVerifyResetToken AcidState AuthenticateState
authenticateState Text
resetToken
            case Maybe (User, JWT VerifiedJWT)
mUser of
              Maybe (User, JWT VerifiedJWT)
Nothing     -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left PasswordError
InvalidResetToken)
              (Just (User
user, JWT VerifiedJWT
_)) ->
                if Text
password Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
passwordConfirm
                then Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left PasswordError
PasswordMismatch)
                else case (PasswordConfig
passwordConfig PasswordConfig
-> Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
-> Text
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Text -> Maybe Text) PasswordConfig (Text -> Maybe Text)
Lens' PasswordConfig (Text -> Maybe Text)
passwordAcceptable) Text
password of
                       (Just Text
e) -> Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ PasswordError -> Either PasswordError Text
forall a b. a -> Either a b
Left (PasswordError -> Either PasswordError Text)
-> PasswordError -> Either PasswordError Text
forall a b. (a -> b) -> a -> b
$ Text -> PasswordError
UnacceptablePassword Text
e
                       Maybe Text
Nothing -> do HashedPass
pw <-  Text -> m HashedPass
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Text -> m HashedPass
mkHashedPass Text
password
                                     AcidState (EventState SetPassword)
-> SetPassword -> m (EventResult SetPassword)
forall event (m :: * -> *).
(UpdateEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
update' AcidState (EventState SetPassword)
AcidState PasswordState
passwordState (UserId -> HashedPass -> SetPassword
SetPassword (User
user User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId) HashedPass
pw)
                                     Either PasswordError Text -> m (Either PasswordError Text)
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Either PasswordError Text -> m (Either PasswordError Text))
-> Either PasswordError Text -> m (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either PasswordError Text
forall a b. b -> Either a b
Right Text
"Password Reset." -- I18N
         {-
         do mTokenTxt <- optional $ queryString $ lookText' "reset_btoken"
            case mTokenTxt of
              Nothing -> badRequest $ Left MissingResetToken
              (Just tokenTxt) ->
                do mUser <- decodeAndVerifyResetToken authenticateState tokenTxt
                   case mUser of
                     Nothing     -> return (Left InvalidResetToken)
                     (Just (user, _)) ->
                       if password /= passwordConfirm
                       then return (Left PasswordMismatch)
                       else do pw <-  mkHashedPass password
                               update' passwordState (SetPassword (user ^. userId) pw)
                               ok $ Right ()
--         ok $ Right $ Text.pack $ show (password, passwordConfirm)
-}

  {-
  do mToken <- optional <$> queryString $ lookText "token"
     case mToken of
       Nothing      -> return (Left MissingResetToken)
       (Just token) ->
         do method GET
-}

decodeAndVerifyResetToken :: (MonadIO m) =>
                             AcidState AuthenticateState
                          -> Text
                          -> m (Maybe (User, JWT VerifiedJWT))
decodeAndVerifyResetToken :: AcidState AuthenticateState
-> Text -> m (Maybe (User, JWT VerifiedJWT))
decodeAndVerifyResetToken AcidState AuthenticateState
authenticateState Text
token =
  do let mUnverified :: Maybe (JWT UnverifiedJWT)
mUnverified = Text -> Maybe (JWT UnverifiedJWT)
JWT.decode Text
token
     case Maybe (JWT UnverifiedJWT)
mUnverified of
       Maybe (JWT UnverifiedJWT)
Nothing -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
       (Just JWT UnverifiedJWT
unverified) ->
         case Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"reset-password" (ClaimsMap -> Map Text Value
unClaimsMap (JWTClaimsSet -> ClaimsMap
unregisteredClaims (JWT UnverifiedJWT -> JWTClaimsSet
forall r. JWT r -> JWTClaimsSet
claims JWT UnverifiedJWT
unverified))) of
           Maybe Value
Nothing -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
           (Just Value
uv) ->
             case Value -> Result User
forall a. FromJSON a => Value -> Result a
fromJSON Value
uv of
               (Error String
_) -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
               (Success User
u) ->
                 do Maybe SharedSecret
mssecret <- AcidState (EventState GetSharedSecret)
-> GetSharedSecret -> m (EventResult GetSharedSecret)
forall event (m :: * -> *).
(QueryEvent event, MonadIO m) =>
AcidState (EventState event) -> event -> m (EventResult event)
query' AcidState (EventState GetSharedSecret)
AcidState AuthenticateState
authenticateState (UserId -> GetSharedSecret
GetSharedSecret (User
u User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId))
                    case Maybe SharedSecret
mssecret of
                      Maybe SharedSecret
Nothing -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
                      (Just SharedSecret
ssecret) ->
#if MIN_VERSION_jwt(0,8,0)
                        case Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)
verify (Text -> Signer
hmacSecret (SharedSecret -> Text
_unSharedSecret SharedSecret
ssecret)) JWT UnverifiedJWT
unverified of
#else
                        case verify (secret (_unSharedSecret ssecret)) unverified of
#endif
                          Maybe (JWT VerifiedJWT)
Nothing -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
                          (Just JWT VerifiedJWT
verified) ->
                            do POSIXTime
now <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
                               case JWTClaimsSet -> Maybe IntDate
JWT.exp (JWT VerifiedJWT -> JWTClaimsSet
forall r. JWT r -> JWTClaimsSet
claims JWT VerifiedJWT
verified) of
                                 Maybe IntDate
Nothing -> Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
                                 (Just IntDate
exp') ->
                                   if (POSIXTime
now POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> IntDate -> POSIXTime
secondsSinceEpoch IntDate
exp')
                                   then Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, JWT VerifiedJWT)
forall a. Maybe a
Nothing
                                   else Maybe (User, JWT VerifiedJWT) -> m (Maybe (User, JWT VerifiedJWT))
forall (m :: * -> *) a. Monad m => a -> m a
return ((User, JWT VerifiedJWT) -> Maybe (User, JWT VerifiedJWT)
forall a. a -> Maybe a
Just (User
u, JWT VerifiedJWT
verified))