auth now using yesod-auth providers. Multiple providers supported.

Foundation.hs

@@ -8,6 +8,7 @@ import Yesod.Auth.BrowserId (authBrowserId)
 import Yesod.Default.Util   (addStaticContentExternal)
 import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
+import Yesod.Auth.HashDB    (authHashDB, getAuthIdHashDB)
 
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
@@ -121,21 +122,18 @@ instance YesodAuth App where
     -- Override the above two destinations when a Referer: header is present
     redirectToReferer _ = True
 
-    getAuthId creds = do
-      now <- liftIO getCurrentTime
+    getAuthId creds = getAuthIdHashDB AuthR (Just . UniqueUser) creds --authenticate on own site
+                      --TODO: Authenticate via OAuth2
+    {-do
       runDB $ do
         x <- getBy $ UniqueUser $ credsIdent creds
         case x of
             Just (Entity uid _) -> return $ Just uid
-            Nothing -> do
-                fmap Just $ insert User
-                    { userIdent = credsIdent creds
-                    , userPassword = Nothing
-                    , userLastLogin = now
-                    }
+            Nothing -> return Nothing-}
 
     -- You can add other plugins like BrowserID, email or OAuth here
     authPlugins _ = [ authBrowserId def
+                    , authHashDB (Just . UniqueUser)
                     ]
 
     authHttpManager = getHttpManager

Handler/Home.hs

@@ -1,9 +1,6 @@
 module Handler.Home where
 
 import Import
-import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
-                              withSmallInput, withPlaceholder, bfs,
-                              withAutofocus)
 
 -- This is a handler function for the GET request method on the HomeR
 -- resource pattern. All of your resource patterns are defined in
@@ -15,7 +12,6 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
 getHomeR :: Handler Html
 getHomeR = do
     maid <- maybeAuthId
-    (loginWidget, loginEnctype) <- generateFormPost loginForm
     defaultLayout $ do
         setTitle "NEAT"
         [whamlet|
@@ -23,16 +19,15 @@ getHomeR = do
                 Welcome to NEAT.
             <div>
                 Current Auth-ID: #{show maid}.
+            <div>
                 $maybe u <- maid
                     <p>
                        Data: #{show u}<br>
                        <a href=@{AuthR LogoutR}>Logout
                 $nothing
-                    Login
-                    <a href=@{AuthR LoginR}>Login-Page
-                    <form method=post action=@{HomeR} enctype=#{loginEnctype}>
-                        ^{loginWidget}
-                        <button>Submit
+                    <p>
+                        <a href=@{AuthR LoginR}>Login
+                    <p>
                         <a href=@{RegisterR}>Register Account
         |]
 {-
@@ -46,7 +41,10 @@ getHomeR = do
 
 postHomeR :: Handler Html
 postHomeR = do
-    ((result, loginWidget), loginEnctype) <- runFormPost loginForm
+    defaultLayout $ [whamlet|
+    <h1>nothing to see here. Stuff coming soon (tm).
+    |]
+{-    ((result, loginWidget), loginEnctype) <- runFormPost loginForm
     let loginfail err = defaultLayout $ do
         setTitle "NEAT"
         [whamlet|
@@ -67,15 +65,10 @@ postHomeR = do
                          Nothing -> loginfail ("wrong username or password" :: Text)
                          Just (Entity _ (User name _ _)) ->
                                 defaultLayout $ do [whamlet|<h1>Hello #{name}|]
-      _ -> loginfail ("wrong username or password" :: Text)
+      _ -> loginfail ("wrong username or password" :: Text)-}
 
 
-sampleForm :: Form (FileInfo, Text)
-sampleForm = renderBootstrap3 BootstrapBasicForm $ (,)
-    <$> fileAFormReq "Choose a file"
-    <*> areq textField (withSmallInput "What's on the file?") Nothing
-
-loginForm :: Form (Text, Text)
+{-loginForm :: Form (Text, Text)
 loginForm = renderBootstrap3 BootstrapBasicForm $ (,)
     <$> areq textField ((withAutofocus . withPlaceholder "Username") (bfs ("Username" :: Text))) Nothing
-    <*> areq passwordField (bfs ("Password" :: Text)) Nothing
+    <*> areq passwordField (bfs ("Password" :: Text)) Nothing-}

Handler/Register.hs

@@ -2,6 +2,7 @@ module Handler.Register where
 
 import Import
 import Yesod.Form.Bootstrap3
+import Yesod.Auth.HashDB (setPassword)
 import Handler.Home (getHomeR)
 
 getRegisterR :: Handler Html
@@ -28,8 +29,9 @@ postRegisterR = do
                   |]
                 case result of
                   FormSuccess (user,mail) -> do
+                        u <- liftIO $ setPassword (fromMaybe "" $ userPassword user) user
                         _ <- runDB $ do
-                            uid <- insert user
+                            uid <- insert u 
                             insert $ Email mail uid Nothing
                         getHomeR
                   FormFailure (err:_) -> again err

Model.hs

@@ -2,6 +2,7 @@ module Model where
 
 import ClassyPrelude.Yesod
 import Database.Persist.Quasi
+import Yesod.Auth.HashDB (HashDBUser(..))
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -9,3 +10,7 @@ import Database.Persist.Quasi
 -- http://www.yesodweb.com/book/persistent/
 share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
+
+instance HashDBUser User where
+    userPasswordHash = userPassword
+    setPasswordHash h p = p { userPassword = Just h }

neat.cabal

@@ -52,9 +52,9 @@ library
                  , yesod                         >= 1.4.1      && < 1.5
                  , yesod-core                    >= 1.4.6      && < 1.5
                  , yesod-auth                    >= 1.4.0      && < 1.5
-                 , yesod-persistent              >= 1.4.0      && < 1.5
                  , yesod-static                  >= 1.4.0.3    && < 1.5
                  , yesod-form                    >= 1.4.0      && < 1.5
+                 , yesod-auth-hashdb             >= 1.4.0      && < 1.5
                  , classy-prelude                >= 0.10.2
                  , classy-prelude-conduit        >= 0.10.2
                  , classy-prelude-yesod          >= 0.10.2