diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs
--- a/Web/Authenticate/OpenId.hs
+++ b/Web/Authenticate/OpenId.hs
@@ -1,10 +1,18 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Web.Authenticate.OpenId
-    ( getForwardUrl
+    ( -- * Functions
+      getForwardUrl
     , authenticate
+    , authenticateClaimed
+      -- * Types
     , AuthenticateException (..)
     , Identifier (..)
+      -- ** Response
+    , OpenIdResponse
+    , oirOpLocal
+    , oirParams
+    , oirClaimed
     ) where
 
 import Control.Monad.IO.Class
@@ -41,7 +49,8 @@
     -> m Text -- ^ URL to send the user to.
 getForwardUrl openid' complete mrealm params manager = do
     let realm = fromMaybe complete mrealm
-    disc <- normalize openid' >>= flip discover manager
+    claimed <- normalize openid'
+    disc <- discover claimed manager
     let helper s q = return $ T.concat
             [ s
             , if "?" `T.isInfixOf` s then "&" else "?"
@@ -50,21 +59,23 @@
     case disc of
         Discovery1 server mdelegate -> helper server
                 $ ("openid.mode", "checkid_setup")
-                : ("openid.identity", maybe openid' id mdelegate)
+                : ("openid.identity", maybe (identifier claimed) id mdelegate)
                 : ("openid.return_to", complete)
                 : ("openid.realm", realm)
                 : ("openid.trust_root", complete)
                 : params
         Discovery2 (Provider p) (Identifier i) itype -> do
-            let i' =
+            let (claimed', identity') =
                     case itype of
-                        ClaimedIdent -> i
-                        OPIdent -> "http://specs.openid.net/auth/2.0/identifier_select"
+                        ClaimedIdent -> (identifier claimed, i)
+                        OPIdent ->
+                            let x = "http://specs.openid.net/auth/2.0/identifier_select"
+                             in (x, x)
             helper p
                 $ ("openid.ns", "http://specs.openid.net/auth/2.0")
                 : ("openid.mode", "checkid_setup")
-                : ("openid.claimed_id", i')
-                : ("openid.identity", i')
+                : ("openid.claimed_id", claimed')
+                : ("openid.identity", identity')
                 : ("openid.return_to", complete)
                 : ("openid.realm", realm)
                 : params
@@ -74,7 +85,23 @@
     => [(Text, Text)]
     -> Manager
     -> m (Identifier, [(Text, Text)])
-authenticate params manager = do
+authenticate ps m = do
+    x <- authenticateClaimed ps m
+    return (oirOpLocal x, oirParams x)
+{-# DEPRECATED authenticate "Use authenticateClaimed" #-}
+
+data OpenIdResponse = OpenIdResponse
+    { oirOpLocal :: Identifier
+    , oirParams :: [(Text, Text)]
+    , oirClaimed :: Maybe Identifier
+    }
+
+authenticateClaimed
+    :: (MonadBaseControl IO m, MonadResource m, MonadIO m)
+    => [(Text, Text)]
+    -> Manager
+    -> m OpenIdResponse
+authenticateClaimed params manager = do
     unless (lookup "openid.mode" params == Just "id_res")
         $ liftIO $ throwIO $ case lookup "openid.mode" params of
                       Nothing -> AuthenticationException "openid.mode was not found in the params."
@@ -88,19 +115,39 @@
                 Just i -> return i
                 Nothing ->
                     liftIO $ throwIO $ AuthenticationException "Missing identity"
-    disc <- normalize ident >>= flip discover manager
-    let endpoint = case disc of
-                    Discovery1 p _ -> p
-                    Discovery2 (Provider p) _ _ -> p
+    discOP <- normalize ident >>= flip discover manager
+
+    let endpoint d =
+            case d of
+                Discovery1 p _ -> p
+                Discovery2 (Provider p) _ _ -> p
     let params' = map (encodeUtf8 *** encodeUtf8)
                 $ ("openid.mode", "check_authentication")
                 : filter (\(k, _) -> k /= "openid.mode") params
-    req' <- liftIO $ parseUrl $ unpack endpoint
+    req' <- liftIO $ parseUrl $ unpack $ endpoint discOP
     let req = urlEncodedBody params' req'
     rsp <- httpLbs req manager
     let rps = parseDirectResponse $ toStrict $ decodeUtf8With lenientDecode $ responseBody rsp
+
+    claimed <-
+        case lookup "openid.claimed_id" params of
+            Nothing -> return Nothing
+            Just claimed' -> do
+                -- need to validate that this provider can speak for the given
+                -- claimed identifier
+                claimedN <- normalize claimed'
+                discC <- discover claimedN manager
+                return $
+                    if endpoint discOP == endpoint discC
+                        then Just claimedN
+                        else Nothing
+
     case lookup "is_valid" rps of
-        Just "true" -> return (Identifier ident, rps)
+        Just "true" -> return OpenIdResponse
+            { oirOpLocal = Identifier ident
+            , oirParams  = rps
+            , oirClaimed = claimed
+            }
         _ -> liftIO $ throwIO $ AuthenticationException "OpenID provider did not validate"
 
 -- | Turn a response body into a list of parameters.
diff --git a/authenticate.cabal b/authenticate.cabal
--- a/authenticate.cabal
+++ b/authenticate.cabal
@@ -1,5 +1,5 @@
 name:            authenticate
-version:         1.2.0.1
+version:         1.2.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman, Hiromi Ishii, Arash Rouhani