diff --git a/OpenId2/Discovery.hs b/OpenId2/Discovery.hs index c4deb80b..e7015d87 100644 --- a/OpenId2/Discovery.hs +++ b/OpenId2/Discovery.hs @@ -26,7 +26,7 @@ import Debug.Trace -- Libraries import Data.Char import Data.Maybe -import Network.HTTP.Enumerator +import Network.HTTP.Conduit import qualified Data.ByteString.Char8 as S8 import Control.Arrow (first) import Control.Monad.IO.Class (MonadIO (liftIO)) @@ -46,12 +46,7 @@ data Discovery = Discovery1 Text (Maybe Text) deriving Show -- | Attempt to resolve an OpenID endpoint, and user identifier. -discover :: ( MonadIO m - , Failure AuthenticateException m - , Failure HttpException m - ) - => Identifier - -> m Discovery +discover :: Identifier -> IO Discovery discover ident@(Identifier i) = do res1 <- discoverYADIS ident Nothing 10 case res1 of @@ -66,13 +61,10 @@ discover ident@(Identifier i) = do -- | Attempt a YADIS based discovery, given a valid identifier. The result is -- an OpenID endpoint, and the actual identifier for the user. -discoverYADIS :: ( MonadIO m - , Failure HttpException m - ) - => Identifier +discoverYADIS :: Identifier -> Maybe String -> Int -- ^ remaining redirects - -> m (Maybe (Provider, Identifier, IdentType)) + -> IO (Maybe (Provider, Identifier, IdentType)) discoverYADIS _ _ 0 = failure TooManyRedirects discoverYADIS ident mb_loc redirects = do let uri = fromMaybe (unpack $ identifier ident) mb_loc @@ -120,9 +112,7 @@ parseYADIS ident = listToMaybe . mapMaybe isOpenId . concat -- | Attempt to discover an OpenID endpoint, from an HTML document. The result -- will be an endpoint on success, and the actual identifier of the user. -discoverHTML :: ( MonadIO m, Failure HttpException m) - => Identifier - -> m (Maybe Discovery) +discoverHTML :: Identifier -> IO (Maybe Discovery) discoverHTML ident'@(Identifier ident) = (parseHTML ident' . toStrict . decodeUtf8With lenientDecode) `liftM` simpleHttp (unpack ident) diff --git a/Web/Authenticate/BrowserId.hs b/Web/Authenticate/BrowserId.hs index 9133e0c2..b978a33e 100644 --- a/Web/Authenticate/BrowserId.hs +++ b/Web/Authenticate/BrowserId.hs @@ -1,19 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module Web.Authenticate.BrowserId ( browserIdJs , checkAssertion ) where import Data.Text (Text) -import Network.HTTP.Enumerator (parseUrl, responseBody, httpLbs, withManager, method, urlEncodedBody) +import Network.HTTP.Conduit (parseUrl, responseBody, httpLbs, withManager, method, urlEncodedBody) import Data.Aeson (json, Value (Object, String)) import Data.Attoparsec.Lazy (parse, maybeResult) -#if MIN_VERSION_aeson(0, 4, 0) import qualified Data.HashMap.Lazy as Map -#else -import qualified Data.Map as Map -#endif import Data.Text.Encoding (encodeUtf8) -- | Location of the Javascript file hosted by browserid.org diff --git a/Web/Authenticate/Facebook.hs b/Web/Authenticate/Facebook.hs index bb9fd4a9..f96f8db3 100644 --- a/Web/Authenticate/Facebook.hs +++ b/Web/Authenticate/Facebook.hs @@ -13,7 +13,7 @@ module Web.Authenticate.Facebook , getLogoutUrl ) where -import Network.HTTP.Enumerator +import Network.HTTP.Conduit import Network.HTTP.Types (parseSimpleQuery) import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as L8 diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs index d48175be..53808757 100644 --- a/Web/Authenticate/OAuth.hs +++ b/Web/Authenticate/OAuth.hs @@ -16,7 +16,7 @@ module Web.Authenticate.OAuth -- * Utility Methods paramEncode, addScope, addMaybeProxy ) where -import Network.HTTP.Enumerator +import Network.HTTP.Conduit import Data.Data import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL @@ -36,11 +36,12 @@ import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..)) import Network.HTTP.Types (Header) import Control.Arrow (second) import Blaze.ByteString.Builder (toByteString) -import Data.Enumerator (($$), run_, Stream (..), continue) -import Data.Monoid (mconcat) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.IORef (newIORef, readIORef, atomicModifyIORef) +import Control.Monad.IO.Class (MonadIO) import Network.HTTP.Types (renderSimpleQuery) +import Data.Conduit (ResourceIO, runResourceT, ($$), ($=), Source) +import qualified Data.Conduit.List as CL +import Data.Conduit.Blaze (builderToByteString) +import Blaze.ByteString.Builder (Builder) -- | Data type for OAuth client (consumer). data OAuth = OAuth { oauthServerName :: String -- ^ Service name @@ -226,7 +227,7 @@ injectOAuthToCred oa cred = , ("oauth_version", "1.0") ] cred -genSign :: MonadIO m => OAuth -> Credential -> Request m -> m BS.ByteString +genSign :: ResourceIO m => OAuth -> Credential -> Request m -> m BS.ByteString genSign oa tok req = case oauthSignatureMethod oa of HMACSHA1 -> do @@ -254,7 +255,7 @@ paramEncode = BS.concatMap escape oct = '%' : replicate (2 - length num) '0' ++ num in BS.pack oct -getBaseString :: MonadIO m => Credential -> Request m -> m BSL.ByteString +getBaseString :: ResourceIO m => Credential -> Request m -> m BSL.ByteString getBaseString tok req = do let bsMtd = BS.map toUpper $ method req isHttps = secure req @@ -274,23 +275,15 @@ getBaseString tok req = do -- So this is OK. return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams] -toLBS :: MonadIO m => RequestBody m -> m BS.ByteString +toLBS :: ResourceIO m => RequestBody m -> m BS.ByteString toLBS (RequestBodyLBS l) = return $ toStrict l toLBS (RequestBodyBS s) = return s toLBS (RequestBodyBuilder _ b) = return $ toByteString b -toLBS (RequestBodyEnum _ enum) = do - i <- liftIO $ newIORef id - run_ $ enum $$ go i - liftIO $ liftM (toByteString . mconcat . ($ [])) $ readIORef i - where - go i = - continue go' - where - go' (Chunks []) = continue go' - go' (Chunks x) = do - liftIO (atomicModifyIORef i $ \y -> (y . (x ++), ())) - continue go' - go' EOF = return () +toLBS (RequestBodySource _ src) = toLBS' src +toLBS (RequestBodySourceChunked src) = toLBS' src + +toLBS' :: ResourceIO m => Source m Builder -> m BS.ByteString +toLBS' src = fmap BS.concat $ runResourceT $ src $= builderToByteString $$ CL.consume isBodyFormEncoded :: [Header] -> Bool isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type" diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs index 2e8d3561..717eb2ea 100644 --- a/Web/Authenticate/OpenId.hs +++ b/Web/Authenticate/OpenId.hs @@ -16,7 +16,7 @@ import Control.Monad (unless) import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy (toStrict) -import Network.HTTP.Enumerator +import Network.HTTP.Conduit ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect , HttpException, withManager ) @@ -41,7 +41,7 @@ getForwardUrl -> m Text -- ^ URL to send the user to. getForwardUrl openid' complete mrealm params = do let realm = fromMaybe complete mrealm - disc <- normalize openid' >>= discover + disc <- liftIO $ normalize openid' >>= discover let helper s q = return $ s `mappend` decodeUtf8 (toByteString $ renderQueryText True $ map (second Just) q) case disc of Discovery1 server mdelegate -> helper server @@ -86,7 +86,7 @@ authenticate params = do Just i -> return i Nothing -> failure $ AuthenticationException "Missing identity" - disc <- normalize ident >>= discover + disc <- liftIO $ normalize ident >>= discover let endpoint = case disc of Discovery1 p _ -> p Discovery2 (Provider p) _ _ -> p diff --git a/Web/Authenticate/Rpxnow.hs b/Web/Authenticate/Rpxnow.hs index f856f036..9081bda8 100644 --- a/Web/Authenticate/Rpxnow.hs +++ b/Web/Authenticate/Rpxnow.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} --------------------------------------------------------- @@ -23,8 +22,8 @@ module Web.Authenticate.Rpxnow ) where import Data.Aeson -import Network.HTTP.Enumerator -import "transformers" Control.Monad.IO.Class +import Network.HTTP.Conduit +import Control.Monad.IO.Class import Control.Failure import Data.Maybe import Control.Monad diff --git a/authenticate.cabal b/authenticate.cabal index 922ec334..8e230934 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -1,5 +1,5 @@ name: authenticate -version: 0.10.4 +version: 0.11.0 license: BSD3 license-file: LICENSE author: Michael Snoyman, Hiromi Ishii, Arash Rouhani @@ -15,8 +15,8 @@ homepage: http://github.com/yesodweb/authenticate library build-depends: base >= 4 && < 5, - aeson >= 0.3.2.11, - http-enumerator >= 0.6.5.4 && < 0.8, + aeson >= 0.5, + http-conduit >= 1.0 && < 1.1, tagsoup >= 0.12 && < 0.13, failure >= 0.0.0 && < 0.2, transformers >= 0.1 && < 0.3, @@ -30,14 +30,15 @@ library random >= 1.0 && < 1.1, text >= 0.5 && < 1.0, http-types >= 0.6 && < 0.7, - enumerator >= 0.4.7 && < 0.5, - xml-enumerator >= 0.4 && < 0.5, + xml-conduit >= 0.5 && < 0.6, blaze-builder >= 0.2 && < 0.4, attoparsec >= 0.9, tls >= 0.7 && < 0.9, containers, unordered-containers, - process >= 1.0.1.1 && < 1.2 + process >= 1.0.1.1 && < 1.2, + conduit >= 0.0 && < 0.1, + blaze-builder-conduit >= 0.0 && < 0.1 exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.BrowserId,