From 2a65b1f01698dd685cef5528f2b0cf25f305a9e3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 4 Oct 2010 07:21:10 +0200
Subject: [PATCH] Checking openid.mode=id_res

---
 Web/Authenticate/OpenId.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs
index c26c70e9..3230ec2c 100644
--- a/Web/Authenticate/OpenId.hs
+++ b/Web/Authenticate/OpenId.hs
@@ -29,7 +29,7 @@ import "transformers" Control.Monad.IO.Class
 import Data.Data
 import Control.Failure hiding (Error)
 import Control.Exception
-import Control.Monad (liftM)
+import Control.Monad (liftM, unless)
 import qualified Data.ByteString.Lazy.Char8 as L8
 import Web.Authenticate.Internal (qsEncode)
 import Data.List (intercalate)
@@ -98,12 +98,12 @@ authenticate :: (MonadIO m,
                  Failure MissingVar m)
              => [(String, String)]
              -> m Identifier
-authenticate req = do -- FIXME check openid.mode == id_res (not cancel)
+authenticate req = do
+    unless (lookup "openid.mode" req == Just "id_res") $
+        failure $ AuthenticateException "authenticate without openid.mode=id_res"
     authUrl <- getAuthUrl req
-    content' <- simpleHttp authUrl
-    let content = L8.unpack content'
-    let isValid = contains "is_valid:true" content
-    if isValid
+    content <- L8.unpack `liftM` simpleHttp authUrl
+    if contains "is_valid:true" content
         then Identifier `liftM` alookup "openid.identity" req
         else failure $ AuthenticateException content