From 12a43ef90b365d28bc13d7ac47cd4672b8fbd58c Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 5 Jan 2010 22:35:41 +0200
Subject: [PATCH] Logout redirect to approot; displayname

---
 Yesod/Constants.hs    |  8 ++++++++
 Yesod/Helpers/Auth.hs | 23 ++++++++++++++++++++---
 Yesod/Request.hs      |  8 ++++++++
 Yesod/Yesod.hs        |  2 +-
 4 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/Yesod/Constants.hs b/Yesod/Constants.hs
index 3fe16922..9879f625 100644
--- a/Yesod/Constants.hs
+++ b/Yesod/Constants.hs
@@ -13,7 +13,15 @@
 ---------------------------------------------------------
 module Yesod.Constants
     ( authCookieName
+    , authDisplayName
+    , encryptedCookies
     ) where
 
 authCookieName :: String
 authCookieName = "IDENTIFIER"
+
+authDisplayName :: String
+authDisplayName = "DISPLAY_NAME"
+
+encryptedCookies :: [String]
+encryptedCookies = [authDisplayName, authCookieName]
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index 7e919402..be5914eb 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -144,17 +144,34 @@ rpxnowLogin = do
                 Just s -> s
     ident <- Rpxnow.authenticate apiKey token
     header authCookieName $ Rpxnow.identifier ident
+    header authDisplayName $ getDisplayName ident
     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 = do
     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
     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 = do
diff --git a/Yesod/Request.hs b/Yesod/Request.hs
index a0ab2153..fecaf724 100644
--- a/Yesod/Request.hs
+++ b/Yesod/Request.hs
@@ -28,6 +28,7 @@ module Yesod.Request
     , anyParam
     , cookieParam
     , identifier
+    , displayName
     , acceptedLanguages
     , requestPath
     , parseEnv
@@ -142,6 +143,13 @@ identifier = do
         Nothing -> return Nothing
         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.
 parseEnv :: (Functor m, RequestReader m) => m Hack.Env
 parseEnv = rawEnv `fmap` getRawRequest
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index c6d5edb8..6344bf3e 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -80,7 +80,7 @@ toHackApp a env = do
     let app' = toHackApp' a
     let mins = clientSessionDuration a
     (gzip $ cleanPath $ jsonp $ methodOverride
-          $ clientsession [authCookieName] key mins $ app') env
+          $ clientsession encryptedCookies key mins $ app') env
 
 toHackApp' :: Yesod y => y -> Hack.Application
 toHackApp' y env = do