http-enumerator 0.6

This commit is contained in:
Michael Snoyman 2011-04-05 00:35:00 +03:00
parent bd9ea53ea8
commit 5fa2e390c1
5 changed files with 8 additions and 10 deletions

View File

@ -69,7 +69,7 @@ discoverYADIS :: ( MonadIO m
discoverYADIS _ _ 0 = failure TooManyRedirects discoverYADIS _ _ 0 = failure TooManyRedirects
discoverYADIS ident mb_loc redirects = do discoverYADIS ident mb_loc redirects = do
let uri = fromMaybe (identifier ident) mb_loc let uri = fromMaybe (identifier ident) mb_loc
req <- parseUrl $ S8.pack uri req <- parseUrl uri
res <- liftIO $ withManager $ httpLbs req res <- liftIO $ withManager $ httpLbs req
let mloc = fmap S8.unpack let mloc = fmap S8.unpack
$ lookup "x-xrds-location" $ lookup "x-xrds-location"
@ -117,7 +117,7 @@ discoverHTML :: ( MonadIO m, Failure HttpException m)
=> Identifier => Identifier
-> m (Maybe Discovery) -> m (Maybe Discovery)
discoverHTML ident'@(Identifier ident) = discoverHTML ident'@(Identifier ident) =
(parseHTML ident' . BSLU.toString) `liftM` simpleHttp (S8.pack ident) (parseHTML ident' . BSLU.toString) `liftM` simpleHttp ident
-- | Parse out an OpenID endpoint and an actual identifier from an HTML -- | Parse out an OpenID endpoint and an actual identifier from an HTML
-- document. -- document.

View File

@ -64,7 +64,7 @@ accessTokenUrl fb code =
getAccessToken :: Facebook -> Text -> IO AccessToken getAccessToken :: Facebook -> Text -> IO AccessToken
getAccessToken fb code = do getAccessToken fb code = do
let url = accessTokenUrl fb code let url = accessTokenUrl fb code
b <- simpleHttp url b <- simpleHttp $ S8.unpack url
let (front, back) = splitAt 13 $ L8.unpack b let (front, back) = splitAt 13 $ L8.unpack b
case front of case front of
"access_token=" -> return $ AccessToken $ T.pack back "access_token=" -> return $ AccessToken $ T.pack back
@ -80,7 +80,7 @@ graphUrl (AccessToken s) func =
getGraphData :: AccessToken -> Text -> IO (Either String Value) getGraphData :: AccessToken -> Text -> IO (Either String Value)
getGraphData at func = do getGraphData at func = do
let url = graphUrl at func let url = graphUrl at func
b <- simpleHttp url b <- simpleHttp $ S8.unpack url
return $ eitherResult $ parse json b return $ eitherResult $ parse json b
getGraphData' :: AccessToken -> Text -> IO Value getGraphData' :: AccessToken -> Text -> IO Value

View File

@ -33,7 +33,6 @@ import Numeric
import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..)) import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..))
import Network.HTTP.Types (Header) import Network.HTTP.Types (Header)
import Control.Arrow (second) import Control.Arrow (second)
import qualified Data.ByteString.Char8 as S8
import Blaze.ByteString.Builder (toByteString) import Blaze.ByteString.Builder (toByteString)
import Data.Enumerator (($$), run_, Stream (..), continue) import Data.Enumerator (($$), run_, Stream (..), continue)
import Data.Monoid (mconcat) import Data.Monoid (mconcat)
@ -91,7 +90,7 @@ fromStrict = BSL.fromChunks . return
getTemporaryCredential :: OAuth -- ^ OAuth Application getTemporaryCredential :: OAuth -- ^ OAuth Application
-> IO Credential -- ^ Temporary Credential (Request Token & Secret). -> IO Credential -- ^ Temporary Credential (Request Token & Secret).
getTemporaryCredential oa = do getTemporaryCredential oa = do
let req = fromJust $ parseUrl $ S8.pack $ oauthRequestUri oa let req = fromJust $ parseUrl $ oauthRequestUri oa
req' <- signOAuth oa emptyCredential (req { method = "POST" }) req' <- signOAuth oa emptyCredential (req { method = "POST" })
rsp <- withManager $ httpLbs req' rsp <- withManager $ httpLbs req'
let dic = parseQueryString . toStrict . responseBody $ rsp let dic = parseQueryString . toStrict . responseBody $ rsp
@ -109,7 +108,7 @@ getAccessToken, getTokenCredential
-> Credential -- ^ Temporary Credential with oauth_verifier -> Credential -- ^ Temporary Credential with oauth_verifier
-> IO Credential -- ^ Token Credential (Access Token & Secret) -> IO Credential -- ^ Token Credential (Access Token & Secret)
getAccessToken oa cr = do getAccessToken oa cr = do
let req = (fromJust $ parseUrl $ S8.pack $ oauthAccessTokenUri oa) { method = "POST" } let req = (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" }
rsp <- signOAuth oa cr req >>= withManager . httpLbs rsp <- signOAuth oa cr req >>= withManager . httpLbs
let dic = parseQueryString . toStrict . responseBody $ rsp let dic = parseQueryString . toStrict . responseBody $ rsp
return $ Credential dic return $ Credential dic

View File

@ -14,7 +14,6 @@ import OpenId2.Types
import Web.Authenticate.Internal (qsUrl) import Web.Authenticate.Internal (qsUrl)
import Control.Monad (unless) import Control.Monad (unless)
import qualified Data.ByteString.UTF8 as BSU import qualified Data.ByteString.UTF8 as BSU
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.UTF8 as BSLU import qualified Data.ByteString.Lazy.UTF8 as BSLU
import Network.HTTP.Enumerator import Network.HTTP.Enumerator
( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect
@ -88,7 +87,7 @@ authenticate params = do
let params' = map (BSU.fromString *** BSU.fromString) let params' = map (BSU.fromString *** BSU.fromString)
$ ("openid.mode", "check_authentication") $ ("openid.mode", "check_authentication")
: filter (\(k, _) -> k /= "openid.mode") params : filter (\(k, _) -> k /= "openid.mode") params
req' <- parseUrl $ S8.pack endpoint req' <- parseUrl endpoint
let req = urlEncodedBody params' req' let req = urlEncodedBody params' req'
rsp <- liftIO $ withManager $ httpLbsRedirect req rsp <- liftIO $ withManager $ httpLbsRedirect req
let rps = parseDirectResponse $ BSLU.toString $ responseBody rsp let rps = parseDirectResponse $ BSLU.toString $ responseBody rsp

View File

@ -16,7 +16,7 @@ homepage: http://github.com/snoyberg/authenticate/tree/master
library library
build-depends: base >= 4 && < 5, build-depends: base >= 4 && < 5,
aeson >= 0.3.1.1 && < 0.4, aeson >= 0.3.1.1 && < 0.4,
http-enumerator >= 0.5.1 && < 0.6, http-enumerator >= 0.6 && < 0.7,
tagsoup >= 0.6 && < 0.13, tagsoup >= 0.6 && < 0.13,
failure >= 0.0.0 && < 0.2, failure >= 0.0.0 && < 0.2,
transformers >= 0.1 && < 0.3, transformers >= 0.1 && < 0.3,