diff --git a/OpenId2/Discovery.hs b/OpenId2/Discovery.hs index e7015d87..dd6a63ac 100644 --- a/OpenId2/Discovery.hs +++ b/OpenId2/Discovery.hs @@ -40,6 +40,7 @@ import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Text.HTML.TagSoup (parseTags, Tag (TagOpen)) import Control.Applicative ((<$>), (<*>)) +import Network.HTTP.Types (status200) data Discovery = Discovery1 Text (Maybe Text) | Discovery2 Provider Identifier IdentType @@ -69,14 +70,14 @@ discoverYADIS _ _ 0 = failure TooManyRedirects discoverYADIS ident mb_loc redirects = do let uri = fromMaybe (unpack $ identifier ident) mb_loc req <- parseUrl uri - res <- liftIO $ withManager $ httpLbs req + res <- liftIO $ withManager $ httpLbs req { checkStatus = \_ _ -> Nothing } let mloc = fmap S8.unpack $ lookup "x-xrds-location" $ map (first $ map toLower . S8.unpack . CI.original) $ responseHeaders res let mloc' = if mloc == mb_loc then Nothing else mloc - case statusCode res of - 200 -> + if statusCode res == status200 + then case mloc' of Just loc -> discoverYADIS ident (Just loc) (redirects - 1) Nothing -> do @@ -84,7 +85,7 @@ discoverYADIS ident mb_loc redirects = do case mdoc of Just doc -> return $ parseYADIS ident doc Nothing -> return Nothing - _ -> return Nothing + else return Nothing -- | Parse out an OpenID endpoint, and actual identifier from a YADIS xml diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs index a43c01d9..e12d439b 100644 --- a/Web/Authenticate/OAuth.hs +++ b/Web/Authenticate/OAuth.hs @@ -36,7 +36,7 @@ import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..)) import Network.HTTP.Types (Header) import Blaze.ByteString.Builder (toByteString) import Control.Monad.IO.Class (MonadIO) -import Network.HTTP.Types (renderSimpleQuery) +import Network.HTTP.Types (renderSimpleQuery, status200) import Data.Conduit (ResourceIO, runResourceT, ($$), ($=), Source) import qualified Data.Conduit.List as CL import Data.Conduit.Blaze (builderToByteString) @@ -133,7 +133,7 @@ getTemporaryCredential' hook oa = do crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential req' <- signOAuth oa crd $ hook (req { method = "POST" }) rsp <- withManager . httpLbs $ req' - if statusCode rsp == 200 + if statusCode rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp return $ Credential dic @@ -170,7 +170,7 @@ getAccessToken' :: (Request IO -> Request IO) -- ^ Request Hook getAccessToken' hook oa cr = do let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" } rsp <- withManager . httpLbs =<< signOAuth oa cr req - if statusCode rsp == 200 + if statusCode rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp return $ Credential dic diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs index 717eb2ea..e651c747 100644 --- a/Web/Authenticate/OpenId.hs +++ b/Web/Authenticate/OpenId.hs @@ -17,7 +17,7 @@ import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy (toStrict) import Network.HTTP.Conduit - ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect + ( parseUrl, urlEncodedBody, responseBody, httpLbs , HttpException, withManager ) import Control.Arrow ((***), second) @@ -95,7 +95,7 @@ authenticate params = do : filter (\(k, _) -> k /= "openid.mode") params req' <- parseUrl $ unpack endpoint let req = urlEncodedBody params' req' - rsp <- liftIO $ withManager $ httpLbsRedirect req + rsp <- liftIO $ withManager $ httpLbs req let rps = parseDirectResponse $ toStrict $ decodeUtf8With lenientDecode $ responseBody rsp case lookup "is_valid" rps of Just "true" -> return (Identifier ident, rps) diff --git a/Web/Authenticate/Rpxnow.hs b/Web/Authenticate/Rpxnow.hs index 9081bda8..a1cc1ad2 100644 --- a/Web/Authenticate/Rpxnow.hs +++ b/Web/Authenticate/Rpxnow.hs @@ -29,7 +29,6 @@ import Data.Maybe import Control.Monad import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L -import Control.Exception (throwIO) import Web.Authenticate.Internal import Data.Data (Data) import Data.Typeable (Typeable) @@ -75,10 +74,8 @@ authenticate apiKey token = do ] , requestBody = RequestBodyLBS body } - res <- liftIO $ withManager $ httpLbsRedirect req + res <- liftIO $ withManager $ httpLbs req let b = responseBody res - unless (200 <= statusCode res && statusCode res < 300) $ - liftIO $ throwIO $ StatusCodeException (statusCode res) b o <- unResult $ parse json b --m <- fromMapping o let mstat = flip Data.Aeson.Types.parse o $ \v -> diff --git a/authenticate.cabal b/authenticate.cabal index a916ba18..ba43334c 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -16,7 +16,7 @@ homepage: http://github.com/yesodweb/authenticate library build-depends: base >= 4 && < 5, aeson >= 0.5, - http-conduit >= 1.0 && < 1.1, + http-conduit >= 1.1 && < 1.2, tagsoup >= 0.12 && < 0.13, failure >= 0.0.0 && < 0.2, transformers >= 0.1 && < 0.3,