haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Checking openid.mode=id_res

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-04 07:21:10 +02:00
parent d6f0d2ee09
commit 2a65b1f016
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Web/Authenticate/OpenId.hs
View File

@ -29,7 +29,7 @@ import "transformers" Control.Monad.IO.Class
import Data.Data import Data.Data
import Control.Failure hiding (Error) import Control.Failure hiding (Error)
import Control.Exception import Control.Exception
import Control.Monad (liftM) import Control.Monad (liftM, unless)
import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy.Char8 as L8
import Web.Authenticate.Internal (qsEncode) import Web.Authenticate.Internal (qsEncode)
import Data.List (intercalate) import Data.List (intercalate)
@ -98,12 +98,12 @@ authenticate :: (MonadIO m,
Failure MissingVar m) Failure MissingVar m)
=> [(String, String)] => [(String, String)]
-> m Identifier -> 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 authUrl <- getAuthUrl req
content' <- simpleHttp authUrl content <- L8.unpack `liftM` simpleHttp authUrl
let content = L8.unpack content' if contains "is_valid:true" content
let isValid = contains "is_valid:true" content
if isValid
then Identifier `liftM` alookup "openid.identity" req then Identifier `liftM` alookup "openid.identity" req
else failure $ AuthenticateException content else failure $ AuthenticateException content