haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

some HashDB cleanups

Browse Source 
* inputs are now flagged as required
* handle empty input more elegantly
* don't preformat the setMessage contents
* cleanup some hamlet
This commit is contained in:
patrick brisbin 2011-04-07 16:23:07 -04:00
parent ef635dc07d
commit d6ecbf5d0a
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
Yesod/Helpers/Auth/HashDB.hs
View File

@ -72,6 +72,7 @@ import Text.Hamlet (hamlet)
import Control.Applicative ((<$>), (<*>))
import Data.ByteString.Lazy.Char8 (pack)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Maybe (fromMaybe)
import Database.Persist.TH (share2)
import Database.Persist.GenericSql (mkMigrate)
@ -114,14 +115,17 @@ postLoginR :: (YesodAuth y,
PersistBackend (YesodDB y (GGHandler Auth y IO)))
=> GHandler Auth y ()
postLoginR = do
(user, password) <- runFormPost' $ (,)
<$> stringInput "username"
<*> stringInput "password"
(mu,mp) <- runFormPost' $ (,)
<$> maybeStringInput "username"
<*> maybeStringInput "password"
isValid <- validateUser (user,password)
isValid <- case (mu,mp) of
(Nothing, _ ) -> return False
(_ , Nothing) -> return False
(Just u , Just p ) -> validateUser (u,p)
if isValid
then setCreds True $ Creds "hashdb" user []
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
else do
setMessage
#if GHC7
@ -129,7 +133,7 @@ postLoginR = do
#else
[$hamlet|
#endif
<em>invalid username/password
Invalid username/password
|]
toMaster <- getRouteToMaster
redirect RedirectTemporary $ toMaster LoginR
@ -160,7 +164,7 @@ getAuthIdHashDB authR creds = do
#else
[$hamlet|
#endif
<em>user not found
User not found
|]
redirect RedirectTemporary $ authR LoginR
@ -178,28 +182,28 @@ authHashDB = AuthPlugin "hashdb" dispatch $ \tm ->
#endif
<div id="header">
<h1>Login
\
<div id="login">
<form method="post" action="@{tm login}">
<table>
<tr>
<th>Username:
<td>
<input id="x" name="username" autofocus="">
<input id="x" name="username" autofocus="" required>
<tr>
<th>Password:
<td>
<input type="password" name="password">
<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();
\}
\
if (!("autofocus" in document.createElement("input"))) {
document.getElementById("x").focus();
}
|]
where
dispatch "POST" ["login"] = postLoginR >>= sendResponse