GHC 7
This commit is contained in:
Michael Snoyman
parent
5894cc0fbd
commit
e6c3fdf15f
@ -3,6 +3,7 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Helpers.Auth
|
||||
( -- * Subsite
|
||||
Auth
|
||||
@ -73,11 +74,17 @@ class Yesod m => YesodAuth m where
|
||||
|
||||
mkYesodSub "Auth"
|
||||
[ ClassP ''YesodAuth [VarT $ mkName "master"]
|
||||
] [$parseRoutes|
|
||||
]
|
||||
#define STRINGS *Strings
|
||||
#if GHC7
|
||||
[parseRoutes|
|
||||
#else
|
||||
[$parseRoutes|
|
||||
#endif
|
||||
/check CheckR GET
|
||||
/login LoginR GET
|
||||
/logout LogoutR GET POST
|
||||
/page/#String/*Strings PluginR
|
||||
/page/#String/STRINGS PluginR
|
||||
|]
|
||||
|
||||
credsKey :: String
|
||||
@ -94,7 +101,13 @@ setCreds doRedirects creds = do
|
||||
then do
|
||||
case authRoute y of
|
||||
Nothing -> do
|
||||
rh <- defaultLayout [$hamlet|%h1 Invalid login|]
|
||||
rh <- defaultLayout
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%h1 Invalid login|]
|
||||
sendResponse rh
|
||||
Just ar -> do
|
||||
setMessage $ string "Invalid login"
|
||||
@ -115,7 +128,12 @@ getCheckR = do
|
||||
setTitle $ string "Authentication Status"
|
||||
addHtml $ html creds) (json creds)
|
||||
where
|
||||
html creds = [$hamlet|
|
||||
html creds =
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%h1 Authentication Status
|
||||
$maybe creds _
|
||||
%p Logged in.
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- | Provides a dummy authentication module that simply lets a user specify
|
||||
-- his/her identifier. This is not intended for real world use, just for
|
||||
-- testing.
|
||||
@ -18,7 +19,12 @@ authDummy =
|
||||
setCreds True $ Creds "dummy" ident []
|
||||
dispatch _ _ = notFound
|
||||
url = PluginR "dummy" []
|
||||
login authToMaster = [$hamlet|
|
||||
login authToMaster =
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%form!method=post!action=@authToMaster.url@
|
||||
Your new identifier is: $
|
||||
%input!type=text!name=ident
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes, TypeFamilies #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Helpers.Auth.Email
|
||||
( authEmail
|
||||
, YesodAuthEmail (..)
|
||||
@ -62,22 +63,12 @@ class YesodAuth m => YesodAuthEmail m where
|
||||
|
||||
authEmail :: YesodAuthEmail m => AuthPlugin m
|
||||
authEmail =
|
||||
AuthPlugin "email" dispatch login'
|
||||
where
|
||||
go x = x >>= sendResponse
|
||||
dispatch "GET" ["register"] = go getRegisterR
|
||||
dispatch "POST" ["register"] = go postRegisterR
|
||||
dispatch "GET" ["verify", eid, verkey] = do
|
||||
y <- getYesod
|
||||
case readAuthEmailId y eid of
|
||||
Nothing -> notFound
|
||||
Just eid' -> go $ getVerifyR eid' verkey
|
||||
dispatch "POST" ["login"] = go postLoginR
|
||||
dispatch "GET" ["set-password"] = go getPasswordR
|
||||
dispatch "POST" ["set-password"] = go postPasswordR
|
||||
dispatch _ _ = notFound
|
||||
|
||||
login' tm = [$hamlet|
|
||||
AuthPlugin "email" dispatch $ \tm ->
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%form!method=post!action=@tm.login@
|
||||
%table
|
||||
%tr
|
||||
@ -93,13 +84,30 @@ authEmail =
|
||||
%input!type=submit!value="Login via email"
|
||||
%a!href=@tm.register@ I don't have an account
|
||||
|]
|
||||
where
|
||||
dispatch "GET" ["register"] = getRegisterR >>= sendResponse
|
||||
dispatch "POST" ["register"] = postRegisterR >>= sendResponse
|
||||
dispatch "GET" ["verify", eid, verkey] = do
|
||||
y <- getYesod
|
||||
case readAuthEmailId y eid of
|
||||
Nothing -> notFound
|
||||
Just eid' -> getVerifyR eid' verkey >>= sendResponse
|
||||
dispatch "POST" ["login"] = postLoginR >>= sendResponse
|
||||
dispatch "GET" ["set-password"] = getPasswordR >>= sendResponse
|
||||
dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse
|
||||
dispatch _ _ = notFound
|
||||
|
||||
getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
|
||||
getRegisterR = do
|
||||
toMaster <- getRouteToMaster
|
||||
defaultLayout $ do
|
||||
setTitle $ string "Register a new account"
|
||||
addHamlet [$hamlet|
|
||||
addHamlet
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
|
||||
%form!method=post!action=@toMaster.register@
|
||||
%label!for=email E-mail
|
||||
@ -129,7 +137,12 @@ postRegisterR = do
|
||||
sendVerifyEmail email verKey verUrl
|
||||
defaultLayout $ do
|
||||
setTitle $ string "Confirmation e-mail sent"
|
||||
addWidget [$hamlet|
|
||||
addWidget
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%p A confirmation e-mail has been sent to $email$.
|
||||
|]
|
||||
|
||||
@ -151,7 +164,12 @@ getVerifyR lid key = do
|
||||
_ -> return ()
|
||||
defaultLayout $ do
|
||||
setTitle $ string "Invalid verification key"
|
||||
addHtml [$hamlet|
|
||||
addHtml
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%p I'm sorry, but that was an invalid verification key.
|
||||
|]
|
||||
|
||||
@ -191,7 +209,12 @@ getPasswordR = do
|
||||
redirect RedirectTemporary $ toMaster login
|
||||
defaultLayout $ do
|
||||
setTitle $ string "Set password"
|
||||
addHamlet [$hamlet|
|
||||
addHamlet
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%h3 Set a new password
|
||||
%form!method=post!action=@toMaster.setpass@
|
||||
%table
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Helpers.Auth.Facebook
|
||||
( authFacebook
|
||||
, facebookUrl
|
||||
@ -53,7 +54,12 @@ authFacebook cid secret perms =
|
||||
render <- liftHandler getUrlRender
|
||||
let fb = Facebook.Facebook cid secret $ render $ tm url
|
||||
let furl = Facebook.getForwardUrl fb $ perms
|
||||
addHtml [$hamlet|
|
||||
addHtml
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%p
|
||||
%a!href=$furl$ Login with Facebook
|
||||
|]
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Helpers.Auth.OpenId
|
||||
( authOpenId
|
||||
, forwardUrl
|
||||
@ -20,12 +21,22 @@ authOpenId =
|
||||
name = "openid_identifier"
|
||||
login tm = do
|
||||
ident <- newIdent
|
||||
addCassius [$cassius|
|
||||
#$ident$
|
||||
addCassius
|
||||
#if GHC7
|
||||
[cassius|
|
||||
#else
|
||||
[$cassius|
|
||||
#endif
|
||||
#$ident$
|
||||
background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
|
||||
padding-left: 18px;
|
||||
|]
|
||||
addHamlet [$hamlet|
|
||||
addHamlet
|
||||
#if GHC7
|
||||
[hamlet|
|
||||
#else
|
||||
[$hamlet|
|
||||
#endif
|
||||
%form!method=get!action=@tm.forwardUrl@
|
||||
%label!for=openid OpenID: $
|
||||
%input#$ident$!type=text!name=$name$!value="http://"
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Helpers.Auth.Rpxnow
|
||||
( authRpxnow
|
||||
) where
|
||||
@ -17,7 +18,12 @@ authRpxnow app apiKey =
|
||||
where
|
||||
login tm = do
|
||||
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
|
||||
addHamlet [$hamlet|
|
||||
addHamlet
|
||||
#if GHC7
|
||||
[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"
|
||||
|]
|
||||
dispatch _ [] = do
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-auth
|
||||
version: 0.2.0.1
|
||||
version: 0.2.0.2
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
@ -11,9 +11,15 @@ cabal-version: >= 1.6
|
||||
build-type: Simple
|
||||
homepage: http://docs.yesodweb.com/
|
||||
|
||||
flag ghc7
|
||||
|
||||
library
|
||||
build-depends: base >= 4 && < 5
|
||||
, authenticate >= 0.7 && < 0.8
|
||||
if flag(ghc7)
|
||||
build-depends: base >= 4.3 && < 5
|
||||
cpp-options: -DGHC7
|
||||
else
|
||||
build-depends: base >= 4 && < 4.3
|
||||
build-depends: authenticate >= 0.7 && < 0.8
|
||||
, bytestring >= 0.9.1.4 && < 0.10
|
||||
, yesod >= 0.6 && < 0.7
|
||||
, wai >= 0.2 && < 0.3
|
||||
|
||||
Loading…
Reference in New Issue
Block a user