http-conduit 1.1

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
+    if statusCode res == status200
-        200 ->
+        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

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

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)

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 ->

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,