http-enumerator 0.6
This commit is contained in:
parent
bd9ea53ea8
commit
5fa2e390c1
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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,
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user