From d6ecbf5d0a150b95a7bcc6be6e7a398e07c9dd06 Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Thu, 7 Apr 2011 16:23:07 -0400
Subject: [PATCH] some HashDB cleanups

* inputs are now flagged as required
* handle empty input more elegantly
* don't preformat the setMessage contents
* cleanup some hamlet
---
 Yesod/Helpers/Auth/HashDB.hs | 34 +++++++++++++++++++---------------
 1 file changed, 19 insertions(+), 15 deletions(-)

diff --git a/Yesod/Helpers/Auth/HashDB.hs b/Yesod/Helpers/Auth/HashDB.hs
index 458738c6..b069e1c7 100644
--- a/Yesod/Helpers/Auth/HashDB.hs
+++ b/Yesod/Helpers/Auth/HashDB.hs
@@ -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