    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE QuasiQuotes                #-}
    {-# LANGUAGE ConstraintKinds            #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE RankNTypes                 #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE OverloadedStrings          #-}
    -------------------------------------------------------------------------------
    -- |
    -- Module      :  Yesod.Auth.HashDB
    -- Copyright   :  (c) Patrick Brisbin 2010, Paul Rouse 2014-2016
    -- License     :  MIT
    --
    -- Maintainer  :  Paul Rouse <pyr@doynton.org>
    -- Stability   :  Stable
    -- Portability :  Portable
    --
    -- A Yesod authentication plugin designed to look users up in a Persistent
    -- database where the hash of their password is stored.
    --
    -- __Releases 1.6 finishes the process of removing compatibility with old__
    -- __(pre 1.3) databases.  Please see__
    -- __<https://github.com/paul-rouse/yesod-auth-hashdb/blob/master/Upgrading.md>__
    --
    -- To use this in a Yesod application, the foundation data type must be an
    -- instance of YesodPersist, and the username and hashed passwords should
    -- be added to the database.  The following steps give an outline of what
    -- is required.
    --
    -- You need a database table to store user records: in a scaffolded site it
    -- might look like:
    --
    -- > User
    -- >     name Text             -- user name used to uniquely identify users
    -- >     password Text Maybe   -- password hash for HashDB
    -- >     UniqueUser name
    --
    -- Create an instance of 'HashDBUser' for this data type:
    --
    -- > import Yesod.Auth.HashDB (HashDBUser(..))
    -- > ....
    -- > instance HashDBUser User where
    -- >     userPasswordHash = userPassword
    -- >     setPasswordHash h u = u { userPassword = Just h }
    --
    -- In the YesodAuth instance declaration for your app, include 'authHashDB'
    -- like so:
    --
    -- > import Yesod.Auth.HashDB (authHashDB)
    -- > ....
    -- > instance YesodAuth App where
    -- >     ....
    -- >     authPlugins _ = [ authHashDB (Just . UniqueUser), .... ]
    -- >     getAuthId creds = ... -- Perhaps modify scaffolding: see below
    --
    -- The argument to 'authHashDB' is a function which takes a 'Text' and
    -- produces a 'Maybe' containing a 'Unique' value to look up in the User
    -- table.  The example @(Just . UniqueUser)@ shown here works for the
    -- model outlined above.
    --
    -- In the scaffolding, the definition of @getAuthId@ contains code to
    -- add a user who is not already in the database.  Depending on how users
    -- are administered, this may not make sense when using HashDB, so consider
    -- whether it should be removed.
    --
    -- For a real application, the developer should provide some sort of
    -- of administrative interface for setting passwords; it needs to call
    -- 'setPassword' and save the result in the database.  However, if you
    -- need to initialise the database by hand, you can generate the correct
    -- password hash as follows:
    --
    -- > ghci -XOverloadedStrings
    -- > > import Yesod.Auth.Util.PasswordStore
    -- > > makePassword "MyPassword" 17
    --
    -- where \"17\" is the default strength parameter ('defaultStrength') used
    -- in this module.
    --
    -- == Custom Login Form
    --
    -- Instead of using the built-in HTML form, a custom one can be supplied
    -- by using 'authHashDBWithForm' instead of 'authHashDB'.
    --
    -- The custom form needs to be given as a function returning a Widget, since
    -- it has to build in the supplied "action" URL, and it must provide two text
    -- fields called "username" and "password".  For example, the following
    -- modification of the outline code given above would replace the default
    -- form with a very minimal one which has no labels and a simple layout.
    --
    -- > instance YesodAuth App where
    -- >     ....
    -- >     authPlugins _ = [ authHashDBWithForm myform (Just . UniqueUser), .... ]
    -- >
    -- > myform :: Route App -> Widget
    -- > myform action = $(whamletFile "templates/loginform.hamlet")
    --
    -- where templates/loginform.hamlet contains
    --
    -- > <form method="post" action="@{action}">
    -- >     <input name="username">
    -- >     <input type="password" name="password">
    -- >     <input type="submit" value="Login">
    --
    -- If a CSRF token needs to be embedded in a custom form, code must be
    -- included in the widget to add it - see @defaultForm@ in the source
    -- code of this module for an example.
    --
    -- == JSON Interface
    --
    -- This plugin provides sufficient tools to build a complete JSON-based
    -- authentication flow.  We assume that a design goal is to avoid URLs
    -- being built into the client, so all of the URLs needed are passed in
    -- JSON data.
    --
    -- To start the process, Yesod's defaultErrorHandler produces a JSON
    -- response if the HTTP Accept header gives \"application/json\"
    -- precedence over HTML.  For a NotAuthenticated error, the status is
    -- 401 and the response contains the URL to use for authentication: this
    -- is the route which will be handled by the loginHandler method of the
    -- YesodAuth instance, which normally returns a login form.
    --
    -- Leaving the loginHandler aside for a moment, the final step - supported
    -- by this plugin since version 1.6 - is to POST the credentials for
    -- authentication in a JSON object.  This object must include the
    -- properties "username" and "password".  In the HTML case this would be
    -- the form submission, but here we want to use JSON instead.
    --
    -- In a JSON interface, the purpose of the loginHandler is to tell the
    -- client the URL for submitting the credentials.  This requires a
    -- custom loginHandler, since the default one generates HTML only.
    -- It can find the correct URL by using the 'submitRouteHashDB'
    -- function defined in this module.
    --
    -- Writing the loginHandler is made a little messy by the fact that its
    -- type allows only HTML content.  A work-around is to send JSON as a
    -- short-circuit response, but we still make the choice using selectRep
    -- so as to get its matching of content types.  Here is an example which
    -- is geared around using HashDB on its own, supporting both JSON and HTML
    -- clients:
    --
    -- > instance YesodAuth App where
    -- >    ....
    -- >    loginHandler = do
    -- >         submission <- submitRouteHashDB
    -- >         render <- lift getUrlRender
    -- >         typedContent@(TypedContent ct _) <- selectRep $ do
    -- >             provideRepType typeHtml $ return emptyContent
    -- >                            -- Dummy: the real Html version is at the end
    -- >             provideJson $ object [("loginUrl", toJSON $ render submission)]
    -- >         when (ct == typeJson) $
    -- >             sendResponse typedContent   -- Short-circuit JSON response
    -- >         defaultLoginHandler             -- Html response
    --
    -------------------------------------------------------------------------------
    module Yesod.Auth.HashDB
        ( HashDBUser(..)
        , defaultStrength
        , setPasswordStrength
        , setPassword
        , validatePass
        , upgradePasswordHash
          -- * Interface to database and Yesod.Auth
        , validateUser
        , authHashDB
        , authHashDBWithForm
        , submitRouteHashDB
        ) where

    import           Yesod.Auth.Util.PasswordStore (makePassword, strengthenPassword,
                                                  verifyPassword, passwordStrength)
    import           Data.Aeson                  ((.:?))
    import qualified Data.ByteString.Char8 as BS (pack, unpack)
    import           Data.Maybe                  (fromMaybe)
    import           Data.Text                   (Text, pack, unpack)
    import           Yesod.Auth
    import qualified Yesod.Auth.Message    as Msg
    import           Yesod.Core
    import           Yesod.Form
    import           Yesod.Persist

    #if !MIN_VERSION_yesod_core(1,6,0)
    type HandlerFor site a = HandlerT site IO a
    type WidgetFor site a  = WidgetT site IO ()
    #define liftHandler lift
    #endif

    #if !MIN_VERSION_yesod_core(1,6,11)
    #define requireInsecureJsonBody requireJsonBody
    #endif

    -- | Default strength used for passwords (see "Yesod.Auth.Util.PasswordStore"
    --   for details).
    defaultStrength :: Int
    defaultStrength :: Int
    defaultStrength = Int
    17

    -- | The type representing user information stored in the database should
    --   be an instance of this class.  It just provides the getter and setter
    --   used by the functions in this module.
    class HashDBUser user where
        -- | Getter used by 'validatePass' and 'upgradePasswordHash' to
        --   retrieve the password hash from user data
        --
        userPasswordHash :: user -> Maybe Text

        -- | Setter used by 'setPassword' and 'upgradePasswordHash'.  Produces a
        --   version of the user data with the hash set to the new value.
        --
        setPasswordHash :: Text   -- ^ Password hash
                           -> user -> user

        {-# MINIMAL userPasswordHash, setPasswordHash #-}

    -- | Calculate a new-style password hash using "Yesod.Auth.Util.PasswordStore".
    passwordHash :: MonadIO m => Int -> Text -> m Text
    passwordHash :: forall (m :: * -> *). MonadIO m => Int -> Text -> m Text
    passwordHash Int
    strength Text
    pwd = do
        h <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    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 (String -> ByteString
    BS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    unpack Text
    pwd) Int
    strength
        return $ pack $ BS.unpack h

    -- | Set password for user, using the given strength setting. Use this
    --   function, or 'setPassword', to produce a user record containing the
    --   hashed password.  Unlike previous versions of this module, no separate
    --   salt field is required for new passwords (but it may still be required
    --   for compatibility while old password hashes remain in the database).
    --
    --   This function does not change the database; the calling application
    --   is responsible for saving the data which is returned.
    setPasswordStrength :: (MonadIO m, HashDBUser user) => Int -> Text -> user -> m user
    setPasswordStrength :: forall (m :: * -> *) user.
    (MonadIO m, HashDBUser user) =>
    Int -> Text -> user -> m user
    setPasswordStrength Int
    strength Text
    pwd user
    u = do
        hashed <- Int -> Text -> m Text
    forall (m :: * -> *). MonadIO m => Int -> Text -> m Text
    passwordHash Int
    strength Text
    pwd
        return $ setPasswordHash hashed u

    -- | As 'setPasswordStrength', but using the 'defaultStrength'
    setPassword :: (MonadIO m, HashDBUser user) => Text -> user -> m user
    setPassword :: forall (m :: * -> *) user.
    (MonadIO m, HashDBUser user) =>
    Text -> user -> m user
    setPassword = Int -> Text -> user -> m user
    forall (m :: * -> *) user.
    (MonadIO m, HashDBUser user) =>
    Int -> Text -> user -> m user
    setPasswordStrength Int
    defaultStrength

    -- | Validate a plaintext password against the hash in the user data structure.
    --
    --   The result distinguishes two types of validation failure, which may
    --   be useful in an application which supports multiple authentication
    --   methods:
    --
    --   * Just False - the user has a password set up, but the given one does
    --     not match it
    --
    --   * Nothing - the user does not have a password ('userPasswordHash' returns
    --     Nothing)
    --
    --   Since 1.4.1
    --
    validatePass :: HashDBUser u => u -> Text -> Maybe Bool
    validatePass :: forall u. HashDBUser u => u -> Text -> Maybe Bool
    validatePass u
    user Text
    passwd = do
        hash <- u -> Maybe Text
    forall user. HashDBUser user => user -> Maybe Text
    userPasswordHash u
    user
        -- NB plaintext password characters are truncated to 8 bits here,
        -- and also in passwordHash above (the hash is already 8 bit).
        -- This is for historical compatibility, but in practice it is
        -- unlikely to reduce the entropy of most users' alphabets by much.
        let hash' = String -> ByteString
    BS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    unpack Text
    hash
            passwd' = String -> ByteString
    BS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    unpack Text
    passwd
        if passwordStrength hash' > 0
            -- Will give >0 for valid hash format, else treat as if wrong password
            then return $ verifyPassword passwd' hash'
            else return False

    -- | Upgrade existing user credentials to a stronger hash.  The existing
    --   hash will have been produced from a weaker setting in the current
    --   algorithm.  Use this function to produce an updated user record to
    --   store in the database.
    --
    --   As of version 1.5 this function cannot be used to upgrade a hash
    --   which has a non-empty separate salt field.  Such entries would have
    --   been produced originally by versions of this module prior to 1.3,
    --   but may have been upgraded using earlier versions of this function.
    --
    --   Returns Nothing if the user has no password (ie if 'userPasswordHash' u
    --   is 'Nothing') or if the password hash is not in the correct format.
    --
    upgradePasswordHash :: (MonadIO m, HashDBUser user) => Int -> user -> m (Maybe user)
    upgradePasswordHash :: forall (m :: * -> *) user.
    (MonadIO m, HashDBUser user) =>
    Int -> user -> m (Maybe user)
    upgradePasswordHash Int
    strength user
    u = do
        let old :: Maybe Text
    old = user -> Maybe Text
    forall user. HashDBUser user => user -> Maybe Text
    userPasswordHash user
    u
        case Maybe Text
    old of
            Just Text
    oldHash -> do
                let oldHash' :: ByteString
    oldHash' = String -> ByteString
    BS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    unpack Text
    oldHash
                if ByteString -> Int
    passwordStrength ByteString
    oldHash' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                  then
                    -- Valid hash format, so strengthen it as needed
                    let newHash :: Text
    newHash = String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    BS.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int -> ByteString
    strengthenPassword ByteString
    oldHash' Int
    strength
                    in Maybe user -> m (Maybe user)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe user -> m (Maybe user)) -> Maybe user -> m (Maybe user)
    forall a b. (a -> b) -> a -> b
    $ user -> Maybe user
    forall a. a -> Maybe a
    Just (user -> Maybe user) -> user -> Maybe user
    forall a b. (a -> b) -> a -> b
    $ Text -> user -> user
    forall user. HashDBUser user => Text -> user -> user
    setPasswordHash Text
    newHash user
    u
                  else do
                    -- Invalid hash format (perhaps from old version of this module)
                    Maybe user -> m (Maybe user)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe user
    forall a. Maybe a
    Nothing
            Maybe Text
    Nothing -> Maybe user -> m (Maybe user)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe user
    forall a. Maybe a
    Nothing

    ----------------------------------------------------------------
    -- Interface to database and Yesod.Auth
    ----------------------------------------------------------------

    -- | Constraint for types of interface functions in this module
    --
    type HashDBPersist master user =
        ( YesodAuthPersist master
        , PersistUnique (YesodPersistBackend master)
        , AuthEntity master ~ user
    #if MIN_VERSION_persistent(2,5,0)
        , PersistEntityBackend user ~ BaseBackend (YesodPersistBackend master)
    #else
        , PersistEntityBackend user ~ YesodPersistBackend master
    #endif
        , HashDBUser user
        , PersistEntity user
        )

    -- Internal data type for receiving JSON encoded username and password
    data UserPass = UserPass (Maybe Text) (Maybe Text)

    instance FromJSON UserPass where
        parseJSON :: Value -> Parser UserPass
    parseJSON (Object Object
    v) = Maybe Text -> Maybe Text -> UserPass
    UserPass (Maybe Text -> Maybe Text -> UserPass)
    -> Parser (Maybe Text) -> Parser (Maybe Text -> UserPass)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                               Object
    v Object -> Key -> Parser (Maybe Text)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "username" Parser (Maybe Text -> UserPass)
    -> Parser (Maybe Text) -> Parser UserPass
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
                               Object
    v Object -> Key -> Parser (Maybe Text)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "password"
        parseJSON Value
    _          = UserPass -> Parser UserPass
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (UserPass -> Parser UserPass) -> UserPass -> Parser UserPass
    forall a b. (a -> b) -> a -> b
    $ Maybe Text -> Maybe Text -> UserPass
    UserPass Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing

    -- | Given a user ID and password in plaintext, validate them against
    --   the database values.  This function simply looks up the user id in the
    --   database and calls 'validatePass' to do the work.
    --
    validateUser :: HashDBPersist site user =>
                    Unique user     -- ^ User unique identifier
                 -> Text            -- ^ Password in plaintext
                 -> HandlerFor site Bool
    validateUser :: forall site user.
    HashDBPersist site user =>
    Unique user -> Text -> HandlerFor site Bool
    validateUser Unique user
    userID Text
    passwd = do
        -- Get user data
        user <- YesodDB site (Maybe (Entity user))
    -> HandlerFor site (Maybe (Entity user))
    forall a. YesodDB site a -> HandlerFor site a
    forall site a.
    YesodPersist site =>
    YesodDB site a -> HandlerFor site a
    runDB (YesodDB site (Maybe (Entity user))
     -> HandlerFor site (Maybe (Entity user)))
    -> YesodDB site (Maybe (Entity user))
    -> HandlerFor site (Maybe (Entity user))
    forall a b. (a -> b) -> a -> b
    $ Unique user -> YesodDB site (Maybe (Entity user))
    forall backend record (m :: * -> *).
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    forall record (m :: * -> *).
    (MonadIO m,
     PersistRecordBackend record (YesodPersistBackend site)) =>
    Unique record
    -> ReaderT (YesodPersistBackend site) m (Maybe (Entity record))
    getBy Unique user
    userID
        return $ fromMaybe False $ flip validatePass passwd . entityVal =<< user

    login :: AuthRoute
    login :: AuthRoute
    login = Text -> Texts -> AuthRoute
    PluginR Text
    "hashdb" [Text
    "login"]

    -- | Handle the login form. First parameter is function which maps
    --   username (whatever it might be) to unique user ID.
    --
    --   Since version 1.6, the data may be submitted as a JSON object.
    --   See the \"JSON Interface\" section above for more details.
    postLoginR :: HashDBPersist site user =>
                  (Text -> Maybe (Unique user))
               -> AuthHandler site TypedContent
    postLoginR :: forall site user.
    HashDBPersist site user =>
    (Text -> Maybe (Unique user)) -> AuthHandler site TypedContent
    postLoginR Text -> Maybe (Unique user)
    uniq = do
        ct <- CI ByteString -> m (Maybe ByteString)
    forall (m :: * -> *).
    MonadHandler m =>
    CI ByteString -> m (Maybe ByteString)
    lookupHeader CI ByteString
    "Content-Type"
        let jsonContent = ((ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "application/json") (ByteString -> Bool)
    -> (ByteString -> ByteString) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    simpleContentType) (ByteString -> Bool) -> Maybe ByteString -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ByteString
    ct
        UserPass mu mp <-
            case jsonContent of
              Just Bool
    True -> m UserPass
    forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireInsecureJsonBody  -- We already know content type!
              Maybe Bool
    _         -> HandlerFor (HandlerSite m) UserPass -> m UserPass
    forall a. HandlerFor (HandlerSite m) a -> m a
    forall (m :: * -> *) a.
    MonadHandler m =>
    HandlerFor (HandlerSite m) a -> m a
    liftHandler (HandlerFor (HandlerSite m) UserPass -> m UserPass)
    -> HandlerFor (HandlerSite m) UserPass -> m UserPass
    forall a b. (a -> b) -> a -> b
    $ FormInput (HandlerFor (HandlerSite m)) UserPass
    -> HandlerFor (HandlerSite m) UserPass
    forall (m :: * -> *) a. MonadHandler m => FormInput m a -> m a
    runInputPost (FormInput (HandlerFor (HandlerSite m)) UserPass
     -> HandlerFor (HandlerSite m) UserPass)
    -> FormInput (HandlerFor (HandlerSite m)) UserPass
    -> HandlerFor (HandlerSite m) UserPass
    forall a b. (a -> b) -> a -> b
    $ Maybe Text -> Maybe Text -> UserPass
    UserPass
                           (Maybe Text -> Maybe Text -> UserPass)
    -> FormInput (HandlerFor site) (Maybe Text)
    -> FormInput (HandlerFor site) (Maybe Text -> UserPass)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Field (HandlerFor site) Text
    -> Text -> FormInput (HandlerFor site) (Maybe Text)
    forall (m :: * -> *) a.
    Monad m =>
    Field m a -> Text -> FormInput m (Maybe a)
    iopt Field (HandlerFor site) Text
    forall (m :: * -> *).
    (Monad m, RenderMessage (HandlerSite m) FormMessage) =>
    Field m Text
    textField Text
    "username"
                           FormInput (HandlerFor site) (Maybe Text -> UserPass)
    -> FormInput (HandlerFor site) (Maybe Text)
    -> FormInput (HandlerFor site) UserPass
    forall a b.
    FormInput (HandlerFor site) (a -> b)
    -> FormInput (HandlerFor site) a -> FormInput (HandlerFor site) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Field (HandlerFor site) Text
    -> Text -> FormInput (HandlerFor site) (Maybe Text)
    forall (m :: * -> *) a.
    Monad m =>
    Field m a -> Text -> FormInput m (Maybe a)
    iopt Field (HandlerFor site) Text
    forall (m :: * -> *).
    (Monad m, RenderMessage (HandlerSite m) FormMessage) =>
    Field m Text
    textField Text
    "password"

        isValid <- liftHandler $ fromMaybe (return False)
                     (validateUser <$> (uniq =<< mu) <*> mp)
        if isValid
            then liftHandler $ setCredsRedirect $ Creds "hashdb" (fromMaybe "" mu) []
            else loginErrorMessageI LoginR Msg.InvalidUsernamePass

    -- | Prompt for username and password, validate that against a database
    --   which holds the username and a hash of the password
    authHashDB :: HashDBPersist site user =>
                  (Text -> Maybe (Unique user)) -> AuthPlugin site
    authHashDB :: forall site user.
    HashDBPersist site user =>
    (Text -> Maybe (Unique user)) -> AuthPlugin site
    authHashDB = (Route site -> WidgetFor site ())
    -> (Text -> Maybe (Unique user)) -> AuthPlugin site
    forall site user.
    HashDBPersist site user =>
    (Route site -> WidgetFor site ())
    -> (Text -> Maybe (Unique user)) -> AuthPlugin site
    authHashDBWithForm Route site -> WidgetFor site ()
    forall app. Yesod app => Route app -> WidgetFor app ()
    defaultForm

    -- | Like 'authHashDB', but with an extra parameter to supply a custom HTML
    -- form.
    --
    -- The custom form should be specified as a function which takes a route to
    -- use as the form action, and returns a Widget containing the form.  The
    -- form must use the supplied route as its action URL, and, when submitted,
    -- it must send two text fields called "username" and "password".
    --
    -- Please see the example in the documentation at the head of this module.
    --
    -- Since 1.3.2
    --
    authHashDBWithForm :: forall site user.
                          HashDBPersist site user =>
                          (Route site -> WidgetFor site ())
                       -> (Text -> Maybe (Unique user))
                       -> AuthPlugin site
    authHashDBWithForm :: forall site user.
    HashDBPersist site user =>
    (Route site -> WidgetFor site ())
    -> (Text -> Maybe (Unique user)) -> AuthPlugin site
    authHashDBWithForm Route site -> WidgetFor site ()
    form Text -> Maybe (Unique user)
    uniq =
        Text
    -> (Text -> Texts -> AuthHandler site TypedContent)
    -> ((AuthRoute -> Route site) -> WidgetFor site ())
    -> AuthPlugin site
    forall master.
    Text
    -> (Text -> Texts -> AuthHandler master TypedContent)
    -> ((AuthRoute -> Route master) -> WidgetFor master ())
    -> AuthPlugin master
    AuthPlugin Text
    "hashdb" Text -> Texts -> m TypedContent
    Text -> Texts -> AuthHandler site TypedContent
    dispatch (((AuthRoute -> Route site) -> WidgetFor site ())
     -> AuthPlugin site)
    -> ((AuthRoute -> Route site) -> WidgetFor site ())
    -> AuthPlugin site
    forall a b. (a -> b) -> a -> b
    $ \AuthRoute -> Route site
    tm -> Route site -> WidgetFor site ()
    form (AuthRoute -> Route site
    tm AuthRoute
    login)
        where
            dispatch :: Text -> [Text] -> AuthHandler site TypedContent
            dispatch :: Text -> Texts -> AuthHandler site TypedContent
    dispatch Text
    "POST" [Text
    "login"] = (Text -> Maybe (Unique user)) -> AuthHandler site TypedContent
    forall site user.
    HashDBPersist site user =>
    (Text -> Maybe (Unique user)) -> AuthHandler site TypedContent
    postLoginR Text -> Maybe (Unique user)
    uniq m TypedContent
    -> (TypedContent -> m TypedContent) -> m TypedContent
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TypedContent -> m TypedContent
    forall (m :: * -> *) c a.
    (MonadHandler m, ToTypedContent c) =>
    c -> m a
    sendResponse
            dispatch Text
    _ Texts
    _              = m TypedContent
    forall (m :: * -> *) a. MonadHandler m => m a
    notFound

    defaultForm :: Yesod app => Route app -> WidgetFor app ()
    defaultForm :: forall app. Yesod app => Route app -> WidgetFor app ()
    defaultForm Route app
    loginRoute = do
        request <- WidgetFor app YesodRequest
    forall (m :: * -> *). MonadHandler m => m YesodRequest
    getRequest
        let mtok = YesodRequest -> Maybe Text
    reqToken YesodRequest
    request
        toWidget [hamlet|
          $newline never
          <div id="header">
            <h1>Login

          <div id="login">
            <form method="post" action="@{loginRoute}">
              $maybe tok <- mtok
                <input type=hidden name=#{defaultCsrfParamName} value=#{tok}>
              <table>
                <tr>
                  <th>Username:
                  <td>
                    <input id="x" name="username" autofocus="" required>
                <tr>
                  <th>Password:
                  <td>
                    <input type="password" name="password" required>
                <tr>
                  <td>&nbsp;
                  <td>
                    <input type="submit" value="Login">

              <script>
                if (!("autofocus" in document.createElement("input"))) {
                    document.getElementById("x").focus();
                }

        |]

    -- | The route, in the parent site, to which the username and password
    --   should be sent in order to log in.  This function is particularly
    --   useful in constructing a 'loginHandler' function which provides a
    --   JSON response.  See the \"JSON Interface\" section above for more
    --   details.
    --
    --   Since 1.6
    submitRouteHashDB :: YesodAuth site => AuthHandler site (Route site)
    submitRouteHashDB :: forall site. YesodAuth site => AuthHandler site (Route site)
    submitRouteHashDB = do
        toParent <- m (AuthRoute -> Route site)
    m (Route (SubHandlerSite m) -> Route (HandlerSite m))
    forall (m :: * -> *).
    MonadHandler m =>
    m (Route (SubHandlerSite m) -> Route (HandlerSite m))
    getRouteToParent
        return $ toParent login