Logout redirect to approot; displayname
This commit is contained in:
parent
f21db91a0f
commit
12a43ef90b
@ -13,7 +13,15 @@
|
|||||||
---------------------------------------------------------
|
---------------------------------------------------------
|
||||||
module Yesod.Constants
|
module Yesod.Constants
|
||||||
( authCookieName
|
( authCookieName
|
||||||
|
, authDisplayName
|
||||||
|
, encryptedCookies
|
||||||
) where
|
) where
|
||||||
|
|
||||||
authCookieName :: String
|
authCookieName :: String
|
||||||
authCookieName = "IDENTIFIER"
|
authCookieName = "IDENTIFIER"
|
||||||
|
|
||||||
|
authDisplayName :: String
|
||||||
|
authDisplayName = "DISPLAY_NAME"
|
||||||
|
|
||||||
|
encryptedCookies :: [String]
|
||||||
|
encryptedCookies = [authDisplayName, authCookieName]
|
||||||
|
|||||||
@ -144,17 +144,34 @@ rpxnowLogin = do
|
|||||||
Just s -> s
|
Just s -> s
|
||||||
ident <- Rpxnow.authenticate apiKey token
|
ident <- Rpxnow.authenticate apiKey token
|
||||||
header authCookieName $ Rpxnow.identifier ident
|
header authCookieName $ Rpxnow.identifier ident
|
||||||
|
header authDisplayName $ getDisplayName ident
|
||||||
redirect dest
|
redirect dest
|
||||||
|
|
||||||
|
-- | Get some form of a display name, defaulting to the identifier.
|
||||||
|
getDisplayName :: Rpxnow.Identifier -> String
|
||||||
|
getDisplayName (Rpxnow.Identifier ident extra) = helper choices where
|
||||||
|
choices = ["verifiedEmail", "email", "displayName", "preferredUsername"]
|
||||||
|
helper [] = ident
|
||||||
|
helper (x:xs) = case lookup x extra of
|
||||||
|
Nothing -> helper xs
|
||||||
|
Just y -> y
|
||||||
|
|
||||||
authCheck :: Handler y HtmlObject
|
authCheck :: Handler y HtmlObject
|
||||||
authCheck = do
|
authCheck = do
|
||||||
ident <- identifier
|
ident <- identifier
|
||||||
return $ toHtmlObject [("identifier", fromMaybe "" ident)]
|
dn <- displayName
|
||||||
|
return $ toHtmlObject
|
||||||
|
[ ("identifier", fromMaybe "" ident)
|
||||||
|
, ("displayName", fromMaybe "" dn)
|
||||||
|
]
|
||||||
|
|
||||||
authLogout :: Handler y HtmlObject
|
authLogout :: YesodAuth y => Handler y HtmlObject
|
||||||
authLogout = do
|
authLogout = do
|
||||||
deleteCookie authCookieName
|
deleteCookie authCookieName
|
||||||
return $ toHtmlObject [("status", "loggedout")]
|
y <- getYesod
|
||||||
|
let (Approot ar) = approot y
|
||||||
|
redirect ar
|
||||||
|
-- FIXME check the DEST information
|
||||||
|
|
||||||
authIdentifier :: YesodAuth y => Handler y String
|
authIdentifier :: YesodAuth y => Handler y String
|
||||||
authIdentifier = do
|
authIdentifier = do
|
||||||
|
|||||||
@ -28,6 +28,7 @@ module Yesod.Request
|
|||||||
, anyParam
|
, anyParam
|
||||||
, cookieParam
|
, cookieParam
|
||||||
, identifier
|
, identifier
|
||||||
|
, displayName
|
||||||
, acceptedLanguages
|
, acceptedLanguages
|
||||||
, requestPath
|
, requestPath
|
||||||
, parseEnv
|
, parseEnv
|
||||||
@ -142,6 +143,13 @@ identifier = do
|
|||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
Just x -> return (Just x)
|
Just x -> return (Just x)
|
||||||
|
|
||||||
|
displayName :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
|
||||||
|
displayName = do
|
||||||
|
env <- parseEnv
|
||||||
|
case lookup authDisplayName $ Hack.hackHeaders env of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just x -> return (Just x)
|
||||||
|
|
||||||
-- | Get the raw 'Hack.Env' value.
|
-- | Get the raw 'Hack.Env' value.
|
||||||
parseEnv :: (Functor m, RequestReader m) => m Hack.Env
|
parseEnv :: (Functor m, RequestReader m) => m Hack.Env
|
||||||
parseEnv = rawEnv `fmap` getRawRequest
|
parseEnv = rawEnv `fmap` getRawRequest
|
||||||
|
|||||||
@ -80,7 +80,7 @@ toHackApp a env = do
|
|||||||
let app' = toHackApp' a
|
let app' = toHackApp' a
|
||||||
let mins = clientSessionDuration a
|
let mins = clientSessionDuration a
|
||||||
(gzip $ cleanPath $ jsonp $ methodOverride
|
(gzip $ cleanPath $ jsonp $ methodOverride
|
||||||
$ clientsession [authCookieName] key mins $ app') env
|
$ clientsession encryptedCookies key mins $ app') env
|
||||||
|
|
||||||
toHackApp' :: Yesod y => y -> Hack.Application
|
toHackApp' :: Yesod y => y -> Hack.Application
|
||||||
toHackApp' y env = do
|
toHackApp' y env = do
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user