haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #8 from Shimuuar/master

Browse Source 
HashDB improvements and refactorings
This commit is contained in:
Michael Snoyman 2011-06-09 09:44:35 -07:00
commit bbdca8cb5d
10 changed files with 202 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
Yesod/Auth.hs
View File

@ -22,19 +22,27 @@ module Yesod.Auth
, requireAuth , requireAuth
) where ) where
#include "qq.h"
import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as Map
import Language.Haskell.TH.Syntax hiding (lift)
import qualified Network.Wai as W
import Text.Hamlet (hamlet)
import Yesod.Core import Yesod.Core
import Yesod.Persist import Yesod.Persist
import Yesod.Json import Yesod.Json
import Language.Haskell.TH.Syntax hiding (lift)
import qualified Network.Wai as W
import Text.Hamlet (hamlet)
import qualified Data.Map as Map
import Control.Monad.Trans.Class (lift)
import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Yesod.Auth.Message (AuthMessage, defaultMessage) import Yesod.Auth.Message (AuthMessage, defaultMessage)
import qualified Yesod.Auth.Message as Msg import qualified Yesod.Auth.Message as Msg
import Yesod.Form (FormMessage) import Yesod.Form (FormMessage)
@ -91,11 +99,7 @@ mkYesodSub "Auth"
[ ClassP ''YesodAuth [VarT $ mkName "master"] [ ClassP ''YesodAuth [VarT $ mkName "master"]
] ]
#define STRINGS *Texts #define STRINGS *Texts
#if GHC7 [QQ(parseRoutes)|
[parseRoutes|
#else
[$parseRoutes|
#endif
/check CheckR GET /check CheckR GET
/login LoginR GET /login LoginR GET
/logout LogoutR GET POST /logout LogoutR GET POST
@ -108,34 +112,21 @@ credsKey = "_ID"
-- | FIXME: won't show up till redirect -- | FIXME: won't show up till redirect
setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m () setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m ()
setCreds doRedirects creds = do setCreds doRedirects creds = do
y <- getYesod y <- getYesod
maid <- getAuthId creds maid <- getAuthId creds
case maid of case maid of
Nothing -> Nothing ->
if doRedirects when doRedirects $ do
then do case authRoute y of
case authRoute y of Nothing -> do rh <- defaultLayout [QQ(hamlet)| <h1>Invalid login |]
Nothing -> do
rh <- defaultLayout
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
<h1>Invalid login
|]
sendResponse rh sendResponse rh
Just ar -> do Just ar -> do setMessageI Msg.InvalidLogin
setMessageI Msg.InvalidLogin
redirect RedirectTemporary ar redirect RedirectTemporary ar
else return ()
Just aid -> do Just aid -> do
setSession credsKey $ toSinglePiece aid setSession credsKey $ toSinglePiece aid
if doRedirects when doRedirects $ do
then do setMessageI Msg.NowLoggedIn
setMessageI Msg.NowLoggedIn redirectUltDest RedirectTemporary $ loginDest y
redirectUltDest RedirectTemporary $ loginDest y
else return ()
getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson
getCheckR = do getCheckR = do
@ -145,11 +136,7 @@ getCheckR = do
addHtml $ html creds) (json' creds) addHtml $ html creds) (json' creds)
where where
html creds = html creds =
#if GHC7 [QQ(hamlet)|
[hamlet|
#else
[$hamlet|
#endif
<h1>Authentication Status <h1>Authentication Status
$maybe _ <- creds $maybe _ <- creds
<p>Logged in. <p>Logged in.
@ -195,15 +182,10 @@ maybeAuth :: ( YesodAuth m
, PersistEntity val , PersistEntity val
, YesodPersist m , YesodPersist m
) => GHandler s m (Maybe (Key val, val)) ) => GHandler s m (Maybe (Key val, val))
maybeAuth = do maybeAuth = runMaybeT $ do
maid <- maybeAuthId aid <- MaybeT $ maybeAuthId
case maid of a <- MaybeT $ runDB $ get aid
Nothing -> return Nothing return (aid, a)
Just aid -> do
ma <- runDB $ get aid
case ma of
Nothing -> return Nothing
Just a -> return $ Just (aid, a)
requireAuthId :: YesodAuth m => GHandler s m (AuthId m) requireAuthId :: YesodAuth m => GHandler s m (AuthId m)
requireAuthId = maybeAuthId >>= maybe redirectLogin return requireAuthId = maybeAuthId >>= maybe redirectLogin return

8
Yesod/Auth/Dummy.hs
View File

@ -8,6 +8,8 @@ module Yesod.Auth.Dummy
( authDummy ( authDummy
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import Yesod.Form (runInputPost, textField, ireq) import Yesod.Form (runInputPost, textField, ireq)
import Yesod.Handler (notFound) import Yesod.Handler (notFound)
@ -23,11 +25,7 @@ authDummy =
dispatch _ _ = notFound dispatch _ _ = notFound
url = PluginR "dummy" [] url = PluginR "dummy" []
login authToMaster = login authToMaster =
#if GHC7 [QQ(hamlet)|
[hamlet|
#else
[$hamlet|
#endif
<form method="post" action="@{authToMaster url}"> <form method="post" action="@{authToMaster url}">
\Your new identifier is: \Your new identifier is:
<input type="text" name="ident"> <input type="text" name="ident">

36
Yesod/Auth/Email.hs
View File

@ -14,6 +14,8 @@ module Yesod.Auth.Email
, setpassR , setpassR
) where ) where
#include "qq.h"
import Network.Mail.Mime (randomString) import Network.Mail.Mime (randomString)
import Yesod.Auth import Yesod.Auth
import System.Random import System.Random
@ -81,11 +83,7 @@ authEmail =
AuthPlugin "email" dispatch $ \tm -> do AuthPlugin "email" dispatch $ \tm -> do
y <- lift getYesod y <- lift getYesod
l <- lift languages l <- lift languages
#if GHC7 [QQ(whamlet)|
[whamlet|
#else
[$whamlet|
#endif
<form method="post" action="@{tm loginR}"> <form method="post" action="@{tm loginR}">
<table> <table>
<tr> <tr>
@ -119,11 +117,7 @@ getRegisterR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.RegisterLong setTitleI Msg.RegisterLong
addWidget addWidget
#if GHC7 [QQ(whamlet)|
[whamlet|
#else
[$whamlet|
#endif
<p>_{Msg.EnterEmail} <p>_{Msg.EnterEmail}
<form method="post" action="@{toMaster registerR}"> <form method="post" action="@{toMaster registerR}">
<label for="email">_{Msg.Email} <label for="email">_{Msg.Email}
@ -154,13 +148,7 @@ postRegisterR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle setTitleI Msg.ConfirmationEmailSentTitle
addWidget addWidget
#if GHC7 [QQ(whamlet)| <p>_{Msg.ConfirmationEmailSent email} |]
[whamlet|
#else
[$whamlet|
#endif
<p>_{Msg.ConfirmationEmailSent email}
|]
getVerifyR :: YesodAuthEmail m getVerifyR :: YesodAuthEmail m
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml => AuthEmailId m -> Text -> GHandler Auth m RepHtml
@ -181,13 +169,7 @@ getVerifyR lid key = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.InvalidKey setTitleI Msg.InvalidKey
addWidget addWidget
#if GHC7 [QQ(whamlet)| <p>_{Msg.InvalidKey} |]
[whamlet|
#else
[$whamlet|
#endif
<p>_{Msg.InvalidKey}
|]
postLoginR :: YesodAuthEmail master => GHandler Auth master () postLoginR :: YesodAuthEmail master => GHandler Auth master ()
postLoginR = do postLoginR = do
@ -226,11 +208,7 @@ getPasswordR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.SetPassTitle setTitleI Msg.SetPassTitle
addWidget addWidget
#if GHC7 [QQ(whamlet)|
[whamlet|
#else
[$whamlet|
#endif
<h3>_{Msg.SetPass} <h3>_{Msg.SetPass}
<form method="post" action="@{toMaster setpassR}"> <form method="post" action="@{toMaster setpassR}">
<table> <table>

8
Yesod/Auth/Facebook.hs
View File

@ -6,6 +6,8 @@ module Yesod.Auth.Facebook
, facebookUrl , facebookUrl
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import qualified Web.Authenticate.Facebook as Facebook import qualified Web.Authenticate.Facebook as Facebook
import Data.Aeson import Data.Aeson
@ -56,11 +58,7 @@ authFacebook cid secret perms =
render <- lift getUrlRender render <- lift getUrlRender
let fb = Facebook.Facebook cid secret $ render $ tm url let fb = Facebook.Facebook cid secret $ render $ tm url
let furl = Facebook.getForwardUrl fb $ perms let furl = Facebook.getForwardUrl fb $ perms
#if GHC7 [QQ(whamlet)|
[whamlet|
#else
[$whamlet|
#endif
<p> <p>
<a href="#{furl}">_{Msg.Facebook} <a href="#{furl}">_{Msg.Facebook}
|] |]

224
Yesod/Auth/HashDB.hs
View File

@ -16,8 +16,7 @@
-- Portability : Portable -- Portability : Portable
-- --
-- A yesod-auth AuthPlugin designed to look users up in Persist where -- A yesod-auth AuthPlugin designed to look users up in Persist where
-- their user id's and a sha1 hash of their password will already be -- their user id's and a salted SHA1 hash of their password is stored.
-- stored.
-- --
-- Example usage: -- Example usage:
-- --
@ -37,10 +36,8 @@
-- > -- >
-- > loginDest _ = RootR -- > loginDest _ = RootR
-- > logoutDest _ = RootR -- > logoutDest _ = RootR
-- > getAuthId = getAuthIdHashDB AuthR -- > getAuthId = getAuthIdHashDB AuthR (Just . UniqueUser)
-- > showAuthId _ = showIntegral -- > authPlugins = [authHashDB (Just . UniqueUser)]
-- > readAuthId _ = readIntegral
-- > authPlugins = [authHashDB]
-- > -- >
-- > -- >
-- > -- include the migration function in site startup -- > -- include the migration function in site startup
@ -49,21 +46,31 @@
-- > runSqlPool (runMigration migrateUsers) p -- > runSqlPool (runMigration migrateUsers) p
-- > let h = DevSite p -- > let h = DevSite p
-- --
-- Your app must be an instance of YesodPersist and the username and -- Note that function which converts username to unique identifier must be same.
-- hashed-passwords must be added manually to the database.
-- --
-- > echo -n 'MyPassword' | sha1sum -- Your app must be an instance of YesodPersist. and the username,
-- salt and hashed-passwords should be added to the database.
--
-- > echo -n 'MySaltMyPassword' | sha1sum
-- --
-- can be used to get the hash from the commandline. -- can be used to get the hash from the commandline.
-- --
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
module Yesod.Auth.HashDB module Yesod.Auth.HashDB
( authHashDB ( HashDBUser(..)
, setPassword
-- * Authentification
, validateUser
, authHashDB
, getAuthIdHashDB , getAuthIdHashDB
-- * Predefined data type
, User(..)
, UserId , UserId
, migrateUsers , migrateUsers
) where ) where
#include "qq.h"
import Yesod.Persist import Yesod.Persist
import Yesod.Handler import Yesod.Handler
import Yesod.Form import Yesod.Form
@ -71,115 +78,130 @@ import Yesod.Auth
import Text.Hamlet (hamlet) import Text.Hamlet (hamlet)
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Data.ByteString.Lazy.Char8 (pack) import Control.Monad (replicateM,liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString.Lazy.Char8 as BS (pack)
import Data.Digest.Pure.SHA (sha1, showDigest) import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Text (Text, unpack) import Data.Text (Text, pack, unpack, append)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Random (randomRIO)
-- | Computer the sha1 of a string and return it as a string
sha1String :: String -> String
sha1String = showDigest . sha1 . pack
-- | Generate data base instances for a valid user -- | Interface for data type which holds user info. It's just a
share2 mkPersist (mkMigrate "migrateUsers") -- collection of getters and setters
#if GHC7 class HashDBUser user where
[persist| -- | Retrieve password hash from user data
#else userPasswordHash :: user -> Maybe Text
[$persist| -- | Retrieve salt for password
#endif userPasswordSalt :: user -> Maybe Text
User -- | Set hash and password
username Text Eq setUserHashAndSalt :: Text -- ^ Salt
password Text -> Text -- ^ Password hash
UniqueUser username -> user -> user
|]
-- | Generate random salt. Length of 8 is chosen arbitrarily
randomSalt :: MonadIO m => m Text
randomSalt = pack `liftM` liftIO (replicateM 8 (randomRIO ('0','z')))
-- | Calculate salted hash using SHA1.
saltedHash :: Text -- ^ Salt
-> Text -- ^ Password
-> Text
saltedHash salt =
pack . showDigest . sha1 . BS.pack . unpack . append salt
-- | Set password for user. This function should be used for setting
-- passwords. It generates random salt and calculates proper hashes.
setPassword :: (MonadIO m, HashDBUser user) => Text -> user -> m user
setPassword pwd u = do salt <- randomSalt
return $ setUserHashAndSalt salt (saltedHash salt pwd) u
----------------------------------------------------------------
-- Authentification
----------------------------------------------------------------
-- | Given a user ID and password in plaintext, validate them against
-- the database values.
validateUser :: ( YesodPersist yesod
, PersistBackend (YesodDB yesod (GGHandler sub yesod IO))
, PersistEntity user
, HashDBUser user
) =>
Unique user -- ^ User unique identifier
-> Text -- ^ Password in plaint-text
-> GHandler sub yesod Bool
validateUser userID passwd = do
-- Checks that hash and password match
let validate u = do hash <- userPasswordHash u
salt <- userPasswordSalt u
return $ hash == saltedHash salt passwd
-- Get user data
user <- runDB $ getBy userID
return $ fromMaybe False $ validate . snd =<< user
-- | Given a (user,password) in plaintext, validate them against the
-- database values
validateUser :: (YesodPersist y,
PersistBackend (YesodDB y (GGHandler sub y IO)))
=> (Text, Text)
-> GHandler sub y Bool
validateUser (user,password) = runDB (getBy $ UniqueUser user) >>= \dbUser ->
case dbUser of
-- user not found
Nothing -> return False
-- validate password
Just (_, sqlUser) -> return $ sha1String (unpack password) == unpack (userPassword sqlUser)
login :: AuthRoute login :: AuthRoute
login = PluginR "hashdb" ["login"] login = PluginR "hashdb" ["login"]
-- | Handle the login form
postLoginR :: (YesodAuth y, -- | Handle the login form. First parameter is function which maps
YesodPersist y, -- username (whatever it might be) to unique user ID.
PersistBackend (YesodDB y (GGHandler Auth y IO))) postLoginR :: ( YesodAuth y, YesodPersist y
=> GHandler Auth y () , HashDBUser user, PersistEntity user
postLoginR = do , PersistBackend (YesodDB y (GGHandler Auth y IO)))
=> (Text -> Maybe (Unique user))
-> GHandler Auth y ()
postLoginR uniq = do
(mu,mp) <- runInputPost $ (,) (mu,mp) <- runInputPost $ (,)
<$> iopt textField "username" <$> iopt textField "username"
<*> iopt textField "password" <*> iopt textField "password"
isValid <- case (mu,mp) of isValid <- fromMaybe (return False)
(Nothing, _ ) -> return False (validateUser <$> (uniq =<< mu) <*> mp)
(_ , Nothing) -> return False
(Just u , Just p ) -> validateUser (u,p)
if isValid if isValid
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) [] then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
else do else do setMessage [QQ(hamlet)| Invalid username/password |]
setMessage toMaster <- getRouteToMaster
#if GHC7 redirect RedirectTemporary $ toMaster LoginR
[hamlet|
#else
[$hamlet|
#endif
Invalid username/password
|]
toMaster <- getRouteToMaster
redirect RedirectTemporary $ toMaster LoginR
-- | A drop in for the getAuthId method of your YesodAuth instance which -- | A drop in for the getAuthId method of your YesodAuth instance which
-- can be used if authHashDB is the only plugin in use. -- can be used if authHashDB is the only plugin in use.
getAuthIdHashDB :: (Key User ~ AuthId master, getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
PersistBackend (YesodDB master (GGHandler sub master IO)), , HashDBUser user, PersistEntity user
YesodPersist master, , Key user ~ AuthId master
YesodAuth master) , PersistBackend (YesodDB master (GGHandler sub master IO)))
=> (AuthRoute -> Route master) -- ^ your site's Auth Route => (AuthRoute -> Route master) -- ^ your site's Auth Route
-> Creds m -- ^ the creds argument -> (Text -> Maybe (Unique user)) -- ^ gets user ID
-> GHandler sub master (Maybe UserId) -> Creds master -- ^ the creds argument
getAuthIdHashDB authR creds = do -> GHandler sub master (Maybe (AuthId master))
getAuthIdHashDB authR uniq creds = do
muid <- maybeAuth muid <- maybeAuth
case muid of case muid of
-- user already authenticated -- user already authenticated
Just (uid, _) -> return $ Just uid Just (uid, _) -> return $ Just uid
Nothing -> do Nothing -> do
x <- runDB $ getBy $ UniqueUser (credsIdent creds) x <- case uniq (credsIdent creds) of
Nothing -> return Nothing
Just u -> runDB (getBy u)
case x of case x of
-- user exists -- user exists
Just (uid, _) -> return $ Just uid Just (uid, _) -> return $ Just uid
Nothing -> do Nothing -> do
setMessage setMessage [QQ(hamlet)| User not found |]
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
User not found
|]
redirect RedirectTemporary $ authR LoginR redirect RedirectTemporary $ authR LoginR
-- | Prompt for username and password, validate that against a database -- | Prompt for username and password, validate that against a database
-- which holds the username and a hash of the password -- which holds the username and a hash of the password
authHashDB :: (YesodAuth y, authHashDB :: ( YesodAuth m, YesodPersist m
YesodPersist y, , HashDBUser user
PersistBackend (YesodDB y (GGHandler Auth y IO))) , PersistEntity user
=> AuthPlugin y , PersistBackend (YesodDB m (GGHandler Auth m IO)))
authHashDB = AuthPlugin "hashdb" dispatch $ \tm -> => (Text -> Maybe (Unique user)) -> AuthPlugin m
#if GHC7 authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm ->
[hamlet| [QQ(hamlet)|
#else
[$hamlet|
#endif
<div id="header"> <div id="header">
<h1>Login <h1>Login
@ -206,5 +228,27 @@ authHashDB = AuthPlugin "hashdb" dispatch $ \tm ->
|] |]
where where
dispatch "POST" ["login"] = postLoginR >>= sendResponse dispatch "POST" ["login"] = postLoginR uniq >>= sendResponse
dispatch _ _ = notFound dispatch _ _ = notFound
----------------------------------------------------------------
-- Predefined datatype
----------------------------------------------------------------
-- | Generate data base instances for a valid user
share2 mkPersist (mkMigrate "migrateUsers")
[QQ(persist)|
User
username Text Eq
password Text
salt Text
UniqueUser username
|]
instance HashDBUser User where
userPasswordHash = Just . userPassword
userPasswordSalt = Just . userSalt
setUserHashAndSalt s h u = u { userSalt = s
, userPassword = h
}

11
Yesod/Auth/OAuth.hs
View File

@ -6,6 +6,9 @@ module Yesod.Auth.OAuth
, authTwitter , authTwitter
, twitterUrl , twitterUrl
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import Yesod.Form import Yesod.Form
import Yesod.Handler import Yesod.Handler
@ -66,13 +69,7 @@ authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch lo
render <- lift getUrlRender render <- lift getUrlRender
let oaUrl = render $ tm $ oauthUrl name let oaUrl = render $ tm $ oauthUrl name
addHtml addHtml
#if GHC7 [QQ(hamlet)| <a href=#{oaUrl}>Login with #{name} |]
[hamlet|
#else
[$hamlet|
#endif
<a href=#{oaUrl}>Login with #{name}
|]
authTwitter :: YesodAuth m => authTwitter :: YesodAuth m =>
String -- ^ Consumer Key String -- ^ Consumer Key

14
Yesod/Auth/OpenId.hs
View File

@ -6,6 +6,8 @@ module Yesod.Auth.OpenId
, forwardUrl , forwardUrl
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import qualified Web.Authenticate.OpenId as OpenId import qualified Web.Authenticate.OpenId as OpenId
import Control.Monad.Attempt import Control.Monad.Attempt
@ -34,20 +36,12 @@ authOpenId =
ident <- lift newIdent ident <- lift newIdent
y <- lift getYesod y <- lift getYesod
addCassius addCassius
#if GHC7 [QQ(cassius)|##{ident}
[cassius|##{ident}
#else
[$cassius|##{ident}
#endif
background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%; background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
padding-left: 18px; padding-left: 18px;
|] |]
l <- lift languages l <- lift languages
#if GHC7 [QQ(whamlet)|
[whamlet|
#else
[$whamlet|
#endif
<form method="get" action="@{tm forwardUrl}"> <form method="get" action="@{tm forwardUrl}">
<label for="#{ident}">OpenID: # <label for="#{ident}">OpenID: #
<input id="#{ident}" type="text" name="#{name}" value="http://"> <input id="#{ident}" type="text" name="#{name}" value="http://">

8
Yesod/Auth/Rpxnow.hs
View File

@ -5,6 +5,8 @@ module Yesod.Auth.Rpxnow
( authRpxnow ( authRpxnow
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import qualified Web.Authenticate.Rpxnow as Rpxnow import qualified Web.Authenticate.Rpxnow as Rpxnow
import Control.Monad (mplus) import Control.Monad (mplus)
@ -27,11 +29,7 @@ authRpxnow app apiKey =
login tm = do login tm = do
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" [] let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
addHamlet addHamlet
#if GHC7 [QQ(hamlet)|
[hamlet|
#else
[$hamlet|
#endif
<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"> <iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
|] |]
dispatch _ [] = do dispatch _ [] = do

10
include/qq.h Normal file
View File

@ -0,0 +1,10 @@
-- CPP macro which choses which quasyquotes syntax to use depending
-- on GHC version.
--
-- QQ stands for quasyquote.
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif

2
yesod-auth.cabal
View File

@ -53,6 +53,8 @@ library
Yesod.Auth.HashDB Yesod.Auth.HashDB
Yesod.Auth.Message Yesod.Auth.Message
ghc-options: -Wall ghc-options: -Wall
include-dirs:
include
source-repository head source-repository head
type: git type: git