own user auth
This commit is contained in:
parent
2411746c6f
commit
d2e2ce5fc6
9 changed files with 51 additions and 96 deletions
|
@ -7,7 +7,7 @@ module Application
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
import Settings
|
import Settings
|
||||||
import Yesod.Auth
|
-- import Yesod.Auth
|
||||||
import Yesod.Default.Config
|
import Yesod.Default.Config
|
||||||
import Yesod.Default.Main
|
import Yesod.Default.Main
|
||||||
import Yesod.Default.Handlers
|
import Yesod.Default.Handlers
|
||||||
|
@ -28,6 +28,9 @@ import Yesod.Core.Types (loggerSet, Logger (Logger))
|
||||||
-- Import all relevant handler modules here.
|
-- Import all relevant handler modules here.
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
import Handler.Home
|
import Handler.Home
|
||||||
|
import Handler.Signup
|
||||||
|
import Handler.Login
|
||||||
|
import Handler.Activate
|
||||||
|
|
||||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||||
|
|
|
@ -3,8 +3,8 @@ module Foundation where
|
||||||
import Prelude
|
import Prelude
|
||||||
import Yesod
|
import Yesod
|
||||||
import Yesod.Static
|
import Yesod.Static
|
||||||
import Yesod.Auth
|
-- import Yesod.Auth
|
||||||
import Yesod.Auth.BrowserId
|
-- import Yesod.Auth.BrowserId
|
||||||
import Yesod.Default.Config
|
import Yesod.Default.Config
|
||||||
import Yesod.Default.Util (addStaticContentExternal)
|
import Yesod.Default.Util (addStaticContentExternal)
|
||||||
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
|
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
|
||||||
|
@ -14,7 +14,7 @@ import qualified Database.Persist
|
||||||
import Database.Persist.Sql (SqlPersistT)
|
import Database.Persist.Sql (SqlPersistT)
|
||||||
import Settings.StaticFiles
|
import Settings.StaticFiles
|
||||||
import Settings (widgetFile, Extra (..))
|
import Settings (widgetFile, Extra (..))
|
||||||
import Model
|
-- import Model
|
||||||
import Text.Jasmine (minifym)
|
import Text.Jasmine (minifym)
|
||||||
import Text.Hamlet (hamletFile)
|
import Text.Hamlet (hamletFile)
|
||||||
import Yesod.Core.Types (Logger)
|
import Yesod.Core.Types (Logger)
|
||||||
|
@ -85,7 +85,7 @@ instance Yesod App where
|
||||||
urlRenderOverride _ _ = Nothing
|
urlRenderOverride _ _ = Nothing
|
||||||
|
|
||||||
-- The page to be redirected to when authentication is required.
|
-- The page to be redirected to when authentication is required.
|
||||||
authRoute _ = Just $ AuthR LoginR
|
-- authRoute _ = Just $ AuthR LoginR
|
||||||
|
|
||||||
-- This function creates static content files in the static folder
|
-- This function creates static content files in the static folder
|
||||||
-- and names them based on a hash of their content. This allows
|
-- and names them based on a hash of their content. This allows
|
||||||
|
@ -116,28 +116,28 @@ instance YesodPersist App where
|
||||||
instance YesodPersistRunner App where
|
instance YesodPersistRunner App where
|
||||||
getDBRunner = defaultGetDBRunner connPool
|
getDBRunner = defaultGetDBRunner connPool
|
||||||
|
|
||||||
instance YesodAuth App where
|
-- instance YesodAuth App where
|
||||||
type AuthId App = UserId
|
-- type AuthId App = UserId
|
||||||
|
|
||||||
-- Where to send a user after successful login
|
-- Where to send a user after successful login
|
||||||
loginDest _ = HomeR
|
-- loginDest _ = HomeR
|
||||||
-- Where to send a user after logout
|
-- Where to send a user after logout
|
||||||
logoutDest _ = HomeR
|
-- logoutDest _ = HomeR
|
||||||
|
|
||||||
getAuthId creds = runDB $ do
|
-- getAuthId creds = runDB $ do
|
||||||
x <- getBy $ UniqueUser $ credsIdent creds
|
-- x <- getBy $ UniqueUser $ credsIdent creds
|
||||||
case x of
|
-- case x of
|
||||||
Just (Entity uid _) -> return $ Just uid
|
-- Just (Entity uid _) -> return $ Just uid
|
||||||
Nothing -> do
|
-- Nothing -> do
|
||||||
fmap Just $ insert User
|
-- fmap Just $ insert User
|
||||||
{ userIdent = credsIdent creds
|
-- { userIdent = credsIdent creds
|
||||||
, userPassword = Nothing
|
-- , userPassword = Nothing
|
||||||
}
|
-- }
|
||||||
|
|
||||||
-- You can add other plugins like BrowserID, email or OAuth here
|
-- You can add other plugins like BrowserID, email or OAuth here
|
||||||
authPlugins _ = [authBrowserId def]
|
-- authPlugins _ = [authBrowserId def]
|
||||||
|
|
||||||
authHttpManager = httpManager
|
-- authHttpManager = httpManager
|
||||||
|
|
||||||
-- This instance is required to use forms. You can modify renderMessage to
|
-- This instance is required to use forms. You can modify renderMessage to
|
||||||
-- achieve customized and internationalized form validation messages.
|
-- achieve customized and internationalized form validation messages.
|
||||||
|
|
|
@ -12,28 +12,10 @@ import Import
|
||||||
-- inclined, or create a single monolithic file.
|
-- inclined, or create a single monolithic file.
|
||||||
getHomeR :: Handler Html
|
getHomeR :: Handler Html
|
||||||
getHomeR = do
|
getHomeR = do
|
||||||
(formWidget, formEnctype) <- generateFormPost sampleForm
|
recentMedia <- runDB $ selectList [] [Desc MediaTime]
|
||||||
let submission = Nothing :: Maybe (FileInfo, Text)
|
|
||||||
handlerName = "getHomeR" :: Text
|
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
aDomId <- newIdent
|
$(widgetFile "home")
|
||||||
setTitle "Welcome To Yesod!"
|
|
||||||
$(widgetFile "homepage")
|
|
||||||
|
|
||||||
postHomeR :: Handler Html
|
postHomeR :: Handler Html
|
||||||
postHomeR = do
|
postHomeR = do
|
||||||
((result, formWidget), formEnctype) <- runFormPost sampleForm
|
error "not yet implemented"
|
||||||
let handlerName = "postHomeR" :: Text
|
|
||||||
submission = case result of
|
|
||||||
FormSuccess res -> Just res
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
defaultLayout $ do
|
|
||||||
aDomId <- newIdent
|
|
||||||
setTitle "Welcome To Yesod!"
|
|
||||||
$(widgetFile "homepage")
|
|
||||||
|
|
||||||
sampleForm :: Form (FileInfo, Text)
|
|
||||||
sampleForm = renderDivs $ (,)
|
|
||||||
<$> fileAFormReq "Choose a file"
|
|
||||||
<*> areq textField "What's on the file?" Nothing
|
|
||||||
|
|
|
@ -1,12 +1,22 @@
|
||||||
User
|
User
|
||||||
ident Text
|
name Text
|
||||||
password Text Maybe
|
|
||||||
UniqueUser ident
|
|
||||||
deriving Typeable
|
|
||||||
Email
|
|
||||||
email Text
|
email Text
|
||||||
user UserId Maybe
|
password Text
|
||||||
verkey Text Maybe
|
deriving Typeable
|
||||||
UniqueEmail email
|
-- Email
|
||||||
|
-- email Text
|
||||||
|
-- user UserId Maybe
|
||||||
|
-- verkey Text Maybe
|
||||||
|
-- UniqueEmail email
|
||||||
|
Token
|
||||||
|
token Text
|
||||||
|
user User
|
||||||
|
Media
|
||||||
|
title Text
|
||||||
|
path FilePath
|
||||||
|
thumbPath FilePath
|
||||||
|
time UTCTime
|
||||||
|
description Text
|
||||||
|
tags Texts
|
||||||
|
|
||||||
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
/static StaticR Static getStatic
|
/static StaticR Static getStatic
|
||||||
/auth AuthR Auth getAuth
|
|
||||||
|
|
||||||
/favicon.ico FaviconR GET
|
/favicon.ico FaviconR GET
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
|
|
||||||
/ HomeR GET POST
|
/ HomeR GET POST
|
||||||
|
/signup SignupR GET POST
|
||||||
|
/login LoginR GET POST
|
||||||
|
/activate/#String ActivateR GET
|
||||||
|
|
|
@ -20,6 +20,9 @@ library
|
||||||
Settings.StaticFiles
|
Settings.StaticFiles
|
||||||
Settings.Development
|
Settings.Development
|
||||||
Handler.Home
|
Handler.Home
|
||||||
|
Handler.Signup
|
||||||
|
Handler.Login
|
||||||
|
Handler.Activate
|
||||||
|
|
||||||
if flag(dev) || flag(library-only)
|
if flag(dev) || flag(library-only)
|
||||||
cpp-options: -DDEVELOPMENT
|
cpp-options: -DDEVELOPMENT
|
||||||
|
|
|
@ -1,38 +0,0 @@
|
||||||
<h1>_{MsgHello}
|
|
||||||
|
|
||||||
<ol>
|
|
||||||
<li>Now that you have a working project you should use the #
|
|
||||||
\<a href="http://www.yesodweb.com/book/">Yesod book</a> to learn more. #
|
|
||||||
You can also use this scaffolded site to explore some basic concepts.
|
|
||||||
|
|
||||||
<li> This page was generated by the #{handlerName} handler in #
|
|
||||||
\<em>Handler/Home.hs</em>.
|
|
||||||
|
|
||||||
<li> The #{handlerName} handler is set to generate your site's home screen in Routes file #
|
|
||||||
<em>config/routes
|
|
||||||
|
|
||||||
<li> The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
|
|
||||||
most of them are brought together by the <em>defaultLayout</em> function which #
|
|
||||||
is defined in the <em>Foundation.hs</em> module, and used by <em>#{handlerName}</em>. #
|
|
||||||
All the files for templates and wigdets are in <em>templates</em>.
|
|
||||||
|
|
||||||
<li>
|
|
||||||
A Widget's Html, Css and Javascript are separated in three files with the #
|
|
||||||
\<em>.hamlet</em>, <em>.lucius</em> and <em>.julius</em> extensions.
|
|
||||||
|
|
||||||
<li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this.
|
|
||||||
|
|
||||||
<li #form>
|
|
||||||
This is an example trivial Form. Read the #
|
|
||||||
\<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> #
|
|
||||||
on the yesod book to learn more about them.
|
|
||||||
$maybe (info,con) <- submission
|
|
||||||
<div .message>
|
|
||||||
Your file's type was <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
|
|
||||||
<form method=post action=@{HomeR}#form enctype=#{formEnctype}>
|
|
||||||
^{formWidget}
|
|
||||||
<input type="submit" value="Send it!">
|
|
||||||
|
|
||||||
<li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a #
|
|
||||||
test suite that performs tests on this page. #
|
|
||||||
You can run your tests by doing: <pre>yesod test</pre>
|
|
|
@ -1 +0,0 @@
|
||||||
document.getElementById(#{toJSON aDomId}).innerHTML = "This text was added by the Javascript part of the homepage widget.";
|
|
|
@ -1,6 +0,0 @@
|
||||||
h1 {
|
|
||||||
text-align: center
|
|
||||||
}
|
|
||||||
h2##{aDomId} {
|
|
||||||
color: #990
|
|
||||||
}
|
|
Loading…
Reference in a new issue