From aa459bc8d8abfa011567b2103e5ef2b9161d831e Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 23 Apr 2012 14:01:25 +0300
Subject: [PATCH] Fixed some warnings

---
 yesod-auth/Yesod/Auth/GoogleEmail.hs | 5 +++--
 yesod-auth/Yesod/Auth/OpenId.hs      | 7 ++++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs
index 9d796123..e06e584f 100644
--- a/yesod-auth/Yesod/Auth/GoogleEmail.hs
+++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs
@@ -72,12 +72,13 @@ authGoogleEmail =
 completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()
 completeHelper gets' = do
         master <- getYesod
-        eres <- lift $ try $ OpenId.authenticate gets' (authHttpManager master)
+        eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
         toMaster <- getRouteToMaster
         let onFailure err = do
             setMessage $ toHtml $ show (err :: SomeException)
             redirect $ toMaster LoginR
-        let onSuccess (OpenId.Identifier ident, _) = do
+        let onSuccess oir = do
+                let OpenId.Identifier ident = OpenId.oirOpLocal oir
                 memail <- lookupGetParam "openid.ext1.value.email"
                 case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of
                     (Just email, True) -> setCreds True $ Creds "openid" email []
diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs
index 97706651..a93840a8 100644
--- a/yesod-auth/Yesod/Auth/OpenId.hs
+++ b/yesod-auth/Yesod/Auth/OpenId.hs
@@ -92,7 +92,7 @@ completeHelper gets' = do
                 let claimed =
                         case OpenId.oirClaimed oir of
                             Nothing -> id
-                            Just (OpenId.Identifier i) -> ((claimedKey, i):)
+                            Just (OpenId.Identifier i') -> ((claimedKey, i'):)
                     gets'' = claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets'
                     i = OpenId.identifier $ OpenId.oirOpLocal oir
                 setCreds True $ Creds "openid" i gets''
@@ -118,5 +118,10 @@ claimedKey = "__CLAIMED"
 --
 -- Since 1.0.2
 credsIdentClaimed :: Creds m -> Text
+
+-- Prevent other backends from overloading the __CLAIMED value, which could
+-- possibly open us to security holes.
+credsIdentClaimed c | credsPlugin c /= "openid" = credsIdent c
+
 credsIdentClaimed c = fromMaybe (credsIdent c)
                     $ lookup claimedKey (credsExtra c)