Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Deprecated

  • Loading branch information...
commit cb159a60ca3bb5b8711d656b70b09547a973e3af 1 parent 3f7b93c
@snoyberg authored
View
25 LICENSE
@@ -1,25 +0,0 @@
-The following license covers this documentation, and the source code, except
-where otherwise indicated.
-
-Copyright 2010, Michael Snoyman. All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
- list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
- this list of conditions and the following disclaimer in the documentation
- and/or other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
907 Network/HTTP/Enumerator.hs
@@ -1,907 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
--- | This module contains everything you need to initiate HTTP connections. If
--- you want a simple interface based on URLs, you can use 'simpleHttp'. If you
--- want raw power, 'http' is the underlying workhorse of this package. Some
--- examples:
---
--- > -- Just download an HTML document and print it.
--- > import Network.HTTP.Enumerator
--- > import qualified Data.ByteString.Lazy as L
--- >
--- > main = simpleHttp "http://www.haskell.org/" >>= L.putStr
---
--- This example uses interleaved IO to write the response body to a file in
--- constant memory space. By using 'httpRedirect', it will automatically
--- follow 3xx redirects.
---
--- > import Data.Enumerator
--- > import Data.Enumerator.Binary
--- > import Network.HTTP.Enumerator
--- > import System.IO
--- >
--- > main :: IO ()
--- > main = withFile "google.html" WriteMode $ \handle -> do
--- > request <- parseUrl "http://google.com/"
--- > withManager $ \manager -> do
--- > run_ $ httpRedirect request (\_ _ -> iterHandle handle) manager
---
--- The following headers are automatically set by this module, and should not
--- be added to 'requestHeaders':
---
--- * Content-Length
---
--- * Host
---
--- * Accept-Encoding (not currently set, but client usage of this variable /will/ cause breakage).
---
--- Any network code on Windows requires some initialization, and the network
--- library provides withSocketsDo to perform it. Therefore, proper usage of
--- this library will always involve calling that function at some point. The
--- best approach is to simply call them at the beginning of your main function,
--- such as:
---
--- > import Network.HTTP.Enumerator
--- > import qualified Data.ByteString.Lazy as L
--- > import Network (withSocketsDo)
--- >
--- > main = withSocketsDo
--- > $ simpleHttp "http://www.haskell.org/" >>= L.putStr
-module Network.HTTP.Enumerator
- ( -- * Perform a request
- simpleHttp
- , httpLbs
- , httpLbsRedirect
- , http
- , httpRedirect
- , redirectIter
- -- * Datatypes
- , Proxy (..)
- , RequestBody (..)
- , Response (..)
- -- ** Request
- , Request
- , def
- , method
- , secure
- , checkCerts
- , host
- , port
- , path
- , queryString
- , requestHeaders
- , requestBody
- , proxy
- , rawBody
- , decompress
- -- *** Defaults
- , defaultCheckCerts
- -- * Manager
- , Manager
- , newManager
- , closeManager
- , withManager
- -- * Utility functions
- , parseUrl
- , applyBasicAuth
- , addProxy
- , semiParseUrl
- , lbsIter
- -- * Decompression predicates
- , alwaysDecompress
- , browserDecompress
- -- * Request bodies
- , urlEncodedBody
- -- * Exceptions
- , HttpException (..)
- ) where
-
-import qualified Network.TLS.Client.Enumerator as TLS
-import Network (connectTo, PortID (PortNumber))
-
-import qualified Network.Socket as NS
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Char8 as S8
-import Data.Enumerator
- ( Iteratee (..), Stream (..), catchError, throwError
- , yield, Step (..), Enumeratee, ($$), joinI, Enumerator, run_
- , returnI, (>==>), (>>==), continue, checkDone, enumEOF
- , (=$)
- )
-import qualified Data.Enumerator.List as EL
-import Network.HTTP.Enumerator.HttpParser
-import Control.Exception
- ( Exception, bracket, throwIO, SomeException, try
- , fromException
- )
-import Control.Arrow (first)
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.Trans.Class (lift)
-import Control.Failure (Failure (failure))
-import Data.Typeable (Typeable)
-import Codec.Binary.UTF8.String (encodeString)
-import qualified Blaze.ByteString.Builder as Blaze
-import Blaze.ByteString.Builder.Enumerator (builderToByteString)
-import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator)
-import Data.Monoid (Monoid (..))
-import qualified Network.HTTP.Types as W
-import qualified Data.CaseInsensitive as CI
-import Data.Int (Int64)
-import qualified Codec.Zlib.Enum as Z
-#if MIN_VERSION_monad_control(0,3,0)
-import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp)
-#else
-import Control.Monad.IO.Control (MonadControlIO, liftIOOp)
-#endif
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified Data.IORef as I
-import Control.Applicative ((<$>))
-import Data.Certificate.X509 (X509)
-import Network.TLS.Extra (certificateVerifyChain, certificateVerifyDomain)
-import qualified Data.ByteString.Base64 as B64
-import System.IO (hClose, hFlush)
-import Blaze.ByteString.Builder (toByteString)
-import Data.Maybe (fromMaybe)
-import Data.Default (Default (def))
-import Numeric (showHex)
-#if !MIN_VERSION_base(4,3,0)
-import GHC.IO.Handle.Types
-import System.IO (hWaitForInput, hIsEOF)
-import System.IO.Error (mkIOError, illegalOperationErrorType)
-
--- | Like 'hGet', except that a shorter 'ByteString' may be returned
--- if there are not enough bytes immediately available to satisfy the
--- whole request. 'hGetSome' only blocks if there is no data
--- available, and EOF has not yet been reached.
---
-hGetSome :: Handle -> Int -> IO S.ByteString
-hGetSome hh i
- | i > 0 = let
- loop = do
- s <- S.hGetNonBlocking hh i
- if not (S.null s)
- then return s
- else do eof <- hIsEOF hh
- if eof then return s
- else hWaitForInput hh (-1) >> loop
- -- for this to work correctly, the
- -- Handle should be in binary mode
- -- (see GHC ticket #3808)
- in loop
- | i == 0 = return S.empty
- | otherwise = illegalBufferSize hh "hGetSome" i
-
-illegalBufferSize :: Handle -> String -> Int -> IO a
-illegalBufferSize handle fn sz =
- ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)
- --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
- where
- msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []
-#endif
-
-getSocket :: String -> Int -> IO NS.Socket
-getSocket host' port' = do
- let hints = NS.defaultHints {
- NS.addrFlags = [NS.AI_ADDRCONFIG]
- , NS.addrSocketType = NS.Stream
- }
- (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
- sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)
- (NS.addrProtocol addr)
- ee <- try' $ NS.connect sock (NS.addrAddress addr)
- case ee of
- Left e -> NS.sClose sock >> throwIO e
- Right () -> return sock
- where
- try' :: IO a -> IO (Either SomeException a)
- try' = try
-
-withSocketConn :: MonadIO m
- => Manager
- -> String
- -> Int
- -> Enumerator Blaze.Builder m ()
- -> Step S.ByteString m (Bool, a)
- -> Iteratee S.ByteString m a
-withSocketConn man host' port' =
- withManagedConn man (host', port', False) $
- fmap TLS.socketConn $ getSocket host' port'
-
-checkReset :: SomeException -> Bool
-checkReset e = isReset || isIOReset
- where isReset = case fromException e of
- Just TLS.ConnectionReset -> True
- _ -> False
- isIOReset = show e == "recv: resource vanished (Connection reset by peer)"
-
-withManagedConn
- :: MonadIO m
- => Manager
- -> ConnKey
- -> IO TLS.ConnInfo
- -> Enumerator Blaze.Builder m ()
- -> Step S.ByteString m (Bool, a) -- ^ Bool indicates if the connection should go back in the manager
- -> Iteratee S.ByteString m a
-withManagedConn man key open req step = do
- mci <- liftIO $ takeInsecureSocket man key
- (ci, isManaged) <-
- case mci of
- Nothing -> do
- ci <- liftIO open
- return (ci, False)
- Just ci -> return (ci, True)
- catchError
- (do
- (toPut, a) <- withCI ci req step
- liftIO $ if toPut
- then putInsecureSocket man key ci
- else TLS.connClose ci
- return a)
- (\se -> liftIO (TLS.connClose ci) >>
- liftIO (putStrLn $ "Error during enum: " ++ show se) >>
- if checkReset se && isManaged
- then withManagedConn man key open req step
- else throwError se
- )
-
-withSslConn :: MonadIO m
- => ([X509] -> IO TLS.TLSCertificateUsage)
- -> Manager
- -> String -- ^ host
- -> Int -- ^ port
- -> Enumerator Blaze.Builder m () -- ^ request
- -> Step S.ByteString m (Bool, a) -- ^ response
- -> Iteratee S.ByteString m a -- ^ response
-withSslConn checkCert man host' port' =
- withManagedConn man (host', port', True) $
- (connectTo host' (PortNumber $ fromIntegral port') >>= TLS.sslClientConn checkCert)
-
-withSslProxyConn :: MonadIO m
- => ([X509] -> IO TLS.TLSCertificateUsage)
- -> S8.ByteString -- ^ Target host
- -> Int -- ^ Target port
- -> Manager
- -> String -- ^ Proxy host
- -> Int -- ^ Proxy port
- -> Enumerator Blaze.Builder m () -- ^ request
- -> Step S.ByteString m (Bool, a) -- ^ response
- -> Iteratee S.ByteString m a -- ^ response
-withSslProxyConn checkCert thost tport man phost pport =
- withManagedConn man (phost, pport, True) $
- doConnect >>= TLS.sslClientConn checkCert
- where
- doConnect = do
- h <- connectTo phost (PortNumber $ fromIntegral pport)
- S8.hPutStr h $ toByteString connectRequest
- hFlush h
-#if MIN_VERSION_base(4,3,0)
- r <- S.hGetSome h 2048
-#else
- r <- hGetSome h 2048
-#endif
- res <- parserHeadersFromByteString r
- case res of
- Right ((_, 200, _), _) -> return h
- Right ((_, _, msg), _) -> hClose h >> proxyError (S8.unpack msg)
- Left s -> hClose h >> proxyError s
-
- connectRequest =
- Blaze.fromByteString "CONNECT "
- `mappend` Blaze.fromByteString thost
- `mappend` Blaze.fromByteString (S8.pack (':' : show tport))
- `mappend` Blaze.fromByteString " HTTP/1.1\r\n\r\n"
- proxyError s =
- error $ "Proxy failed to CONNECT to '"
- ++ S8.unpack thost ++ ":" ++ show tport ++ "' : " ++ s
-
-withCI :: MonadIO m => TLS.ConnInfo -> Enumerator Blaze.Builder m () -> Enumerator S.ByteString m a
-withCI ci req step0 = do
- lift $ run_ $ req $$ joinI $ builderToByteString $$ TLS.connIter ci
- a <- TLS.connEnum ci step0
- -- FIXME liftIO $ hClose handle
- return a
-
-
--- | Define a HTTP proxy, consisting of a hostname and port number.
-
-data Proxy = Proxy
- { proxyHost :: W.Ascii -- ^ The host name of the HTTP proxy.
- , proxyPort :: Int -- ^ The port numner of the HTTP proxy.
- }
-
-type ContentType = S.ByteString
-
--- | All information on how to connect to a host and what should be sent in the
--- HTTP request.
---
--- If you simply wish to download from a URL, see 'parseUrl'.
---
--- The constructor for this data type is not exposed. Instead, you should use
--- either the 'def' method to retrieve a default instance, or 'parseUrl' to
--- construct from a URL, and then use the records below to make modifications.
--- This approach allows http-enumerator to add configuration options without
--- breaking backwards compatibility.
-data Request m = Request
- { method :: W.Method -- ^ HTTP request method, eg GET, POST.
- , secure :: Bool -- ^ Whether to use HTTPS (ie, SSL).
- , checkCerts :: W.Ascii -> [X509] -> IO TLS.TLSCertificateUsage -- ^ Check if the server certificate is valid. Only relevant for HTTPS.
- , host :: W.Ascii
- , port :: Int
- , path :: W.Ascii -- ^ Everything from the host to the query string.
- , queryString :: W.Query -- ^ Automatically escaped for your convenience.
- , requestHeaders :: W.RequestHeaders
- , requestBody :: RequestBody m
- , proxy :: Maybe Proxy -- ^ Optional HTTP proxy.
- , rawBody :: Bool -- ^ If True, a chunked and/or gzipped body will not be decoded. Use with caution.
- , decompress :: ContentType -> Bool -- ^ Predicate to specify whether gzipped data should be decompressed on the fly.
- }
-
--- | When using the 'RequestBodyEnum' constructor and any function which calls
--- 'redirectIter', you must ensure that the 'Enumerator' can be called multiple
--- times.
---
--- The 'RequestBodyEnumChunked' will send a chunked request body, note
--- that not all servers support this. Only use 'RequestBodyEnumChunked'
--- if you know the server you're sending to supports chunked request
--- bodies.
-data RequestBody m
- = RequestBodyLBS L.ByteString
- | RequestBodyBS S.ByteString
- | RequestBodyBuilder Int64 Blaze.Builder
- | RequestBodyEnum Int64 (Enumerator Blaze.Builder m ())
- | RequestBodyEnumChunked (Enumerator Blaze.Builder m ())
-
-
--- | Add a Basic Auth header (with the specified user name and password) to the
--- given Request. Ignore error handling:
---
--- applyBasicAuth \"user\" \"pass\" $ fromJust $ parseUrl url
-
-applyBasicAuth :: S.ByteString -> S.ByteString -> Request m -> Request m
-applyBasicAuth user passwd req =
- req { requestHeaders = authHeader : requestHeaders req }
- where
- authHeader = (CI.mk "Authorization", basic)
- basic = S8.append "Basic " (B64.encode $ S8.concat [ user, ":", passwd ])
-
-
--- | Add a proxy to the the Request so that the Request when executed will use
--- the provided proxy.
-addProxy :: S.ByteString -> Int -> Request m -> Request m
-addProxy hst prt req =
- req { proxy = Just $ Proxy hst prt }
-
-
--- | A simple representation of the HTTP response created by 'lbsIter'.
-data Response = Response
- { statusCode :: Int
- , responseHeaders :: W.ResponseHeaders
- , responseBody :: L.ByteString
- }
- deriving (Show, Read, Eq, Typeable)
-
-enumSingle :: Monad m => a -> Enumerator a m b
-enumSingle x (Continue k) = k $ Chunks [x]
-enumSingle _ step = returnI step
-
-
--- | Always decompress a compressed stream.
-alwaysDecompress :: ContentType -> Bool
-alwaysDecompress = const True
-
--- | Decompress a compressed stream unless the content-type is 'application/x-tar'.
-browserDecompress :: ContentType -> Bool
-browserDecompress = (/= "application/x-tar")
-
-
--- | The most low-level function for initiating an HTTP request.
---
--- The first argument to this function gives a full specification on the
--- request: the host to connect to, whether to use SSL, headers, etc. Please
--- see 'Request' for full details.
---
--- The second argument specifies how the response should be handled. It's a
--- function that takes two arguments: the first is the HTTP status code of the
--- response, and the second is a list of all response headers. This module
--- exports 'lbsIter', which generates a 'Response' value.
---
--- Note that this allows you to have fully interleaved IO actions during your
--- HTTP download, making it possible to download very large responses in
--- constant memory.
-http
- :: MonadIO m
- => Request m
- -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)
- -> Manager
- -> Iteratee S.ByteString m a
-http req@(Request {..}) bodyStep m =
- withConn m connhost connport requestEnum $$ getResponse req bodyStep
- where
- (useProxy, connhost, connport) =
- case proxy of
- Just p -> (True, S8.unpack (proxyHost p), proxyPort p)
- Nothing -> (False, S8.unpack host, port)
- withConn =
- case (secure, useProxy) of
- (False, _) -> withSocketConn
- (True, False) -> withSslConn $ checkCerts host
- (True, True) -> withSslProxyConn (checkCerts host) host port
- (contentLength, bodyEnum) =
- case requestBody of
- RequestBodyLBS lbs -> (Just $ L.length lbs, enumSingle $ Blaze.fromLazyByteString lbs)
- RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs, enumSingle $ Blaze.fromByteString bs)
- RequestBodyBuilder i b -> (Just $ i, enumSingle b)
- RequestBodyEnum i enum -> (Just i, enum)
- RequestBodyEnumChunked enum -> (Nothing, \step -> enum $$ joinI $ chunkIt step)
- hh
- | port == 80 && not secure = host
- | port == 443 && secure = host
- | otherwise = host `mappend` S8.pack (':' : show port)
- contentLengthHeader (Just contentLength') =
- if method `elem` ["GET", "HEAD"] && contentLength' == 0
- then id
- else (:) ("Content-Length", S8.pack $ show contentLength')
- contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked")
- headers' = ("Host", hh)
- : (contentLengthHeader contentLength)
- (("Accept-Encoding", "gzip") : requestHeaders)
- requestHeaders' =
- Blaze.fromByteString method
- `mappend` Blaze.fromByteString " "
- `mappend`
- (if useProxy
- then Blaze.fromByteString (if secure then "https://" else "http://")
- `mappend` Blaze.fromByteString hh
- else mempty)
- `mappend`
- (case S8.uncons path of
- Just ('/', _) -> Blaze.fromByteString path
- _ -> Blaze.fromByteString "/"
- `mappend` Blaze.fromByteString path)
- `mappend` (if null queryString
- then mempty
- else W.renderQueryBuilder True queryString)
- `mappend` Blaze.fromByteString " HTTP/1.1\r\n"
- `mappend` mconcat (flip map headers' $ \(k, v) ->
- Blaze.fromByteString (CI.original k)
- `mappend` Blaze.fromByteString ": "
- `mappend` Blaze.fromByteString v
- `mappend` Blaze.fromByteString "\r\n")
- `mappend` Blaze.fromByteString "\r\n"
- requestEnum = enumSingle requestHeaders' >==> bodyEnum
-
-getResponse :: MonadIO m
- => Request m
- -> (W.Status -> [W.Header] -> Iteratee S8.ByteString m a)
- -> Iteratee S8.ByteString m (Bool, a)
-getResponse Request {..} bodyStep = do
- ((_, sc, sm), hs) <- iterHeaders
- let s = W.Status sc sm
- let hs' = map (first CI.mk) hs
- let mcl = lookup "content-length" hs'
- let body' =
- case (rawBody, ("transfer-encoding", "chunked") `elem` hs') of
- (False, True) -> (chunkedEnumeratee =$)
- (True , True) -> (chunkedTerminator =$)
- (_ , False) -> case mcl >>= readMay . S8.unpack of
- Just len -> (takeLBS len =$)
- Nothing -> id
- let decompresser =
- if needsGunzip hs'
- then (Z.ungzip =$)
- else id
- -- RFC 2616 section 4.4_1 defines responses that must not include a body
- res <-
- if hasNoBody method sc
- then enumEOF $$ bodyStep s hs'
- else body' $ decompresser $ do
- x <- bodyStep s hs'
- flushStream
- return x
-
- -- should we put this connection back into the connection manager?
- let toPut = Just "close" /= lookup "connection" hs'
- return (toPut, res)
- where
- hasNoBody :: S8.ByteString -- ^ request method
- -> Int -- ^ status code
- -> Bool
- hasNoBody "HEAD" _ = True
- hasNoBody _ 204 = True
- hasNoBody _ 304 = True
- hasNoBody _ i = 100 <= i && i < 200
-
- needsGunzip :: [W.Header] -> Bool
- needsGunzip hs' =
- not rawBody
- && ("content-encoding", "gzip") `elem` hs'
- && decompress (fromMaybe "" $ lookup "content-type" hs')
-
-flushStream :: Monad m => Iteratee a m ()
-flushStream = do
- x <- EL.head
- case x of
- Nothing -> return ()
- Just _ -> flushStream
-
-chunkedEnumeratee :: MonadIO m => Enumeratee S.ByteString S.ByteString m a
-chunkedEnumeratee k@(Continue _) = do
- len <- catchParser "Chunk header" iterChunkHeader
- if len == 0
- then return k
- else do
- k' <- takeLBS len k
- catchParser "End of chunk newline" iterNewline
- chunkedEnumeratee k'
-chunkedEnumeratee step = return step
-
-chunkedTerminator :: MonadIO m => Enumeratee S.ByteString S.ByteString m a
-chunkedTerminator (Continue k) = do
- len <- catchParser "Chunk header" iterChunkHeader
- k' <- sendCont k $ S8.pack $ showHex len "\r\n"
- if len == 0
- then return k'
- else do
- step <- takeLBS len k'
- catchParser "End of chunk newline" iterNewline
- case step of
- Continue k'' -> do
- k''' <- sendCont k'' "\r\n"
- chunkedTerminator k'''
- _ -> return step
-chunkedTerminator step = return step
-
-sendCont :: Monad m
- => (Stream S8.ByteString -> Iteratee S8.ByteString m a)
- -> S8.ByteString
- -> Iteratee S8.ByteString m (Step S8.ByteString m a)
-sendCont k bs = lift $ runIteratee $ k $ Chunks [bs]
-
-chunkIt :: Monad m => Enumeratee Blaze.Builder Blaze.Builder m a
-chunkIt = checkDone $ continue . step
- where
- step k EOF = k (Chunks [chunkedTransferTerminator]) >>== return
- step k (Chunks []) = continue $ step k
- step k (Chunks xs) = k (Chunks [chunkedTransferEncoding $ mconcat xs])
- >>== chunkIt
-
-
-takeLBS :: MonadIO m => Int -> Enumeratee S.ByteString S.ByteString m a
-takeLBS 0 step = return step
-takeLBS len (Continue k) = do
- mbs <- EL.head
- case mbs of
- Nothing -> return $ Continue k
- Just bs -> do
- let (len', chunk, rest) =
- if S.length bs > len
- then (0, S.take len bs,
- if S.length bs == len
- then Chunks []
- else Chunks [S.drop len bs])
- else (len - S.length bs, bs, Chunks [])
- step' <- lift $ runIteratee $ k $ Chunks [chunk]
- if len' == 0
- then yield step' rest
- else takeLBS len' step'
-takeLBS _ step = return step
-
-encodeUrlCharPI :: Bool -> Char -> String
-encodeUrlCharPI _ '/' = "/"
-encodeUrlCharPI False '?' = "?"
-encodeUrlCharPI False '&' = "&"
-encodeUrlCharPI False '=' = "="
-encodeUrlCharPI _ c = encodeUrlChar c
-
-encodeUrlChar :: Char -> String
-encodeUrlChar c
- -- List of unreserved characters per RFC 3986
- -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding
- | 'A' <= c && c <= 'Z' = [c]
- | 'a' <= c && c <= 'z' = [c]
- | '0' <= c && c <= '9' = [c]
-encodeUrlChar c@'-' = [c]
-encodeUrlChar c@'_' = [c]
-encodeUrlChar c@'.' = [c]
-encodeUrlChar c@'~' = [c]
-encodeUrlChar y =
- let (a, c) = fromEnum y `divMod` 16
- b = a `mod` 16
- showHex' x
- | x < 10 = toEnum $ x + (fromEnum '0')
- | x < 16 = toEnum $ x - 10 + (fromEnum 'A')
- | otherwise = error $ "Invalid argument to showHex: " ++ show x
- in ['%', showHex' b, showHex' c]
-
--- | Convert a URL into a 'Request'.
---
--- This defaults some of the values in 'Request', such as setting 'method' to
--- GET and 'requestHeaders' to @[]@.
---
--- Since this function uses 'Failure', the return monad can be anything that is
--- an instance of 'Failure', such as 'IO' or 'Maybe'.
-parseUrl :: Failure HttpException m => String -> m (Request m')
-parseUrl = parseUrlHelper True
-
--- | Same as 'parseUrl', with one distinction: this function will not attempt
--- to parse the query string, but instead leave it with the path info. This can
--- be useful if you need precise control of the rendering of the query string,
--- such as using semicolons instead of ampersands.
-semiParseUrl :: Failure HttpException m => String -> m (Request m')
-semiParseUrl = parseUrlHelper False
-
-parseUrlHelper :: Failure HttpException m => Bool -> String -> m (Request m')
-parseUrlHelper parsePath s@('h':'t':'t':'p':':':'/':'/':rest) = parseUrl1 s False parsePath rest
-parseUrlHelper parsePath s@('h':'t':'t':'p':'s':':':'/':'/':rest) = parseUrl1 s True parsePath rest
-parseUrlHelper _ x = failure $ InvalidUrlException x "Invalid scheme"
-
-parseUrl1 :: Failure HttpException m
- => String -> Bool -> Bool -> String -> m (Request m')
-parseUrl1 full sec parsePath s =
- parseUrl2 full sec parsePath s'
- where
- s' = encodeString s
-
-defaultCheckCerts :: W.Ascii -> [X509] -> IO TLS.TLSCertificateUsage
-defaultCheckCerts host' certs =
- case certificateVerifyDomain (S8.unpack host') certs of
- TLS.CertificateUsageAccept -> certificateVerifyChain certs
- rejected -> return rejected
-
-instance Default (Request m) where
- def = Request
- { host = "localhost"
- , port = 80
- , secure = False
- , checkCerts = defaultCheckCerts
- , requestHeaders = []
- , path = "/"
- , queryString = []
- , requestBody = RequestBodyLBS L.empty
- , method = "GET"
- , proxy = Nothing
- , rawBody = False
- , decompress = alwaysDecompress
- }
-
-parseUrl2 :: Failure HttpException m
- => String -> Bool -> Bool -> String -> m (Request m')
-parseUrl2 full sec parsePath s = do
- port' <- mport
- return def
- { host = S8.pack hostname
- , port = port'
- , secure = sec
- , path = S8.pack
- $ (if null path'
- then "/"
- else concatMap (encodeUrlCharPI parsePath) path')
- ++
- (if parsePath then "" else qstring')
- , queryString = if parsePath
- then W.parseQuery $ S8.pack qstring
- else []
- }
- where
- (beforeSlash, afterSlash) = break (== '/') s
- (hostname, portStr) = break (== ':') beforeSlash
- (path', qstring') = break (== '?') afterSlash
- qstring'' = case qstring' of
- '?':x -> x
- _ -> qstring'
- qstring = takeWhile (/= '#') qstring''
- mport =
- case (portStr, sec) of
- ("", False) -> return 80
- ("", True) -> return 443
- (':':rest, _) ->
- case readMay rest of
- Just i -> return i
- Nothing -> failure $ InvalidUrlException full "Invalid port"
- x -> error $ "parseUrl1: this should never happen: " ++ show x
-
--- | Convert the HTTP response into a 'Response' value.
---
--- Even though a 'Response' contains a lazy bytestring, this function does
--- /not/ utilize lazy I/O, and therefore the entire response body will live in
--- memory. If you want constant memory usage, you'll need to write your own
--- iteratee and use 'http' or 'httpRedirect' directly.
-lbsIter :: Monad m => W.Status -> W.ResponseHeaders
- -> Iteratee S.ByteString m Response
-lbsIter (W.Status sc _) hs = do
- lbs <- fmap L.fromChunks EL.consume
- return $ Response sc hs lbs
-
--- | Download the specified 'Request', returning the results as a 'Response'.
---
--- This is a simplified version of 'http' for the common case where you simply
--- want the response data as a simple datatype. If you want more power, such as
--- interleaved actions on the response body during download, you'll need to use
--- 'http' directly. This function is defined as:
---
--- @httpLbs = http lbsIter@
---
--- Please see 'lbsIter' for more information on how the 'Response' value is
--- created.
---
--- Even though a 'Response' contains a lazy bytestring, this function does
--- /not/ utilize lazy I/O, and therefore the entire response body will live in
--- memory. If you want constant memory usage, you'll need to write your own
--- iteratee and use 'http' or 'httpRedirect' directly.
-httpLbs :: MonadIO m => Request m -> Manager -> m Response
-httpLbs req = run_ . http req lbsIter
-
--- | Download the specified URL, following any redirects, and return the
--- response body.
---
--- This function will 'throwIO' an 'HttpException' for any response with a
--- non-2xx status code. It uses 'parseUrl' to parse the input. This function
--- essentially wraps 'httpLbsRedirect'.
---
--- Note: Even though this function returns a lazy bytestring, it does /not/
--- utilize lazy I/O, and therefore the entire response body will live in
--- memory. If you want constant memory usage, you'll need to write your own
--- iteratee and use 'http' or 'httpRedirect' directly.
-simpleHttp :: MonadIO m => String -> m L.ByteString
-simpleHttp url = do
- url' <- liftIO $ parseUrl url
- Response sc _ b <- liftIO $ withManager $ httpLbsRedirect
- $ url' { decompress = browserDecompress }
- if 200 <= sc && sc < 300
- then return b
- else liftIO $ throwIO $ StatusCodeException sc b
-
-data HttpException = StatusCodeException Int L.ByteString
- | InvalidUrlException String String
- | TooManyRedirects
- | HttpParserException String
- deriving (Show, Typeable)
-instance Exception HttpException
-
--- | Same as 'http', but follows all 3xx redirect status codes that contain a
--- location header.
-httpRedirect
- :: MonadIO m
- => Request m
- -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)
- -> Manager
- -> Iteratee S.ByteString m a
-httpRedirect req bodyStep manager =
- http req (redirectIter 10 req bodyStep manager) manager
-
--- | Make a request automatically follow 3xx redirects.
---
--- Used internally by 'httpRedirect' and family.
-redirectIter :: MonadIO m
- => Int -- ^ number of redirects to attempt
- -> Request m -- ^ Original request
- -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)
- -> Manager
- -> (W.Status -> W.ResponseHeaders -> Iteratee S.ByteString m a)
-redirectIter redirects req bodyStep manager s@(W.Status code _) hs
- | 300 <= code && code < 400 =
- case lookup "location" hs of
- Just l'' -> do
- -- Prepend scheme, host and port if missing
- let l' =
- case S8.uncons l'' of
- Just ('/', _) -> concat
- [ "http"
- , if secure req then "s" else ""
- , "://"
- , S8.unpack $ host req
- , ":"
- , show $ port req
- , S8.unpack l''
- ]
- _ -> S8.unpack l''
- l <- liftIO $ parseUrl l'
- let req' = req
- { host = host l
- , port = port l
- , secure = secure l
- , path = path l
- , queryString = queryString l
- , method =
- if code == 303
- then "GET"
- else method l
- }
- if redirects == 0
- then liftIO $ throwIO TooManyRedirects
- else (http req') (redirectIter (redirects - 1) req' bodyStep manager) manager
- Nothing -> bodyStep s hs
- | otherwise = bodyStep s hs
-
--- | Download the specified 'Request', returning the results as a 'Response'
--- and automatically handling redirects.
---
--- This is a simplified version of 'httpRedirect' for the common case where you
--- simply want the response data as a simple datatype. If you want more power,
--- such as interleaved actions on the response body during download, you'll
--- need to use 'httpRedirect' directly. This function is defined as:
---
--- @httpLbsRedirect = httpRedirect lbsIter@
---
--- Please see 'lbsIter' for more information on how the 'Response' value is
--- created.
---
--- Even though a 'Response' contains a lazy bytestring, this function does
--- /not/ utilize lazy I/O, and therefore the entire response body will live in
--- memory. If you want constant memory usage, you'll need to write your own
--- iteratee and use 'http' or 'httpRedirect' directly.
-httpLbsRedirect :: MonadIO m => Request m -> Manager -> m Response
-httpLbsRedirect req = run_ . httpRedirect req lbsIter
-
-readMay :: Read a => String -> Maybe a
-readMay s = case reads s of
- [] -> Nothing
- (x, _):_ -> Just x
-
--- FIXME add a helper for generating POST bodies
-
--- | Add url-encoded paramters to the 'Request'.
---
--- This sets a new 'requestBody', adds a content-type request header and
--- changes the 'method' to POST.
-urlEncodedBody :: Monad m => [(S.ByteString, S.ByteString)] -> Request m' -> Request m
-urlEncodedBody headers req = req
- { requestBody = RequestBodyLBS body
- , method = "POST"
- , requestHeaders =
- (ct, "application/x-www-form-urlencoded")
- : filter (\(x, _) -> x /= ct) (requestHeaders req)
- }
- where
- ct = "Content-Type"
- body = L.fromChunks . return $ W.renderSimpleQuery False headers
-
-catchParser :: Monad m => String -> Iteratee a m b -> Iteratee a m b
-catchParser s i = catchError i (const $ throwError $ HttpParserException s)
-
--- | Keeps track of open connections for keep-alive.
-newtype Manager = Manager
- { mConns :: I.IORef (Map ConnKey TLS.ConnInfo)
- }
-
--- | ConnKey consists of a hostname, a port and a Bool specifying whether to
--- use keepalive.
-type ConnKey = (String, Int, Bool)
-
-takeInsecureSocket :: Manager -> ConnKey -> IO (Maybe TLS.ConnInfo)
-takeInsecureSocket man key =
- I.atomicModifyIORef (mConns man) go
- where
- go m = (Map.delete key m, Map.lookup key m)
-
-putInsecureSocket :: Manager -> ConnKey -> TLS.ConnInfo -> IO ()
-putInsecureSocket man key ci = do
- msock <- I.atomicModifyIORef (mConns man) go
- maybe (return ()) TLS.connClose msock
- where
- go m = (Map.insert key ci m, Map.lookup key m)
-
--- | Create a new 'Manager' with no open connection.
-newManager :: IO Manager
-newManager = Manager <$> I.newIORef Map.empty
-
--- | Close all connections in a 'Manager'. Afterwards, the 'Manager' can be
--- reused if desired.
-closeManager :: Manager -> IO ()
-closeManager (Manager i) = do
- m <- I.atomicModifyIORef i $ \x -> (Map.empty, x)
- mapM_ TLS.connClose $ Map.elems m
-
--- | Create a new 'Manager', call the supplied function and then close it.
-#if MIN_VERSION_monad_control(0,3,0)
-withManager :: MonadBaseControl IO m => (Manager -> m a) -> m a
-withManager = liftBaseOp $ bracket newManager closeManager
-#else
-withManager :: MonadControlIO m => (Manager -> m a) -> m a
-withManager = liftIOOp $ bracket newManager closeManager
-#endif
View
151 Network/HTTP/Enumerator/HttpParser.hs
@@ -1,151 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Network.HTTP.Enumerator.HttpParser
- ( iterHeaders
- , iterChunkHeader
- , iterNewline
- , parserHeadersFromByteString
- ) where
-
-import Prelude hiding (take, takeWhile)
-import Data.Attoparsec
-import Data.Attoparsec.Enumerator
-import Data.Enumerator (Iteratee)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Char8 as S8
-import Control.Applicative
-import Data.Word (Word8)
-import Control.Monad (when)
-
-type Header = (S.ByteString, S.ByteString)
-
-parseHeader :: Parser Header
-parseHeader = do
- k <- takeWhile1 notNewlineColon
- _ <- word8 58 -- colon
- skipWhile isSpace
- v <- takeWhile notNewline
- newline
- return (k, v)
-
-notNewlineColon, isSpace, notNewline :: Word8 -> Bool
-
-notNewlineColon 10 = False -- LF
-notNewlineColon 13 = False -- CR
-notNewlineColon 58 = False -- colon
-notNewlineColon _ = True
-
-isSpace 32 = True
-isSpace _ = False
-
-notNewline 10 = False
-notNewline 13 = False
-notNewline _ = True
-
-newline :: Parser ()
-newline =
- lf <|> (cr >> lf)
- where
- word8' x = word8 x >> return ()
- lf = word8' 10
- cr = word8' 13
-
-parseHeaders :: Parser (Status, [Header])
-parseHeaders = do
- s <- parseStatus <?> "HTTP status line"
- h <- manyTill parseHeader newline <?> "Response headers"
- return (s, h)
-
-iterHeaders :: Monad m => Iteratee S.ByteString m (Status, [Header])
-iterHeaders = iterParser parseHeaders
-
-
-parserHeadersFromByteString :: Monad m => S.ByteString -> m (Either String (Status, [Header]))
-parserHeadersFromByteString s = return $ parseOnly parseHeaders s
-
-
-type Status = (S.ByteString, Int, S.ByteString)
-
-parseStatus :: Parser Status
-parseStatus = do
- end <- atEnd
- when end $ fail "EOF reached"
- _ <- manyTill (take 1 >> return ()) (try $ string "HTTP/") <?> "HTTP/"
- ver <- takeWhile1 $ not . isSpace
- _ <- word8 32 -- space
- statCode <- takeWhile1 $ not . isSpace
- statCode' <-
- case reads $ S8.unpack statCode of
- [] -> fail $ "Invalid status code: " ++ S8.unpack statCode
- (x, _):_ -> return x
- _ <- word8 32
- statMsg <- takeWhile1 $ notNewline
- newline
- if (statCode == "100")
- then newline >> parseStatus
- else return (ver, statCode', statMsg)
-
-parseChunkHeader :: Parser Int
-parseChunkHeader = do
- len <- hexs
- skipWhile isSpace
- newline <|> attribs
- return len
-
-iterChunkHeader :: Monad m => Iteratee S.ByteString m Int
-iterChunkHeader =
- iterParser (parseChunkHeader <?> "Chunked transfer encoding header")
-
-iterNewline :: Monad m => Iteratee S.ByteString m ()
-iterNewline = iterParser newline
-
-attribs :: Parser ()
-attribs = do
- _ <- word8 59 -- colon
- skipWhile notNewline
- newline
-
-hexs :: Parser Int
-hexs = do
- ws <- many1 hex
- return $ foldl1 (\a b -> a * 16 + b) $ map fromIntegral ws
-
-hex :: Parser Word8
-hex =
- (digit <|> upper <|> lower) <?> "Hexadecimal digit"
- where
- digit = do
- d <- satisfy $ \w -> (w >= 48 && w <= 57)
- return $ d - 48
- upper = do
- d <- satisfy $ \w -> (w >= 65 && w <= 70)
- return $ d - 55
- lower = do
- d <- satisfy $ \w -> (w >= 97 && w <= 102)
- return $ d - 87
-
-{-
-iterParserTill :: Monad m
- => Parser a
- -> Parser end
- -> E.Enumeratee a S.ByteString m b
-iterParserTill p pend =
- E.continue $ step $ parse p
- where
- step parse (E.Chunks xs) = parseLoop parse xs
- step parse E.EOF = case parse S.empty of
- Done extra a -> E.yield a $ if S.null extra
- then E.Chunks []
- else E.Chunks [extra]
- Partial _ -> err [] "iterParser: divergent parser"
- Fail _ ctx msg -> err ctx msg
-
- parseLoop parse [] = E.continue (step parse)
- parseLoop parse (x:xs) = case parse x of
- Done extra a -> E.yield a $ if S.null extra
- then E.Chunks xs
- else E.Chunks (extra:xs)
- Partial parse' -> parseLoop parse' xs
- Fail _ ctx msg -> err ctx msg
-
- err ctx msg = E.throwError (ParseError ctx msg)
--}
View
94 Network/TLS/Client/Enumerator.hs
@@ -1,94 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module Network.TLS.Client.Enumerator
- ( ConnInfo
- , connClose
- , connIter
- , connEnum
- , sslClientConn
- , socketConn
- , TLSCertificateRejectReason(..)
- , TLSCertificateUsage(..)
- , ConnectionReset (..)
- ) where
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-import Data.Typeable (Typeable)
-import Control.Exception (Exception)
-import System.IO (Handle, hClose)
-import Network.Socket (Socket, sClose)
-import Network.Socket.ByteString (recv, sendAll)
-import Network.TLS
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Trans.Class (lift)
-import Data.Enumerator
- ( Iteratee (..), Enumerator, Step (..), Stream (..), continue, returnI
- , tryIO, throwError
- )
-import Data.Certificate.X509 (X509)
-import Network.TLS.Extra (ciphersuite_all)
-import Crypto.Random.AESCtr (makeSystem)
-
-data ConnInfo = ConnInfo
- { connRead :: IO [ByteString]
- , connWrite :: [ByteString] -> IO ()
- , connClose :: IO ()
- }
-
-data ConnectionReset = ConnectionReset
- deriving (Show,Typeable)
-instance Exception ConnectionReset
-
-connIter :: MonadIO m => ConnInfo -> Iteratee ByteString m ()
-connIter ConnInfo { connWrite = write } =
- continue go
- where
- go EOF = return ()
- go (Chunks bss) = do
- tryIO $ write bss
- continue go
-
-connEnum :: MonadIO m => ConnInfo -> Enumerator ByteString m b
-connEnum ConnInfo { connRead = read' } =
- go
- where
- go (Continue k) = do
- bs <- tryIO read'
- if all S.null bs
- then continue k
- else do
- step <- lift $ runIteratee $ k $ Chunks bs
- go step
- go step = returnI step
-
-socketConn :: Socket -> ConnInfo
-socketConn sock = ConnInfo
- { connRead = fmap return $ recv sock 4096
- , connWrite = mapM_ (sendAll sock)
- , connClose = sClose sock
- }
-
-sslClientConn :: ([X509] -> IO TLSCertificateUsage) -> Handle -> IO ConnInfo
-sslClientConn onCerts h = do
- let tcp = defaultParams
- { pConnectVersion = TLS10
- , pAllowedVersions = [ TLS10, TLS11 ]
- , pCiphers = ciphersuite_all
- , onCertificatesRecv = onCerts
- }
- gen <- makeSystem
- istate <- client tcp gen h
- handshake istate
- return ConnInfo
- { connRead = recvD istate
- , connWrite = sendData istate . L.fromChunks
- , connClose = bye istate >> hClose h
- }
- where
- recvD istate = do
- x <- recvData istate
- if S.null x
- then recvD istate
- else return [x]
View
16 OpenFileTest.hs
@@ -1,16 +0,0 @@
-import Prelude hiding (catch)
-
-import Network.HTTP.Enumerator
-import Control.Concurrent
-import Control.Exception
-import qualified Data.ByteString.Lazy as BSL
-
-main =
- do mapM_ (\_ -> simpleHttp "http://localhost/index.html" `catch` handle) [0..100]
- threadDelay 1000000000000000
- putStrLn "Done"
- where
- handle :: SomeException -> IO BSL.ByteString
- handle e =
- do putStrLn (show e)
- return BSL.empty
View
5 README
@@ -1,5 +0,0 @@
-Note: future development (besides bug fixes) has been moved to the http-conduit
-package, which provides much more flexibility in its API. I recommend all users
-migrate.
-
-https://github.com/snoyberg/http-conduit
View
1  README.md
@@ -0,0 +1 @@
+This package has been deprecated in favor of [http-conduit](https://github.com/snoyberg/http-conduit).
View
8 Setup.lhs
@@ -1,8 +0,0 @@
-#!/usr/bin/env runhaskell
-
-> module Main where
-> import Distribution.Simple
-> import System.Cmd (system)
-
-> main :: IO ()
-> main = defaultMain
View
47 Warp.hs
@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Warp (noKeepAlive) where
-
-import Network.Wai.Handler.Warp
-import Control.Exception (bracket)
-import Control.Monad (forever)
-import Network (sClose)
-import Network.Socket (accept)
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Enumerator as E
-import qualified Data.Enumerator.Binary as EB
-import Control.Concurrent (forkIO)
-import Network.Wai (responseLBS)
-import Network.HTTP.Types (status200)
-import Data.Enumerator (($$), run_)
-import Data.IORef
-import Network.Socket.ByteString (recv)
-import qualified Data.ByteString as S
-
-app = const $ return $ responseLBS status200
- [ ("Content-type", "text/plain")
- , ("Connection", "close")
- ] "This is not kept alive under any circumtances"
-
-noKeepAlive ioref = withManager 30000000 $ \man -> bracket
- (bindPort (settingsPort set) (settingsHost set))
- sClose
- (\socket -> forever $ do
- (conn, sa) <- accept socket
- th <- liftIO $ registerKillThread man
- _ <- forkIO $ do
- run_ $ enumSocket th 4096 conn $$ do
- liftIO $ pause th
- (len, env) <- parseRequest (settingsPort set) sa
- liftIO $ resume th
- res <- E.joinI $ EB.isolate len $$ app env
- _ <- liftIO $ sendResponse th env conn res
- return ()
- bs <- recv conn 1
- if S.length bs == 1
- then writeIORef ioref True
- else return ()
- sClose conn
- return ()
- )
- where
- set = defaultSettings
View
64 http-enumerator.cabal
@@ -1,64 +0,0 @@
-name: http-enumerator
-version: 0.7.3.1
-license: BSD3
-license-file: LICENSE
-author: Michael Snoyman <michael@snoyman.com>
-maintainer: Michael Snoyman <michael@snoyman.com>
-synopsis: HTTP client package with enumerator interface and HTTPS support.
-description:
- This package uses attoparsec for parsing the actual contents of the HTTP connection. It also provides higher-level functions which allow you to avoid direct usage of enumerators.
-category: Web, Enumerator
-stability: Stable
-cabal-version: >= 1.6
-build-type: Simple
-homepage: http://github.com/snoyberg/http-enumerator
-
-flag test
- description: Build the test executable.
- default: False
-flag network-bytestring
- default: False
-
-library
- build-depends: base >= 4 && < 5
- , bytestring >= 0.9.1.4 && < 0.10
- , transformers >= 0.2 && < 0.3
- , failure >= 0.1 && < 0.3
- , enumerator >= 0.4.9 && < 0.5
- , attoparsec >= 0.8.0.2 && < 0.11
- , attoparsec-enumerator >= 0.2.0.4 && < 0.4
- , utf8-string >= 0.3.4 && < 0.4
- , blaze-builder >= 0.2.1 && < 0.4
- , zlib-enum >= 0.2 && < 0.3
- , http-types >= 0.6 && < 0.7
- , blaze-builder-enumerator >= 0.2 && < 0.3
- , cprng-aes >= 0.2 && < 0.3
- , tls >= 0.9 && < 0.10
- , tls-extra >= 0.4.3 && < 0.5
- , monad-control >= 0.2 && < 0.4
- , containers >= 0.2
- , certificate >= 1.1 && < 1.2
- , case-insensitive >= 0.2
- , base64-bytestring >= 0.1 && < 0.2
- , asn1-data >= 0.5.1 && < 0.7
- , data-default >= 0.3 && < 0.4
- if flag(network-bytestring)
- build-depends: network >= 2.2.1 && < 2.2.3
- , network-bytestring >= 0.1.3 && < 0.1.4
- else
- build-depends: network >= 2.3 && < 2.4
- exposed-modules: Network.HTTP.Enumerator
- other-modules: Network.HTTP.Enumerator.HttpParser
- Network.TLS.Client.Enumerator
- ghc-options: -Wall
-
-executable http-enumerator
- main-is: test.hs
- if flag(test)
- Buildable: True
- else
- Buildable: False
-
-source-repository head
- type: git
- location: git://github.com/snoyberg/http-enumerator.git
View
35 http.hs
@@ -1,35 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-import Http
-import Data.Attoparsec
-import Data.ByteString.Char8 (pack)
-import qualified Data.ByteString as S
-
-main = do
- print $ parse parseHeaders
- "HTTP/1.1 100 CONTINUE\n\nHTTP/1.1 200 OK\r\nfoo: bar\nbaz: baz\r\nhelper: bin\n\r\ncontent body"
- let x@(Done _ y) = parse parseChunks sample
- print x
- print $ S.concat y == expected
-
-sample = pack $ concatMap ntorn $ unlines
- [ "25"
- , "This is the data in the first chunk"
- , ""
- , "1C; ignore this please"
- , "and this is the second one"
- , ""
- , "3"
- , "con"
- , "8"
- , "sequence"
- , "0"
- ]
-
-expected = pack $ concatMap ntorn $ init $ unlines
- [ "This is the data in the first chunk"
- , "and this is the second one"
- , "consequence"
- ]
-
-ntorn '\n' = "\r\n"
-ntorn c = [c]
View
19 keepalive.hs
@@ -1,19 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-import Network.Wai.Handler.Warp (runEx)
-import qualified Network.Wai as W
-import Control.Concurrent (forkIO, threadDelay)
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Enumerator
-import Data.Enumerator (run_)
-import Data.ByteString.Lazy.Char8 ()
-
-app _ = do
- liftIO $ putStrLn "Received request"
- return $ W.responseLBS W.status200 [] ""
-
-main = do
- forkIO $ runEx print 3000 app
- req <- parseUrl "http://localhost:3000"
- withManager $ \m -> do
- sequence_ $ replicate 15 $ run_ $ http req (\_ _ -> liftIO (putStrLn "got a response")) m
- threadDelay 1000000
View
56 runtests.hs
@@ -1,56 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-import Test.Hspec
-import Test.Hspec.HUnit
-import Test.HUnit
-
-import Network.Wai
-import Network.HTTP.Types
-import Network.Wai.Handler.Warp (run)
-import Control.Concurrent (forkIO, killThread)
-import Control.Exception (finally)
-import Network.HTTP.Enumerator
-import Control.Monad (replicateM_)
-import Data.Enumerator (run_)
-import qualified Data.ByteString.Lazy as L
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.ByteString.Char8 as S8
-import Warp
-import Data.IORef (newIORef, readIORef)
-
-main = hspec $ describe "http-enumerator"
- [ it "doesn't fail with unconsumed data, chunked" unconsumedChunked
- , it "doesn't fail with unconsumed data, unchunked" unconsumedUnchunked
- , it "handles closed connections properly" closedConnections
- ]
-
-unconsumedChunked = do
- tid <- forkIO $ run 3002 $ const $ return $ responseLBS status200 [] $ L.fromChunks $ replicate 10000 "this is completely ignored"
- flip finally (killThread tid) $ do
- req <- parseUrl "http://localhost:3002"
- withManager $ \m -> run_ $ replicateM_ 10 $ http req (\s h -> do
- liftIO $ s @?= status200
- liftIO $ lookup "transfer-encoding" h @?= Just "chunked"
- ) m
-
-unconsumedUnchunked = do
- let lbs = L.fromChunks $ replicate 10000 "this is completely ignored"
- tid <- forkIO $ run 3001 $ const $ return $ responseLBS status200 [("Content-Length", S8.pack $ show $ L.length lbs)] lbs
- flip finally (killThread tid) $ do
- req <- parseUrl "http://localhost:3001"
- withManager $ \m -> run_ $ replicateM_ 10 $ http req (\s h -> do
- liftIO $ s @?= status200
- liftIO $ lookup "transfer-encoding" h @?= Nothing
- ) m
-
-closedConnections = do
- x <- newIORef False
- tid <- forkIO $ noKeepAlive x
- flip finally (killThread tid) $ do
- req <- parseUrl "http://localhost:3000"
- withManager $ \m -> run_ $ do
- res <- httpLbs req m
- replicateM_ 10 $ do
- res' <- httpLbs req m
- liftIO $ res @?= res'
- y <- readIORef x
- assert $ not y
View
15 test-server.hs
@@ -1,15 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-import Network.Wai
-import Network.Wai.Handler.Warp
-import Network.Wai.Parse
-import Data.ByteString.UTF8 (toString)
-import Data.ByteString.Lazy.UTF8 (fromString)
-
-main = run 3000 $ \req -> do
- body <- parseRequestBody lbsSink req
- return $ responseLBS status200 [("Content-Type", "plain")] $ fromString $ unlines
- [ "Path info: " ++ toString (pathInfo req)
- , "Query string: " ++ toString (queryString req)
- , "Request body: " ++ show body
- , "Method: " ++ toString (requestMethod req)
- ]
View
33 test.hs
@@ -1,33 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-import Network.HTTP.Enumerator
-import Network
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Char8 as S8
-import qualified Data.ByteString.Lazy as L
-import System.Environment.UTF8 (getArgs)
-import Data.CaseInsensitive (original)
-
-main :: IO ()
-main = withSocketsDo $ do
- [url] <- getArgs
- _req2 <- parseUrl url
- {-
- let req = urlEncodedBody
- [ ("foo", "bar")
- , ("baz%%38**.8fn", "bin")
- ] _req2
- -}
- Response sc hs b <- withManager $ httpLbsRedirect _req2
-#if DEBUG
- return ()
-#else
- print sc
- mapM_ (\(x, y) -> do
- S.putStr $ original x
- putStr ": "
- S.putStr y
- putStrLn "") hs
- putStrLn ""
- L.putStr b
-#endif
Please sign in to comment.
Something went wrong with that request. Please try again.