Enable simple username+password login - ugly but serviceable
This commit is contained in:
parent
e141fb4666
commit
f934632484
5 changed files with 20 additions and 31 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 }
|
||||
|
|
Loading…
Reference in a new issue