getFacebookUrl function
This commit is contained in:
parent
7e4ec40779
commit
c4c3d0b10d
@ -34,6 +34,7 @@ module Yesod.Helpers.Auth
|
|||||||
, RpxnowSettings (..)
|
, RpxnowSettings (..)
|
||||||
, EmailSettings (..)
|
, EmailSettings (..)
|
||||||
, FacebookSettings (..)
|
, FacebookSettings (..)
|
||||||
|
, getFacebookUrl
|
||||||
-- * Functions
|
-- * Functions
|
||||||
, maybeAuth
|
, maybeAuth
|
||||||
, maybeAuthId
|
, maybeAuthId
|
||||||
@ -514,19 +515,27 @@ getFacebookR = do
|
|||||||
setCreds c []
|
setCreds c []
|
||||||
redirectUltDest RedirectTemporary $ defaultDest y
|
redirectUltDest RedirectTemporary $ defaultDest y
|
||||||
|
|
||||||
getLoginR :: YesodAuth master => GHandler Auth master RepHtml
|
getFacebookUrl :: YesodAuth m
|
||||||
getLoginR = do
|
=> (AuthRoute -> Route m) -> GHandler s m (Maybe String)
|
||||||
lookupGetParam "dest" >>= maybe (return ()) setUltDestString
|
getFacebookUrl tm = do
|
||||||
tm <- getRouteToMaster
|
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
let facebookUrl f =
|
case facebookSettings y of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just f -> do
|
||||||
let fb =
|
let fb =
|
||||||
Facebook.Facebook
|
Facebook.Facebook
|
||||||
(fbAppId f)
|
(fbAppId f)
|
||||||
(fbSecret f)
|
(fbSecret f)
|
||||||
(render $ tm FacebookR)
|
(render $ tm FacebookR)
|
||||||
in Facebook.getForwardUrl fb $ fbPerms f
|
return $ Just $ Facebook.getForwardUrl fb $ fbPerms f
|
||||||
|
|
||||||
|
getLoginR :: YesodAuth master => GHandler Auth master RepHtml
|
||||||
|
getLoginR = do
|
||||||
|
lookupGetParam "dest" >>= maybe (return ()) setUltDestString
|
||||||
|
tm <- getRouteToMaster
|
||||||
|
y <- getYesod
|
||||||
|
fb <- getFacebookUrl tm
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "Login"
|
setTitle "Login"
|
||||||
addStyle [$cassius|
|
addStyle [$cassius|
|
||||||
@ -557,10 +566,10 @@ $if openIdEnabled.y
|
|||||||
%label!for=openid OpenID: $
|
%label!for=openid OpenID: $
|
||||||
%input#openid!type=text!name=openid
|
%input#openid!type=text!name=openid
|
||||||
%input!type=submit!value="Login via OpenID"
|
%input!type=submit!value="Login via OpenID"
|
||||||
$maybe facebookSettings.y f
|
$maybe fb f
|
||||||
%h3 Facebook
|
%h3 Facebook
|
||||||
%p
|
%p
|
||||||
%a!href=$facebookUrl.f$ Login via Facebook
|
%a!href=$f$ Login via Facebook
|
||||||
$maybe rpxnowSettings.y r
|
$maybe rpxnowSettings.y r
|
||||||
%h3 OpenID
|
%h3 OpenID
|
||||||
%p
|
%p
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user