diff --git a/config/models b/config/models index ff73c40..ee4023d 100644 --- a/config/models +++ b/config/models @@ -1,9 +1,10 @@ User username Text maxlen=190 + password Text maxlen=79 fullName Text maxlen=500 email Text maxlen=190 note Text sqltype=mediumtext - UniqueUsername username + UniqueUser username UniqueEmail email deriving Typeable diff --git a/package.yaml b/package.yaml index 9450c46..f582310 100644 --- a/package.yaml +++ b/package.yaml @@ -46,9 +46,11 @@ dependencies: - time - case-insensitive - wai + - conduit-combinators >= 1.1 && < 1.2 - libravatar >=0.4 && <0.5 - split >=0.2 && <0.3 +- yesod-auth-hashdb >=1.6.2 && <1.7 - yesod-sitemap >=1.4 && <1.5 # The library contains all of our application code. The executable diff --git a/src/Foundation.hs b/src/Foundation.hs index e441d28..534040e 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -12,10 +12,9 @@ import Database.Persist.Sql (ConnectionPool, runSqlPool) import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) --- Used only when in "auth-dummy-login" setting is enabled. -import Yesod.Auth.Dummy +import Yesod.Auth.HashDB (authHashDB) +import qualified Yesod.Auth.Message as AuthMsg -import Yesod.Auth.OpenId (authOpenId, IdentifierType (Claimed)) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) import qualified Yesod.Core.Unsafe as Unsafe @@ -125,13 +124,7 @@ instance Yesod App where authRoute _ = Just $ AuthR LoginR -- Routes not requiring authentication. - isAuthorized (AuthR _) _ = return Authorized - isAuthorized HomeR _ = return Authorized - isAuthorized FaviconR _ = return Authorized - isAuthorized KeybaseR _ = return Authorized - isAuthorized RobotsR _ = return Authorized - isAuthorized SitemapR _ = return Authorized - isAuthorized (StaticR _) _ = return Authorized + isAuthorized _ _ = return Authorized -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows @@ -163,9 +156,8 @@ instance Yesod App where -- Define breadcrumbs. instance YesodBreadcrumbs App where - breadcrumb HomeR = return ("Home", Nothing) - breadcrumb (AuthR _) = return ("Login", Just HomeR) - breadcrumb _ = return ("home", Nothing) + breadcrumb (AuthR _) = return ("login", Just HomeR) + breadcrumb _ = return ("home", Nothing) -- How to run database actions. instance YesodPersist App where @@ -183,25 +175,14 @@ instance YesodAuth App where loginDest _ = HomeR -- Where to send a user after logout logoutDest _ = HomeR - -- Override the above two destinations when a Referer: header is present - redirectToReferer _ = True - authenticate creds = runDB $ do - x <- getBy . UniqueUsername $ credsIdent creds - case x of - Just (Entity uid _) -> return $ Authenticated uid - Nothing -> Authenticated <$> insert User - { userUsername = credsIdent creds - , userFullName = "" - , userEmail = "" - , userNote = "" - } + authenticate = fmap toResult . lookupCreds + where + lookupCreds = runDB . getBy . UniqueUser . credsIdent + toResult = UserError AuthMsg.InvalidLogin `maybe` (Authenticated . entityKey) -- You can add other plugins like Google Email, email or OAuth here - authPlugins app = [authOpenId Claimed []] ++ extraAuthPlugins - -- Enable authDummy login if enabled. - where extraAuthPlugins = [authDummy | appAuthDummyLogin $ appSettings app] - + authPlugins _ = [authHashDB (Just . UniqueUser)] authHttpManager = getHttpManager -- | Access function to determine if a user is logged in. diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 74fe394..eae3746 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -10,7 +10,7 @@ import Widget.Hcard (hcard) getHomeR :: Handler Html getHomeR = do - user <- runDB . getBy404 $ UniqueUsername "dani" + user <- runDB . getBy404 $ UniqueUser "dani" let name = userFullName . entityVal $ user maybeTitle <- asks $ appTitle . appSettings defaultLayout $ do diff --git a/src/Model.hs b/src/Model.hs index 4420c16..5a9da96 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -11,6 +11,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 @@ -18,3 +19,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 = Just . userPassword + setPasswordHash pw u = u { userPassword = pw }