http-streams-0.8.6.1/lib/0000755000000000000000000000000012421350545013254 5ustar0000000000000000http-streams-0.8.6.1/lib/Network/0000755000000000000000000000000012421350545014705 5ustar0000000000000000http-streams-0.8.6.1/lib/Network/Http/0000755000000000000000000000000013272464117015632 5ustar0000000000000000http-streams-0.8.6.1/tests/0000755000000000000000000000000013077254255013661 5ustar0000000000000000http-streams-0.8.6.1/lib/Network/Http/Client.hs0000644000000000000000000001203312661467431017406 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -fno-warn-orphans #-} -- | -- Maintainer: Andrew Cowie -- Stability: Experimental -- -- /Overview/ -- -- A simple HTTP client library, using the Snap Framework's @io-streams@ -- library to handle the streaming I\/O. The @http-streams@ API is designed -- for ease of use when querying web services and dealing with the result. -- -- Given: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import System.IO.Streams (InputStream, OutputStream, stdout) -- > import qualified System.IO.Streams as Streams -- > import qualified Data.ByteString as S -- -- and this library: -- -- > import Network.Http.Client -- -- the underlying API is straight-forward. In particular, constructing the -- 'Request' to send is quick and to the point: -- -- @ -- main :: IO () -- main = do -- \ c <- 'openConnection' \"www.example.com\" 80 -- -- \ let q = 'buildRequest1' $ do -- 'http' GET \"\/\" -- 'setAccept' \"text/html\" -- -- \ 'sendRequest' c q 'emptyBody' -- -- \ `receiveResponse` c (\\p i -> do -- xm <- Streams.read i -- case xm of -- Just x -> S.putStr x -- Nothing -> \"\") -- -- \ 'closeConnection' c -- @ -- -- which would print the first chunk of the response back from the -- server. Obviously in real usage you'll do something more interesting -- with the 'Response' in the handler function, and consume the entire -- response body from the InputStream ByteString. -- -- Because this is all happening in 'IO' (the defining feature of -- @io-streams@!), you can ensure resource cleanup on normal or -- abnormal termination by using @Control.Exception@'s standard -- 'Control.Exception.bracket' function; see 'closeConnection' for an -- example. For the common case we have a utility function which -- wraps @bracket@ for you: -- -- @ -- foo :: IO ByteString -- foo = 'withConnection' ('openConnection' \"www.example.com\" 80) doStuff -- -- doStuff :: Connection -> IO ByteString -- @ -- -- There are also a set of convenience APIs that do just that, along with -- the tedious bits like parsing URLs. For example, to do an HTTP GET and -- stream the response body to stdout, you can simply do: -- -- @ -- 'get' \"http:\/\/www.example.com\/file.txt\" (\\p i -> Streams.connect i stdout) -- @ -- -- which on the one hand is \"easy\" while on the other exposes the the -- 'Response' and InputStream for you to read from. Of course, messing -- around with URLs is all a bit inefficient, so if you already have e.g. -- hostname and path, or if you need more control over the request being -- created, then the underlying @http-streams@ API is simple enough to use -- directly. -- module Network.Http.Client ( -- * Connecting to server Hostname, Port, Connection, openConnection, openConnectionUnix, -- * Building Requests -- | You setup a request using the RequestBuilder monad, and -- get the resultant Request object by running 'buildRequest1'. The -- first call doesn't have to be to 'http', but it looks better when -- it is, don't you think? Method(..), RequestBuilder, buildRequest1, buildRequest, http, setHostname, setAccept, setAccept', setAuthorizationBasic, ContentType, setContentType, setContentLength, setExpectContinue, setTransferEncoding, setHeader, -- * Sending HTTP request Request, Response, getHostname, sendRequest, emptyBody, fileBody, inputStreamBody, encodedFormBody, -- * Processing HTTP response receiveResponse, receiveResponseRaw, UnexpectedCompression, StatusCode, getStatusCode, getStatusMessage, getHeader, debugHandler, concatHandler, concatHandler', HttpClientError(..), jsonHandler, -- * Resource cleanup closeConnection, withConnection, -- * Convenience APIs -- | Some simple functions for making requests with useful defaults. -- There's no @head@ function for the usual reason of needing to -- avoid collision with @Prelude@. -- -- These convenience functions work with @http@ and @https@, but -- note that if you retrieve an @https@ URL, you /must/ wrap your -- @main@ function with 'OpenSSL.withOpenSSL' to initialize the -- native openssl library code. -- URL, get, TooManyRedirects, post, postForm, put, -- * Secure connections openConnectionSSL, baselineContextSSL, modifyContextSSL, establishConnection, -- * Testing support makeConnection, Headers, getHeaders, getHeadersFull, -- * Deprecated getRequestHeaders ) where import Network.Http.Types import Network.Http.Connection import Network.Http.Inconvenience http-streams-0.8.6.1/lib/Network/Http/Connection.hs0000644000000000000000000004546413272464014020276 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide, not-home #-} module Network.Http.Connection ( Connection(..), -- constructors only for testing makeConnection, withConnection, openConnection, openConnectionSSL, openConnectionUnix, closeConnection, getHostname, getRequestHeaders, getHeadersFull, sendRequest, receiveResponse, receiveResponseRaw, UnexpectedCompression, emptyBody, fileBody, inputStreamBody, debugHandler, concatHandler ) where import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as Builder (flush, fromByteString, toByteString) import qualified Blaze.ByteString.Builder.HTTP as Builder (chunkedTransferEncoding, chunkedTransferTerminator) import Control.Exception (bracket) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import Network.Socket import OpenSSL (withOpenSSL) import OpenSSL.Session (SSL, SSLContext) import qualified OpenSSL.Session as SSL import System.IO.Streams (InputStream, OutputStream, stdout) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.SSL as Streams hiding (connect) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mappend, mempty) #endif import Network.Http.Internal import Network.Http.ResponseParser -- -- | A connection to a web server. -- data Connection = Connection { cHost :: ByteString, -- ^ will be used as the Host: header in the HTTP request. cClose :: IO (), -- ^ called when the connection should be closed. cOut :: OutputStream Builder, cIn :: InputStream ByteString } instance Show Connection where show c = {-# SCC "Connection.show" #-} concat ["Host: ", S.unpack $ cHost c, "\n"] -- -- | Create a raw Connection object from the given parts. This is -- primarily of use when teseting, for example: -- -- > fakeConnection :: IO Connection -- > fakeConnection = do -- > o <- Streams.nullOutput -- > i <- Streams.nullInput -- > c <- makeConnection "www.example.com" (return()) o i -- > return c -- -- is an idiom we use frequently in testing and benchmarking, usually -- replacing the InputStream with something like: -- -- > x' <- S.readFile "properly-formatted-response.txt" -- > i <- Streams.fromByteString x' -- -- If you're going to do that, keep in mind that you /must/ have CR-LF -- pairs after each header line and between the header and body to -- be compliant with the HTTP protocol; otherwise, parsers will -- reject your message. -- makeConnection :: ByteString -- ^ will be used as the @Host:@ header in the HTTP request. -> IO () -- ^ an action to be called when the connection is terminated. -> OutputStream ByteString -- ^ write end of the HTTP client-server connection. -> InputStream ByteString -- ^ read end of the HTTP client-server connection. -> IO Connection makeConnection h c o1 i = do o2 <- Streams.builderStream o1 return $! Connection h c o2 i -- -- | Given an @IO@ action producing a 'Connection', and a computation -- that needs one, runs the computation, cleaning up the -- @Connection@ afterwards. -- -- > x <- withConnection (openConnection "s3.example.com" 80) $ (\c -> do -- > let q = buildRequest1 $ do -- > http GET "/bucket42/object/149" -- > sendRequest c q emptyBody -- > ... -- > return "blah") -- -- which can make the code making an HTTP request a lot more -- straight-forward. -- -- Wraps @Control.Exception@'s 'Control.Exception.bracket'. -- withConnection :: IO Connection -> (Connection -> IO γ) -> IO γ withConnection mkC = bracket mkC closeConnection -- -- | In order to make a request you first establish the TCP -- connection to the server over which to send it. -- -- Ordinarily you would supply the host part of the URL here and it will -- be used as the value of the HTTP 1.1 @Host:@ field. However, you can -- specify any server name or IP addresss and set the @Host:@ value -- later with 'Network.Http.Client.setHostname' when building the -- request. -- -- Usage is as follows: -- -- > c <- openConnection "localhost" 80 -- > ... -- > closeConnection c -- -- More likely, you'll use 'withConnection' to wrap the call in order -- to ensure finalization. -- -- HTTP pipelining is supported; you can reuse the connection to a -- web server, but it's up to you to ensure you match the number of -- requests sent to the number of responses read, and to process those -- responses in order. This is all assuming that the /server/ supports -- pipelining; be warned that not all do. Web browsers go to -- extraordinary lengths to probe this; you probably only want to do -- pipelining under controlled conditions. Otherwise just open a new -- connection for subsequent requests. -- openConnection :: Hostname -> Port -> IO Connection openConnection h1' p = do is <- getAddrInfo (Just hints) (Just h1) (Just $ show p) let addr = head is let a = addrAddress addr s <- socket (addrFamily addr) Stream defaultProtocol connect s a (i,o1) <- Streams.socketToStreams s o2 <- Streams.builderStream o1 return Connection { cHost = h2', cClose = close s, cOut = o2, cIn = i } where hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV], addrSocketType = Stream } h2' = if p == 80 then h1' else S.concat [ h1', ":", S.pack $ show p ] h1 = S.unpack h1' -- -- | Open a secure connection to a web server. -- -- > import OpenSSL (withOpenSSL) -- > -- > main :: IO () -- > main = do -- > ctx <- baselineContextSSL -- > c <- openConnectionSSL ctx "api.github.com" 443 -- > ... -- > closeConnection c -- -- If you want to tune the parameters used in making SSL connections, -- manually specify certificates, etc, then setup your own context: -- -- > import OpenSSL.Session (SSLContext) -- > import qualified OpenSSL.Session as SSL -- > -- > ... -- > ctx <- SSL.context -- > ... -- -- See "OpenSSL.Session". -- -- Crypto is as provided by the system @openssl@ library, as wrapped -- by the @HsOpenSSL@ package and @openssl-streams@. -- -- /There is no longer a need to call @withOpenSSL@ explicitly; the -- initialization is invoked once per process for you/ -- openConnectionSSL :: SSLContext -> Hostname -> Port -> IO Connection openConnectionSSL ctx h1' p = withOpenSSL $ do is <- getAddrInfo Nothing (Just h1) (Just $ show p) let a = addrAddress $ head is f = addrFamily $ head is s <- socket f Stream defaultProtocol connect s a ssl <- SSL.connection ctx s SSL.setTlsextHostName ssl h1 SSL.connect ssl (i,o1) <- Streams.sslToStreams ssl o2 <- Streams.builderStream o1 return Connection { cHost = h2', cClose = closeSSL s ssl, cOut = o2, cIn = i } where h2' :: ByteString h2' = if p == 443 then h1' else S.concat [ h1', ":", S.pack $ show p ] h1 = S.unpack h1' closeSSL :: Socket -> SSL -> IO () closeSSL s ssl = do SSL.shutdown ssl SSL.Unidirectional close s -- -- | Open a connection to a Unix domain socket. -- -- > main :: IO () -- > main = do -- > c <- openConnectionUnix "/var/run/docker.sock" -- > ... -- > closeConnection c -- openConnectionUnix :: FilePath -> IO Connection openConnectionUnix path = do let a = SockAddrUnix path s <- socket AF_UNIX Stream defaultProtocol connect s a (i,o1) <- Streams.socketToStreams s o2 <- Streams.builderStream o1 return Connection { cHost = path', cClose = close s, cOut = o2, cIn = i } where path' = S.pack path -- -- | Having composed a 'Request' object with the headers and metadata for -- this connection, you can now send the request to the server, along -- with the entity body, if there is one. For the rather common case of -- HTTP requests like 'GET' that don't send data, use 'emptyBody' as the -- output stream: -- -- > sendRequest c q emptyBody -- -- For 'PUT' and 'POST' requests, you can use 'fileBody' or -- 'inputStreamBody' to send content to the server, or you can work with -- the @io-streams@ API directly: -- -- > sendRequest c q (\o -> -- > Streams.write (Just (Builder.fromString "Hello World\n")) o) -- {- I would like to enforce the constraints on the Empty and Static cases shown here, but those functions take OutputStream ByteString, and we are of course working in OutputStream Builder by that point. -} sendRequest :: Connection -> Request -> (OutputStream Builder -> IO α) -> IO α sendRequest c q handler = do -- write the headers Streams.write (Just msg) o2 -- deal with the expect-continue mess e2 <- case t of Normal -> do return e Continue -> do Streams.write (Just Builder.flush) o2 p <- readResponseHeader i case getStatusCode p of 100 -> do -- ok to send return e _ -> do -- put the response back Streams.unRead (rsp p) i return Empty -- write the body, if there is one x <- case e2 of Empty -> do o3 <- Streams.nullOutput y <- handler o3 return y Chunking -> do o3 <- Streams.contramap Builder.chunkedTransferEncoding o2 y <- handler o3 Streams.write (Just Builder.chunkedTransferTerminator) o2 return y (Static _) -> do -- o3 <- Streams.giveBytes (fromIntegral n :: Int64) o2 y <- handler o2 return y -- push the stream out by flushing the output buffers Streams.write (Just Builder.flush) o2 return x where o2 = cOut c e = qBody q t = qExpect q msg = composeRequestBytes q h' h' = cHost c i = cIn c rsp p = Builder.toByteString $ composeResponseBytes p -- -- | Get the virtual hostname that will be used as the @Host:@ header in -- the HTTP 1.1 request. Per RFC 2616 § 14.23, this will be of the form -- @hostname:port@ if the port number is other than the default, ie 80 -- for HTTP. -- getHostname :: Connection -> Request -> ByteString getHostname c q = case qHost q of Just h' -> h' Nothing -> cHost c {-# DEPRECATED getRequestHeaders "use retrieveHeaders . getHeadersFull instead" #-} getRequestHeaders :: Connection -> Request -> [(ByteString, ByteString)] getRequestHeaders c q = ("Host", getHostname c q) : kvs where h = qHeaders q kvs = retrieveHeaders h -- -- | Get the headers that will be sent with this request. You likely won't -- need this but there are some corner cases where people need to make -- calculations based on all the headers before they go out over the wire. -- -- If you'd like the request headers as an association list, import the header -- functions: -- -- > import Network.Http.Types -- -- then use 'Network.Http.Types.retreiveHeaders' as follows: -- -- >>> let kvs = retreiveHeaders $ getHeadersFull c q -- >>> :t kvs -- :: [(ByteString, ByteString)] -- getHeadersFull :: Connection -> Request -> Headers getHeadersFull c q = h' where h = qHeaders q h' = updateHeader h "Host" (getHostname c q) -- -- | Handle the response coming back from the server. This function -- hands control to a handler function you supply, passing you the -- 'Response' object with the response headers and an 'InputStream' -- containing the entity body. -- -- For example, if you just wanted to print the first chunk of the -- content from the server: -- -- > receiveResponse c (\p i -> do -- > m <- Streams.read i -- > case m of -- > Just bytes -> putStr bytes -- > Nothing -> return ()) -- -- Obviously, you can do more sophisticated things with the -- 'InputStream', which is the whole point of having an @io-streams@ -- based HTTP client library. -- -- The final value from the handler function is the return value of -- @receiveResponse@, if you need it. -- -- Throws 'UnexpectedCompression' if it doesn't know how to handle the -- compression format used in the response. -- {- The reponse body coming from the server MUST be fully read, even if (especially if) the users's handler doesn't consume it all. This is necessary to maintain the HTTP protocol invariants; otherwise pipelining would not work. It's not entirely clear *which* InputStream is being drained here; the underlying InputStream ByteString in Connection remains unconsumed beyond the threshold of the current response, which is exactly what we need. -} receiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β receiveResponse c handler = do p <- readResponseHeader i i' <- readResponseBody p i x <- handler p i' Streams.skipToEof i' return x where i = cIn c -- -- | This is a specialized variant of 'receiveResponse' that /explicitly/ does -- not handle the content encoding of the response body stream (it will not -- decompress anything). Unless you really want the raw gzipped content coming -- down from the server, use @receiveResponse@. -- {- See notes at receiveResponse. -} receiveResponseRaw :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β receiveResponseRaw c handler = do p <- readResponseHeader i let p' = p { pContentEncoding = Identity } i' <- readResponseBody p' i x <- handler p i' Streams.skipToEof i' return x where i = cIn c -- -- | Use this for the common case of the HTTP methods that only send -- headers and which have no entity body, i.e. 'GET' requests. -- emptyBody :: OutputStream Builder -> IO () emptyBody _ = return () -- -- | Specify a local file to be sent to the server as the body of the -- request. -- -- You use this partially applied: -- -- > sendRequest c q (fileBody "/etc/passwd") -- -- Note that the type of @(fileBody \"\/path\/to\/file\")@ is just what -- you need for the third argument to 'sendRequest', namely -- -- >>> :t filePath "hello.txt" -- :: OutputStream Builder -> IO () -- {- Relies on Streams.withFileAsInput generating (very) large chunks [which it does]. A more efficient way to do this would be interesting. -} fileBody :: FilePath -> OutputStream Builder -> IO () fileBody p o = do Streams.withFileAsInput p (\i -> inputStreamBody i o) -- -- | Read from a pre-existing 'InputStream' and pipe that through to the -- connection to the server. This is useful in the general case where -- something else has handed you stream to read from and you want to use -- it as the entity body for the request. -- -- You use this partially applied: -- -- > i <- getStreamFromVault -- magic, clearly -- > sendRequest c q (inputStreamBody i) -- -- This function maps "Builder.fromByteString" over the input, which will -- be efficient if the ByteString chunks are large. -- {- Note that this has to be 'supply' and not 'connect' as we do not want the end of stream to prematurely terminate the chunked encoding pipeline! -} inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO () inputStreamBody i1 o = do i2 <- Streams.map Builder.fromByteString i1 Streams.supply i2 o -- -- | Print the response headers and response body to @stdout@. You can -- use this with 'receiveResponse' or one of the convenience functions -- when testing. For example, doing: -- -- > c <- openConnection "kernel.operationaldynamics.com" 58080 -- > -- > let q = buildRequest1 $ do -- > http GET "/time" -- > -- > sendRequest c q emptyBody -- > -- > receiveResponse c debugHandler -- -- would print out: -- -- > HTTP/1.1 200 OK -- > Transfer-Encoding: chunked -- > Content-Type: text/plain -- > Vary: Accept-Encoding -- > Server: Snap/0.9.2.4 -- > Content-Encoding: gzip -- > Date: Mon, 21 Jan 2013 06:13:37 GMT -- > -- > Mon 21 Jan 13, 06:13:37.303Z -- -- or thereabouts. -- debugHandler :: Response -> InputStream ByteString -> IO () debugHandler p i = do S.putStr $ S.filter (/= '\r') $ Builder.toByteString $ composeResponseBytes p Streams.connect i stdout -- -- | Sometimes you just want the entire response body as a single blob. -- This function concatonates all the bytes from the response into a -- ByteString. If using the main @http-streams@ API, you would use it -- as follows: -- -- > ... -- > x' <- receiveResponse c concatHandler -- > ... -- -- The methods in the convenience API all take a function to handle the -- response; this function is passed directly to the 'receiveResponse' -- call underlying the request. Thus this utility function can be used -- for 'get' as well: -- -- > x' <- get "http://www.example.com/document.txt" concatHandler -- -- Either way, the usual caveats about allocating a -- single object from streaming I/O apply: do not use this if you are -- not absolutely certain that the response body will fit in a -- reasonable amount of memory. -- -- Note that this function makes no discrimination based on the -- response's HTTP status code. You're almost certainly better off -- writing your own handler function. -- {- I'd welcome a better name for this function. -} concatHandler :: Response -> InputStream ByteString -> IO ByteString concatHandler _ i1 = do i2 <- Streams.map Builder.fromByteString i1 x <- Streams.fold mappend mempty i2 return $ Builder.toByteString x -- -- | Shutdown the connection. You need to call this release the -- underlying socket file descriptor and related network resources. To -- do so reliably, use this in conjunction with 'openConnection' in a -- call to 'Control.Exception.bracket': -- -- > -- -- > -- Make connection, cleaning up afterward -- > -- -- > -- > foo :: IO ByteString -- > foo = bracket -- > (openConnection "localhost" 80) -- > (closeConnection) -- > (doStuff) -- > -- > -- -- > -- Actually use Connection to send Request and receive Response -- > -- -- > -- > doStuff :: Connection -> IO ByteString -- -- or, just use 'withConnection'. -- -- While returning a ByteString is probably the most common use case, -- you could conceivably do more processing of the response in 'doStuff' -- and have it and 'foo' return a different type. -- closeConnection :: Connection -> IO () closeConnection c = cClose c http-streams-0.8.6.1/lib/Network/Http/ResponseParser.hs0000644000000000000000000001740513272464067021154 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- -- Significant portions of this file were written while studying -- the HTTP request parser implementation in the Snap Framework; -- snap-core's src/Snap/Internal/Parsing.hs and snap-server's -- src/Snap/Internal/Http/Parser.hs, and various utility functions -- have been cloned from there. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide, not-home #-} module Network.Http.ResponseParser ( readResponseHeader, readResponseBody, UnexpectedCompression(..), -- for testing readDecimal ) where import Prelude hiding (take, takeWhile) import Control.Exception (Exception, throwIO) import Control.Monad (void) import Control.Monad.IO.Class (liftIO) import Data.Attoparsec.ByteString.Char8 import Data.Bits (Bits (..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import Data.CaseInsensitive (mk) import Data.Char (ord) import Data.Int (Int64) import Data.Typeable (Typeable) import System.IO.Streams (Generator, InputStream) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Attoparsec as Streams #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Network.Http.Internal import Network.Http.Utilities {- The chunk size coming down from the server is somewhat arbitrary; it's really just an indication of how many bytes need to be read before the next size marker or end marker - neither of which has anything to do with streaming on our side. Instead, we'll feed bytes into our InputStream at an appropriate intermediate size. -} __BITE_SIZE__ :: Int __BITE_SIZE__ = 32 * 1024 {- Process the reply from the server up to the end of the headers as deliniated by a blank line. -} readResponseHeader :: InputStream ByteString -> IO Response readResponseHeader i = do (sc,sm) <- Streams.parseFromStream parseStatusLine i hs <- readHeaderFields i let h = buildHeaders hs let te = case lookupHeader h "Transfer-Encoding" of Just x' -> if mk x' == "chunked" then Chunked else None Nothing -> None let ce = case lookupHeader h "Content-Encoding" of Just x' -> if mk x' == "gzip" then Gzip else Identity Nothing -> Identity let nm = case lookupHeader h "Content-Length" of Just x' -> Just (readDecimal x' :: Int64) Nothing -> case sc of 204 -> Just 0 304 -> Just 0 100 -> Just 0 _ -> Nothing return Response { pStatusCode = sc, pStatusMsg = sm, pTransferEncoding = te, pContentEncoding = ce, pContentLength = nm, pHeaders = h } parseStatusLine :: Parser (Int,ByteString) parseStatusLine = do sc <- string "HTTP/1." *> satisfy version *> char ' ' *> decimal <* char ' ' sm <- takeTill (== '\r') <* crlf return (sc,sm) where version c = c == '1' || c == '0' crlf :: Parser ByteString crlf = string "\r\n" --------------------------------------------------------------------- {- Switch on the encoding and compression headers, wrapping the raw InputStream to present the entity body's actual bytes. -} readResponseBody :: Response -> InputStream ByteString -> IO (InputStream ByteString) readResponseBody p i1 = do i2 <- case t of None -> case l of Just n -> readFixedLengthBody i1 n Nothing -> readUnlimitedBody i1 Chunked -> readChunkedBody i1 i3 <- case c of Identity -> return i2 Gzip -> readCompressedBody i2 Deflate -> throwIO (UnexpectedCompression $ show c) return i3 where t = pTransferEncoding p c = pContentEncoding p l = pContentLength p readDecimal :: (Enum α, Num α, Bits α) => ByteString -> α readDecimal str' = S.foldl' f 0 x' where f !cnt !i = cnt * 10 + digitToInt i x' = head $ S.words str' {-# INLINE digitToInt #-} digitToInt :: (Enum α, Num α, Bits α) => Char -> α digitToInt c | c >= '0' && c <= '9' = toEnum $! ord c - ord '0' | otherwise = error $ "'" ++ [c] ++ "' is not an ascii digit" {-# INLINE readDecimal #-} data UnexpectedCompression = UnexpectedCompression String deriving (Typeable, Show) instance Exception UnexpectedCompression --------------------------------------------------------------------- {- Process a response body in chunked transfer encoding, taking the resultant bytes and reproducing them as an InputStream -} readChunkedBody :: InputStream ByteString -> IO (InputStream ByteString) readChunkedBody i1 = do i2 <- Streams.fromGenerator (consumeChunks i1) return i2 {- For a response body in chunked transfer encoding, iterate over the individual chunks, reading the size parameter, then looping over that chunk in bites of at most __BYTE_SIZE__, yielding them to the receiveResponse InputStream accordingly. -} consumeChunks :: InputStream ByteString -> Generator ByteString () consumeChunks i1 = do !n <- parseSize if n > 0 then do -- read one or more bites, then loop to next chunk go n skipCRLF consumeChunks i1 else do -- skip "trailers" and consume final CRLF skipEnd where go 0 = return () go !n = do (!x',!r) <- liftIO $ readN n i1 Streams.yield x' go r parseSize = do n <- liftIO $ Streams.parseFromStream transferChunkSize i1 return n skipEnd = do liftIO $ do _ <- readHeaderFields i1 return () skipCRLF = do liftIO $ do _ <- Streams.parseFromStream crlf i1 return () {- Read the specified number of bytes up to a maximum of __BITE_SIZE__, returning a resultant ByteString and the number of bytes remaining. -} readN :: Int -> InputStream ByteString -> IO (ByteString, Int) readN n i1 = do !x' <- Streams.readExactly p i1 return (x', r) where !d = n - size !p = if d > 0 then size else n !r = if d > 0 then d else 0 size = __BITE_SIZE__ transferChunkSize :: Parser (Int) transferChunkSize = do !n <- hexadecimal void (takeTill (== '\r')) void crlf return n --------------------------------------------------------------------- {- This has the rather crucial side effect of terminating the stream after the requested number of bytes. Otherwise, code handling responses waits on more input until an HTTP timeout occurs. -} readFixedLengthBody :: InputStream ByteString -> Int64 -> IO (InputStream ByteString) readFixedLengthBody i1 n = do i2 <- Streams.takeBytes n i1 return i2 {- On the other hand, there is the (predominently HTTP/1.0) case where there is no content length sent and no chunking, with the result that only the connection closing marks the end of the response body. -} readUnlimitedBody :: InputStream ByteString -> IO (InputStream ByteString) readUnlimitedBody i1 = do return i1 --------------------------------------------------------------------- readCompressedBody :: InputStream ByteString -> IO (InputStream ByteString) readCompressedBody i1 = do i2 <- Streams.gunzip i1 return i2 http-streams-0.8.6.1/lib/Network/Http/Inconvenience.hs0000644000000000000000000004756113272464051020763 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide, not-home #-} module Network.Http.Inconvenience ( URL, modifyContextSSL, establishConnection, get, post, postForm, encodedFormBody, put, baselineContextSSL, concatHandler', jsonHandler, TooManyRedirects(..), HttpClientError(..), -- for testing splitURI ) where #include "config.h" import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as Builder (fromByteString, fromWord8, toByteString) import qualified Blaze.ByteString.Builder.Char8 as Builder (fromString) import Control.Exception (Exception, bracket, throw) import Data.Aeson (FromJSON, Result (..), fromJSON, json') import Data.Bits (Bits (..)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Data.ByteString.Internal (c2w, w2c) import Data.Char (intToDigit) import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (intersperse) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Typeable (Typeable) import Data.Word (Word16) import GHC.Exts import GHC.Word (Word8 (..)) import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseRelativeReference, parseURI, uriToString) import OpenSSL (withOpenSSL) import OpenSSL.Session (SSLContext) import qualified OpenSSL.Session as SSL import System.IO.Streams (InputStream, OutputStream) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Attoparsec as Streams import System.IO.Unsafe (unsafePerformIO) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid (..), mappend) #endif import Network.Http.Connection import Network.Http.RequestBuilder import Network.Http.Types #if defined __LINUX__ || defined __FREEBSD__ import System.Directory (doesDirectoryExist) #endif type URL = ByteString ------------------------------------------------------------------------------ -- -- | URL-escapes a string (see -- ) -- urlEncode :: ByteString -> URL urlEncode = Builder.toByteString . urlEncodeBuilder {-# INLINE urlEncode #-} -- -- | URL-escapes a string (see -- ) into a 'Builder'. -- urlEncodeBuilder :: ByteString -> Builder urlEncodeBuilder = go mempty where go !b !s = maybe b' esc (S.uncons y) where (x,y) = S.span (flip HashSet.member urlEncodeTable) s b' = b `mappend` Builder.fromByteString x esc (c,r) = let b'' = if c == ' ' then b' `mappend` Builder.fromWord8 (c2w '+') else b' `mappend` hexd c in go b'' r hexd :: Char -> Builder hexd c0 = Builder.fromWord8 (c2w '%') `mappend` Builder.fromWord8 hi `mappend` Builder.fromWord8 low where !c = c2w c0 toDigit = c2w . intToDigit !low = toDigit $ fromEnum $ c .&. 0xf !hi = toDigit $ (c .&. 0xf0) `shiftr` 4 shiftr (W8# a#) (I# b#) = I# (word2Int# (uncheckedShiftRL# a# b#)) urlEncodeTable :: HashSet Char urlEncodeTable = HashSet.fromList $! filter f $! map w2c [0..255] where f c | c >= 'A' && c <= 'Z' = True | c >= 'a' && c <= 'z' = True | c >= '0' && c <= '9' = True f c = c `elem` ("$-_.!~*'(),"::String) ------------------------------------------------------------------------------ {- The default SSLContext used by the convenience APIs in the http-streams library. This is a kludge, unsafe bad yada yada. The technique, however, was described on a Haskell Wiki page, so that makes it an officially supported kludge. The justification for doing this is a) the functions accessing this IORef are themselves all in the IO monad, and b) these contortions are necessary to allow the library to be used for https:// URLs *without* requiring the developer to do 'withOpenSSL'. -} global :: IORef SSLContext global = unsafePerformIO $ do ctx <- baselineContextSSL newIORef ctx {-# NOINLINE global #-} -- -- | Modify the context being used to configure the SSL tunnel used by -- the convenience API functions to make @https://@ connections. The -- default is that setup by 'baselineContextSSL'. -- modifyContextSSL :: (SSLContext -> IO SSLContext) -> IO () modifyContextSSL f = do ctx <- readIORef global ctx' <- f ctx writeIORef global ctx' -- -- | Given a URL, work out whether it is normal, secure, or unix domain, -- and then open the connection to the webserver including setting the -- appropriate default port if one was not specified in the URL. This -- is what powers the convenience API, but you may find it useful in -- composing your own similar functions. -- -- For example (on the assumption that your server behaves when given -- an absolute URI as the request path), this will open a connection -- to server @www.example.com@ port @443@ and request @/photo.jpg@: -- -- > let url = "https://www.example.com/photo.jpg" -- > -- > c <- establishConnection url -- > let q = buildRequest1 $ do -- > http GET url -- > ... -- establishConnection :: URL -> IO (Connection) establishConnection r' = do establish u where u = parseURL r' {-# INLINE establishConnection #-} establish :: URI -> IO (Connection) establish u = case scheme of "http:" -> do openConnection host port "https:" -> do ctx <- readIORef global openConnectionSSL ctx host ports "unix:" -> do openConnectionUnix $ uriPath u _ -> error ("Unknown URI scheme " ++ scheme) where scheme = uriScheme u auth = case uriAuthority u of Just x -> x Nothing -> URIAuth "" "localhost" "" host = S.pack (uriRegName auth) port = case uriPort auth of "" -> 80 _ -> read $ tail $ uriPort auth :: Word16 ports = case uriPort auth of "" -> 443 _ -> read $ tail $ uriPort auth :: Word16 -- -- | Creates a basic SSL context. This is the SSL context used if you make an -- @\"https:\/\/\"@ request using one of the convenience functions. It -- configures OpenSSL to use the default set of ciphers. -- -- On Linux, OpenBSD and FreeBSD systems, this function also configures -- OpenSSL to verify certificates using the system/distribution supplied -- certificate authorities' certificates -- -- On other systems, /no certificate validation is performed/ by the -- generated 'SSLContext' because there is no canonical place to find -- the set of system certificates. When using this library on such system, -- you are encouraged to install the system -- certificates somewhere and create your own 'SSLContext'. -- {- We would like to turn certificate verification on for everyone, but this has proved contingent on leveraging platform specific mechanisms to reach the certificate store. That logic should probably be in hsopenssl, but feel free to change this as appropriate for your OS. -} baselineContextSSL :: IO SSLContext baselineContextSSL = withOpenSSL $ do ctx <- SSL.context SSL.contextSetDefaultCiphers ctx #if defined __MACOSX__ SSL.contextSetVerificationMode ctx SSL.VerifyNone #elif defined __WINDOWS__ SSL.contextSetVerificationMode ctx SSL.VerifyNone #elif defined __FREEBSD__ SSL.contextSetCAFile ctx "/usr/local/etc/ssl/cert.pem" SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing #elif defined __OPENBSD__ SSL.contextSetCAFile ctx "/etc/ssl/cert.pem" SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing #else fedora <- doesDirectoryExist "/etc/pki/tls" if fedora then do SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt" else do SSL.contextSetCADirectory ctx "/etc/ssl/certs" SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing #endif return ctx parseURL :: URL -> URI parseURL r' = case parseURI r of Just u -> u Nothing -> error ("Can't parse URI " ++ r) where r = T.unpack $ T.decodeUtf8 r' ------------------------------------------------------------------------------ {- Account for bug where "http://www.example.com" is parsed with no path element, resulting in an illegal HTTP request line. -} path :: URI -> ByteString path u = case url of "" -> "/" _ -> url where url = T.encodeUtf8 $! T.pack $! concat [uriPath u, uriQuery u, uriFragment u] ------------------------------------------------------------------------------ -- -- | Issue an HTTP GET request and pass the resultant response to the -- supplied handler function. This code will silently follow redirects, -- to a maximum depth of 5 hops. -- -- The handler function is as for 'receiveResponse', so you can use one -- of the supplied convenience handlers if you're in a hurry: -- -- > x' <- get "http://www.bbc.co.uk/news/" concatHandler -- -- But as ever the disadvantage of doing this is that you're not doing -- anything intelligent with the HTTP response status code. If you want -- an exception raised in the event of a non @2xx@ response, you can use: -- -- > x' <- get "http://www.bbc.co.uk/news/" concatHandler' -- -- but for anything more refined you'll find it easy to simply write -- your own handler function. -- -- Throws 'TooManyRedirects' if more than 5 redirects are thrown. -- get :: URL -- ^ Resource to GET from. -> (Response -> InputStream ByteString -> IO β) -- ^ Handler function to receive the response from the server. -> IO β get r' handler = getN 0 r' handler getN n r' handler = do bracket (establish u) (teardown) (process) where teardown = closeConnection u = parseURL r' q = buildRequest1 $ do http GET (path u) setAccept "*/*" process c = do sendRequest c q emptyBody receiveResponse c (wrapRedirect u n handler) {- This is fairly simple-minded. Improvements could include reusing the Connection if the redirect is to the same host, and closing the original Connection if it is not. These are both things that can be done manually if using the full API, so not worried about it for now. -} wrapRedirect :: URI -> Int -> (Response -> InputStream ByteString -> IO β) -> Response -> InputStream ByteString -> IO β wrapRedirect u n handler p i = do if (s == 301 || s == 302 || s == 303 || s == 307) then case lm of Just l -> getN n' (splitURI u l) handler Nothing -> handler p i else handler p i where s = getStatusCode p lm = getHeader p "Location" !n' = if n < 5 then n + 1 else throw $! TooManyRedirects n splitURI :: URI -> URL -> URL splitURI old new' = let new = S.unpack new' in if isAbsoluteURI new then new' else let rel = parseRelativeReference new in case rel of Nothing -> new' Just x -> S.pack $ uriToString id old { uriPath = uriPath x, uriQuery = uriQuery x, uriFragment = uriFragment x } "" data TooManyRedirects = TooManyRedirects Int deriving (Typeable, Show, Eq) instance Exception TooManyRedirects -- -- | Send content to a server via an HTTP POST request. Use this -- function if you have an 'OutputStream' with the body content. -- post :: URL -- ^ Resource to POST to. -> ContentType -- ^ MIME type of the request body being sent. -> (OutputStream Builder -> IO α) -- ^ Handler function to write content to server. -> (Response -> InputStream ByteString -> IO β) -- ^ Handler function to receive the response from the server. -> IO β post r' t body handler = do bracket (establish u) (teardown) (process) where teardown = closeConnection u = parseURL r' q = buildRequest1 $ do http POST (path u) setAccept "*/*" setContentType t process c = do _ <- sendRequest c q body x <- receiveResponse c handler return x -- -- | Send form data to a server via an HTTP POST request. This is the -- usual use case; most services expect the body to be MIME type -- @application/x-www-form-urlencoded@ as this is what conventional -- web browsers send on form submission. If you want to POST to a URL -- with an arbitrary Content-Type, use 'post'. -- postForm :: URL -- ^ Resource to POST to. -> [(ByteString, ByteString)] -- ^ List of name=value pairs. Will be sent URL-encoded. -> (Response -> InputStream ByteString -> IO β) -- ^ Handler function to receive the response from the server. -> IO β postForm r' nvs handler = do bracket (establish u) (teardown) (process) where teardown = closeConnection u = parseURL r' q = buildRequest1 $ do http POST (path u) setAccept "*/*" setContentType "application/x-www-form-urlencoded" process c = do _ <- sendRequest c q (encodedFormBody nvs) x <- receiveResponse c handler return x -- -- | Specify name/value pairs to be sent to the server in the manner -- used by web browsers when submitting a form via a POST request. -- Parameters will be URL encoded per RFC 2396 and combined into a -- single string which will be sent as the body of your request. -- -- You use this partially applied: -- -- > let nvs = [("name","Kermit"), -- > ("type","frog")] -- > ("role","stagehand")] -- > -- > sendRequest c q (encodedFormBody nvs) -- -- Note that it's going to be up to you to call 'setContentType' with -- a value of @\"application/x-www-form-urlencoded\"@ when building the -- Request object; the 'postForm' convenience (which uses this -- @encodedFormBody@ function) takes care of this for you, obviously. -- encodedFormBody :: [(ByteString,ByteString)] -> OutputStream Builder -> IO () encodedFormBody nvs o = do Streams.write (Just b) o where b = mconcat $ intersperse (Builder.fromString "&") $ map combine nvs combine :: (ByteString,ByteString) -> Builder combine (n',v') = mconcat [urlEncodeBuilder n', Builder.fromString "=", urlEncodeBuilder v'] -- -- | Place content on the server at the given URL via an HTTP PUT -- request, specifying the content type and a function to write the -- content to the supplied 'OutputStream'. You might see: -- -- > put "http://s3.example.com/bucket42/object149" "text/plain" -- > (fileBody "hello.txt") (\p i -> do -- > putStr $ show p -- > Streams.connect i stdout) -- put :: URL -- ^ Resource to PUT to. -> ContentType -- ^ MIME type of the request body being sent. -> (OutputStream Builder -> IO α) -- ^ Handler function to write content to server. -> (Response -> InputStream ByteString -> IO β) -- ^ Handler function to receive the response from the server. -> IO β put r' t body handler = do bracket (establish u) (teardown) (process) where teardown = closeConnection u = parseURL r' q = buildRequest1 $ do http PUT (path u) setAccept "*/*" setHeader "Content-Type" t process c = do _ <- sendRequest c q body x <- receiveResponse c handler return x -- -- | A special case of 'concatHandler', this function will return the -- entire response body as a single ByteString, but will throw -- 'HttpClientError' if the response status code was other than @2xx@. -- concatHandler' :: Response -> InputStream ByteString -> IO ByteString concatHandler' p i = if s >= 300 then throw (HttpClientError s m) else concatHandler p i where s = getStatusCode p m = getStatusMessage p data HttpClientError = HttpClientError Int ByteString deriving (Typeable) instance Exception HttpClientError instance Show HttpClientError where show (HttpClientError s msg) = Prelude.show s ++ " " ++ S.unpack msg {- There should probably also be HttpServerError and maybe even HttpRedirectError, but as these names don't seem to show up in the runtime when raised, not sure it's worth the bother. It's not like we'd want anything different in their Show instances. -} -- -- | If you're working with a data stream that is in @application/json@, -- then chances are you're using @aeson@ to handle the JSON to Haskell -- decoding. If so, then this helper function might be of use. -- -- > v <- get "http://api.example.com/v1/" jsonHandler -- -- This function feeds the input body to the 'Data.Aeson.Parser.json'' -- @attoparsec@ Parser in order to get the aeson Value type. This is then -- marshalled to your type represeting the source data, via the FromJSON -- typeclass. -- -- The above example was actually insufficient; when working with -- @aeson@ you need to fix the type so it knows what FromJSON instance -- to use. Let's say you're getting Person objects, then it would be -- -- > v <- get "http://api.example.com/v1/person/461" jsonHandler :: IO Person -- -- assuming your Person type had a FromJSON instance, of course. -- -- /Note/ -- -- This function parses a single top level JSON object or array, which -- is all you're supposed to get if it's a valid document. People do -- all kinds of crazy things though, so beware. Also, this function (like the -- "concatHander" convenience) loads the entire response into memory; it's -- not /streaming/; if you're receiving a document which is (say) a very -- long array of objects then you may want to implement your own -- handler function, perhaps using "Streams.parserToInputStream" and -- the 'Data.Aeson.Parser' combinators directly — with a result type of -- InputStream Value, perhaps — by which you could then iterate over -- the Values one at a time in constant space. -- {- This looks simple. It wasn't. The types involved are rediculous to disentangle. The biggest problem is that the Parser type used in [aeson] is *NOT* the Parser type from [attoparsec]. But the parsing function `json` and `json` from Aeson use the attoparsec Parser even though the rest of the top level page is all about Aeson's parser as used in FromJSON! Anyway, `json` and `json'` are [attoparsec] Parser [aeson] Value; we run that using the [io-streams] convenience function `parseFromStream` which gets us a Value which is the intermediate abstract syntax tree for a JSON document. Then (and this was hard to find) to work with that in terms of the FromJSON typeclass, you use the `fromJSON` function which has type (FromJSON α => Value -> Result α). Then finally, pull the result out of it. Why in Bog's name this wasn't just Either I'll never know. -} jsonHandler :: (FromJSON α) => Response -> InputStream ByteString -> IO α jsonHandler _ i = do v <- Streams.parseFromStream json' i -- Value let r = fromJSON v -- Result case r of (Success a) -> return a (Error str) -> error str http-streams-0.8.6.1/lib/Network/Http/Utilities.hs0000644000000000000000000002025713272464116020146 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- -- This file is essentially a clone of Snap.Internal.Parsing, -- the HTTP request parser implementation in the Snap Framework; -- snap-core's src/Snap/Internal/Parsing.hs and snap-server's -- src/Snap/Internal/Http/Parser.hs, copied here to specialize -- it to Response parsing. This code replaces the attoparsec -- based implementation formerly in ResponseParser, but is -- kept separate to aid syncing changes from snap-core as they -- become available. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK hide, not-home #-} module Network.Http.Utilities ( readResponseLine, readHeaderFields ) where ------------------------------------------------------------------------------ import Control.Exception (throwIO) import Control.Monad (when) import Data.Bits import qualified Data.ByteString.Char8 as S import Data.ByteString.Internal (ByteString, w2c) import qualified Data.ByteString.Unsafe as S import Data.Char hiding (digitToInt, isDigit, isSpace) import GHC.Exts (Int (..), Int#, (+#)) import Prelude hiding (head, take, takeWhile) import System.IO.Streams (InputStream) import qualified System.IO.Streams as Streams ---------------------------------------------------------------------------- import Network.Http.Types ------------------------------------------------------------------------------ {- This is vestigial; originally it was the Request parsing code in Snap. Keeping it here until we can use if for response parsing. -} parseRequest :: InputStream ByteString -> IO (Maybe Request) parseRequest input = do eof <- Streams.atEOF input if eof then return Nothing else do line <- readResponseLine input let (!mStr,!s) = bSp line let (!uri, !vStr) = bSp s let !version = pVer vStr :: (Int,Int) -- hdrs <- readHeaderFields input return $! Nothing where pVer s = if "HTTP/" `S.isPrefixOf` s then pVers (S.unsafeDrop 5 s) else (1, 0) bSp = splitCh ' ' pVers s = (c, d) where (!a, !b) = splitCh '.' s !c = unsafeFromNat a !d = unsafeFromNat b {- Read a single line of an HTTP response. -} readResponseLine :: InputStream ByteString -> IO ByteString readResponseLine input = go [] where throwNoCRLF = throwIO $ HttpParseException "parse error: expected line ending in crlf" throwBadCRLF = throwIO $ HttpParseException "parse error: got cr without subsequent lf" go !l = do !mb <- Streams.read input !s <- maybe throwNoCRLF return mb case findCRLF s of FoundCRLF idx# -> foundCRLF l s idx# NoCR -> noCRLF l s LastIsCR idx# -> lastIsCR l s idx# _ -> throwBadCRLF foundCRLF l s idx# = do let !i1 = (I# idx#) let !i2 = (I# (idx# +# 2#)) let !a = S.unsafeTake i1 s when (i2 < S.length s) $ do let !b = S.unsafeDrop i2 s Streams.unRead b input -- Optimize for the common case: dl is almost always "id" let !out = if null l then a else S.concat (reverse (a:l)) return out noCRLF l s = go (s:l) lastIsCR l s idx# = do !t <- Streams.read input >>= maybe throwNoCRLF return if S.null t then lastIsCR l s idx# else do let !c = S.unsafeHead t if c /= 10 then throwBadCRLF else do let !a = S.unsafeTake (I# idx#) s let !b = S.unsafeDrop 1 t when (not $ S.null b) $ Streams.unRead b input let !out = if null l then a else S.concat (reverse (a:l)) return out ------------------------------------------------------------------------------ data CS = FoundCRLF !Int# | NoCR | LastIsCR !Int# | BadCR ------------------------------------------------------------------------------ findCRLF :: ByteString -> CS findCRLF b = case S.elemIndex '\r' b of Nothing -> NoCR Just !i@(I# i#) -> let !i' = i + 1 in if i' < S.length b then if S.unsafeIndex b i' == 10 then FoundCRLF i# else BadCR else LastIsCR i# {-# INLINE findCRLF #-} ------------------------------------------------------------------------------ splitCh :: Char -> ByteString -> (ByteString, ByteString) splitCh !c !s = maybe (s, S.empty) f (S.elemIndex c s) where f !i = let !a = S.unsafeTake i s !b = S.unsafeDrop (i + 1) s in (a, b) {-# INLINE splitCh #-} ------------------------------------------------------------------------------ breakCh :: Char -> ByteString -> (ByteString, ByteString) breakCh !c !s = maybe (s, S.empty) f (S.elemIndex c s) where f !i = let !a = S.unsafeTake i s !b = S.unsafeDrop i s in (a, b) {-# INLINE breakCh #-} ------------------------------------------------------------------------------ splitHeader :: ByteString -> (ByteString, ByteString) splitHeader !s = maybe (s, S.empty) f (S.elemIndex ':' s) where l = S.length s f i = let !a = S.unsafeTake i s in (a, skipSp (i + 1)) skipSp !i | i >= l = S.empty | otherwise = let c = S.unsafeIndex s i in if isLWS $ w2c c then skipSp $ i + 1 else S.unsafeDrop i s {-# INLINE splitHeader #-} ------------------------------------------------------------------------------ isLWS :: Char -> Bool isLWS c = c == ' ' || c == '\t' {-# INLINE isLWS #-} ------------------------------------------------------------------------------ {- Read the remainder of the response message's header section, parsing into key/value pairs. Note that this function terminates when it hits the "blank" line (ie, CRLF CRLF pair), which it consumes. -} readHeaderFields :: InputStream ByteString -> IO [(ByteString,ByteString)] readHeaderFields input = do f <- go id return $! f [] where go !dlistSoFar = do line <- readResponseLine input if S.null line then return dlistSoFar else do let (!k,!v) = splitHeader line vf <- pCont id let vs = vf [] let !v' = if null vs then v else S.concat (v:vs) let !t = (k,v') go (dlistSoFar . (t:)) where trimBegin = S.dropWhile isLWS pCont !dlist = do mbS <- Streams.peek input maybe (return dlist) (\s -> if S.null s then Streams.read input >> pCont dlist else if isLWS $ w2c $ S.unsafeHead s then procCont dlist else return dlist) mbS procCont !dlist = do line <- readResponseLine input let !t = trimBegin line pCont (dlist . (" ":) . (t:)) ----------------------- -- utility functions -- ----------------------- ------------------------------------------------------------------------------ -- | Note: only works for nonnegative naturals unsafeFromNat :: (Enum a, Num a, Bits a) => ByteString -> a unsafeFromNat = S.foldl' f 0 where zero = ord '0' f !cnt !i = cnt * 10 + toEnum (digitToInt i) digitToInt c = if d >= 0 && d <= 9 then d else error $ "bad digit: '" ++ [c] ++ "'" where !d = ord c - zero {-# INLINE unsafeFromNat #-} http-streams-0.8.6.1/tests/check.hs0000644000000000000000000000112313077254255015267 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is made -- available to you by its authors as open source software: you can -- redistribute it and/or modify it under a BSD licence. -- {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -fno-warn-unused-imports #-} module Main where import OpenSSL (withOpenSSL) import Test.Hspec (hspec) import MockServer (runMockServer) import TestSuite (suite) main :: IO () main = withOpenSSL $ do runMockServer hspec suite http-streams-0.8.6.1/tests/TestSuite.hs0000644000000000000000000005647612517351173016163 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is made -- available to you by its authors as open source software: you can -- redistribute it and/or modify it under a BSD licence. -- {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -fno-warn-unused-imports #-} module TestSuite where import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as Builder (fromByteString, toByteString) import qualified Blaze.ByteString.Builder.Char8 as Builder (fromChar, fromString) import Control.Applicative import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar) import Control.Exception (Exception, bracket, handleJust) import Control.Monad (forM_, guard) import Data.Aeson (FromJSON, ToJSON, Value (..), json, object, parseJSON, toJSON, (.:), (.=)) import Data.Aeson.Encode.Pretty import Data.Bits import qualified Data.HashMap.Strict as Map import Data.Maybe (fromJust) import Data.Monoid import Data.String import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import GHC.Generics hiding (Selector) import Network.Socket (SockAddr (..)) import Network.URI (parseURI) import System.Timeout (timeout) import Test.Hspec (Spec, describe, it) import Test.Hspec.Expectations (Selector, anyException, shouldThrow) import Test.HUnit import Debug.Trace -- -- Otherwise redundent imports, but useful for testing in GHCi. -- import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, parseTest) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy as L import Debug.Trace import System.IO.Streams (InputStream, OutputStream) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Debug as Streams -- -- what we're actually testing -- import MockServer (localPort) import Network.Http.Client import Network.Http.Connection (Connection (..)) import Network.Http.Inconvenience (HttpClientError (..), TooManyRedirects (..), splitURI) import Network.Http.Internal (Request (..), Response (..), composeRequestBytes, lookupHeader) import Network.Http.ResponseParser (readDecimal, readResponseHeader) localhost = S.pack ("localhost:" ++ show localPort) suite :: Spec suite = do describe "Opening a connection" $ do testConnectionHost describe "Request, when serialized" $ do testRequestLineFormat testRequestTermination testEnsureHostField testAcceptHeaderFormat testBasicAuthorizatonHeader describe "Parsing responses" $ do testResponseParser1 testResponseParserMismatch testPaddedContentLength -- testTrailingWhitespace testChunkedEncoding testContentLength testDevoidOfContent testCompressedResponse testRepeatedResponseHeaders describe "Expectation handling" $ do testExpectationContinue describe "Convenience API" $ do testPutChunks testPostChunks testPostWithForm testGetRedirects testSplitURI testGetLocalRedirects testGetFormatsRequest testExcessiveRedirects testGeneralHandler testEstablishConnection testParsingJson1 testParsingJson2 describe "Corner cases in protocol compliance" $ do testSendBodyFor PUT testSendBodyFor DELETE testSendBodyFor PATCH testRequestTermination = it "terminates with a blank line" $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http GET "/time" setAccept "text/plain" let e' = Builder.toByteString $ composeRequestBytes q "booga" let n = S.length e' - 4 let (a',b') = S.splitAt n e' assertEqual "Termination not CRLF CRLF" "\r\n\r\n" b' assertBool "Must be only one blank line at end of headers" ('\n' /= S.last a') closeConnection c testRequestLineFormat = do it "has a properly formatted request line" $ bracket (fakeConnection) (return) (\c -> do let q = buildRequest1 $ do http GET "/time" let e' = Builder.toByteString $ composeRequestBytes q (cHost c) let l' = S.takeWhile (/= '\r') e' assertEqual "Invalid HTTP request line" "GET /time HTTP/1.1" l') it "handles empty request path" $ bracket (fakeConnection) (return) (\c -> do let q = buildRequest1 $ do http GET "" let e' = Builder.toByteString $ composeRequestBytes q (cHost c) let l' = S.takeWhile (/= '\r') e' assertEqual "Invalid HTTP request line" "GET / HTTP/1.1" l') fakeConnection :: IO Connection fakeConnection = do i <- Streams.nullInput o <- Streams.nullOutput c <- makeConnection "www.example.com" (return ()) o i return c testAcceptHeaderFormat = it "properly formats Accept header" $ do let q = buildRequest1 $ do setAccept' [("text/html", 1),("*/*", 0.0)] let h = qHeaders q let (Just a) = lookupHeader h "Accept" assertEqual "Failed to format header" "text/html; q=1.0, */*; q=0.0" a testBasicAuthorizatonHeader = it "properly formats Authorization header" $ do let q = buildRequest1 $ do setAuthorizationBasic "Aladdin" "open sesame" let h = qHeaders q let (Just a) = lookupHeader h "Authorization" assertEqual "Failed to format header" "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" a testConnectionHost = do it "properly caches hostname and port" $ do bracket (openConnection "localhost" localPort) closeConnection (\c -> do let h' = cHost c assertEqual "Host value needs to be name, not IP address" expected h') where expected = S.pack $ "localhost:" ++ show localPort {- Incidentally, Host is *not* stored in the Headers map, but is a field of the Request object. -} testEnsureHostField = it "has a properly formatted Host header" $ do let q1 = buildRequest1 $ do http GET "/hello.txt" let h1 = qHost q1 assertEqual "Incorrect Host header" Nothing h1 let q2 = buildRequest1 $ do http GET "/hello.txt" setHostname "other.example.com" 80 let h2 = qHost q2 assertEqual "Incorrect Host header" (Just "other.example.com") h2 let q3 = buildRequest1 $ do http GET "/hello.txt" setHostname "other.example.com" 54321 let h3 = qHost q3 assertEqual "Incorrect Host header" (Just "other.example.com:54321") h3 testResponseParser1 = it "parses a simple 200 response" $ do p <- Streams.withFileAsInput "tests/example1.txt" (\i -> readResponseHeader i) assertEqual "Incorrect parse of response" 200 (getStatusCode p) return () testResponseParserMismatch = it "parses response when HTTP version doesn't match" $ do p <- Streams.withFileAsInput "tests/example3.txt" (\i -> readResponseHeader i) assertEqual "Incorrect parse of response" 200 (getStatusCode p) return () testPaddedContentLength = it "handles padded Content-Length" $ do p <- Streams.withFileAsInput "tests/example4.txt" (\i -> readResponseHeader i) let (Just len) = pContentLength p assertEqual "Should have trimmed in decimal conversion" 86 len {- Presently inactive -} testTrailingWhitespace = it "where headers have trailing whitespace" $ do p <- Streams.withFileAsInput "tests/example4.txt" (\i -> readResponseHeader i) let (Just value) = getHeader p "Content-Length" assertEqual "Should have trimmed field value" "86" value testChunkedEncoding = it "recognizes chunked transfer encoding and decodes" $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http GET "/time" sendRequest c q emptyBody receiveResponse c (\p i1 -> do let cm = getHeader p "Transfer-Encoding" assertEqual "Should be chunked encoding!" (Just "chunked") cm (i2, getCount) <- Streams.countInput i1 Streams.skipToEof i2 len <- getCount assertEqual "Incorrect number of bytes read" 29 len) testContentLength = do it "recognzies fixed length message" $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http GET "/static/statler.jpg" sendRequest c q emptyBody receiveResponse c (\p i1 -> do let nm = getHeader p "Content-Length" assertMaybe "Should be a Content-Length header!" nm let n = read $ S.unpack $ fromJust nm :: Int assertEqual "Should be a fixed length message!" 4611 n (i2, getCount) <- Streams.countInput i1 x' <- Streams.readExactly 4611 i2 len <- getCount assertEqual "Incorrect number of bytes read" 4611 len assertBool "Incorrect length" (4611 == S.length x') end <- Streams.atEOF i2 assertBool "Expected end of stream" end) it "doesn't choke if server neglects Content-Length" $ do p <- Streams.withFileAsInput "tests/example3.txt" (\i -> readResponseHeader i) assertEqual "Incorrect parse of response" 200 (getStatusCode p) assertEqual "Incorrect parse of response" Nothing (getHeader p "Content-Length") assertEqual "Should not have pContentLength" Nothing (pContentLength p) return () it "reads body without Content-Length or Transfer-Encoding" $ do c <- fakeConnectionHttp10 let q = buildRequest1 $ do http GET "/fake" sendRequest c q emptyBody receiveResponse c (\_ i1 -> do (i2, getCount) <- Streams.countInput i1 o <- Streams.nullOutput Streams.connect i2 o end <- Streams.atEOF i2 assertBool "Expected end of stream" end len <- getCount assertEqual "Incorrect number of bytes read" 4611 len) return () fakeConnectionHttp10 :: IO Connection fakeConnectionHttp10 = do x' <- S.readFile "tests/example3.txt" i <- Streams.fromByteString x' o <- Streams.nullOutput c <- makeConnection "bad.example.com" (return ()) o i return c {- Corner case where servers responding 204 No Content are not required to transmit a Content-Length header; Snap *does* send one, so we can't test it in the MockServer, so fake it with example5.txt -} testDevoidOfContent = do it "handles 204 No Content response without Content-Length" $ timeout_ 2 $ do (c, mv) <- fakeConnectionNoContent let q = buildRequest1 $ do http GET "/fake" sendRequest c q emptyBody receiveResponse c (\_ i1 -> do (i2, getCount) <- Streams.countInput i1 o <- Streams.nullOutput Streams.connect i2 o end <- Streams.atEOF i2 assertBool "Expected end of stream" end len <- getCount assertEqual "Incorrect number of bytes read" 0 len) putMVar mv () return () where secs :: Int secs = 10 ^ (6 :: Int) timeout_ :: Int -> IO a -> IO a timeout_ t m = timeout (t * secs) m >>= maybe (error "timeout") return fakeConnectionNoContent :: IO (Connection, MVar ()) fakeConnectionNoContent = do x' <- S.readFile "tests/example5.txt" i1 <- Streams.fromByteString x' mv <- newEmptyMVar i2 <- Streams.makeInputStream $ blockOn mv i3 <- Streams.concatInputStreams [i1, i2] o <- Streams.nullOutput c <- makeConnection "worse.example.com" (return ()) o i3 return (c, mv) where blockOn :: MVar () -> IO (Maybe ByteString) blockOn mv = takeMVar mv >> return Nothing {- This had to change when we moved to an internal test server; seems Snap is doing something funny when gzipping and switching to chunked encoding no matter what I do. -} testCompressedResponse = it "recognizes gzip content encoding and decompresses" $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http GET "/static/hello.html" setHeader "Accept-Encoding" "gzip" sendRequest c q emptyBody receiveResponse c (\p i -> do let nm = getHeader p "Content-Encoding" assertMaybe "Should be a Content-Encoding header!" nm assertEqual "Content-Encoding header should be 'gzip'!" (Just "gzip") nm (i2, getCount) <- Streams.countInput i x' <- Streams.readExactly 102 i2 len <- getCount assertEqual "Incorrect number of bytes read" 102 len assertBool "Incorrect length" (102 == S.length x') end <- Streams.atEOF i assertBool "Expected end of stream" end) {- This isn't much of a test yet; we really need to test a) that 100 Continue was received b) that it was absorbed c) that body is correct size, and then d) 4xx and 5xx responses are propegated through. -} testExpectationContinue = it "sends expectation and handles 100 response" $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http PUT "/resource/x149" setExpectContinue sendRequest c q (\o -> do Streams.write (Just (Builder.fromString "Hello world\n")) o) receiveResponse c (\p i -> do assertEqual "Incorrect status code" 201 (getStatusCode p) x' <- Streams.readExactly 12 i end <- Streams.atEOF i assertBool "Expected end of stream" end assertEqual "Incorrect body" "Hello world\n" x') closeConnection c assertMaybe :: String -> Maybe a -> Assertion assertMaybe prefix m0 = case m0 of Nothing -> assertFailure prefix Just _ -> assertBool "" True testPutChunks = it "PUT correctly chunks known size entity body" $ do let url = S.concat ["http://", localhost, "/size"] put url "text/plain" body handler where body :: OutputStream Builder -> IO () body o = do let x = mconcat $ replicate 33000 (Builder.fromChar 'x') Streams.write (Just x) o handler :: Response -> InputStream ByteString -> IO () handler _ i = do (Just b') <- Streams.read i end <- Streams.atEOF i assertBool "Expected end of stream" end let size = readDecimal b' :: Int assertEqual "Should have replied with correct file size" 33000 size testSendBodyFor meth = it ("Sends a request body for " ++ show meth) $ do c <- openConnection "localhost" localPort let q = buildRequest1 $ do http meth "/size" setContentType "text/plain" setTransferEncoding sendRequest c q (\o -> do Streams.write (Just (Builder.fromString "a request")) o) receiveResponse c (\p i -> do assertEqual "Incorrect status code" 200 (getStatusCode p) (Just b') <- Streams.read i let size = readDecimal b' :: Int assertEqual "Should have received a request body" 9 size) closeConnection c testPostChunks = it "POST correctly chunks a fileBody" $ do let url = S.concat ["http://", localhost, "/size"] post url "image/jpeg" (fileBody "tests/statler.jpg") handler where handler :: Response -> InputStream ByteString -> IO () handler p i = do let code = getStatusCode p assertEqual "Expected 200 OK" 200 code (Just b') <- Streams.read i end <- Streams.atEOF i assertBool "Expected end of stream" end let size = readDecimal b' :: Int assertEqual "Should have replied with correct file size" 4611 size testPostWithForm = it "POST with form data correctly encodes parameters" $ do let url = S.concat ["http://", localhost, "/postbox"] postForm url [ ("name", "Kermit") , ("role", "St&gehand") , ("country", Text.encodeUtf8 $ Text.pack "Nørway") ] handler where handler :: Response -> InputStream ByteString -> IO () handler p i = do let code = getStatusCode p assertEqual "Expected 201" 201 code b' <- Streams.readExactly 48 i end <- Streams.atEOF i assertBool "Expected end of stream" end assertEqual "Incorrect URL encoding" "name=Kermit&role=St%26gehand&country=N%c3%b8rway" b' testGetRedirects = it "GET internal handler follows redirect on 307" $ do let url = S.concat ["http://", localhost, "/bounce"] get url handler where handler :: Response -> InputStream ByteString -> IO () handler p i1 = do let code = getStatusCode p assertEqual "Should have been final code" 200 code (i2, getCount) <- Streams.countInput i1 Streams.skipToEof i2 len <- getCount assertEqual "Incorrect number of bytes read" 29 len testGetLocalRedirects = it "GET internal handler follows local redirect on 307" $ do let url = S.concat ["http://", localhost, "/local"] get url handler where handler :: Response -> InputStream ByteString -> IO () handler p i1 = do let code = getStatusCode p assertEqual "Should have been final code" 200 code (i2, getCount) <- Streams.countInput i1 Streams.skipToEof i2 len <- getCount assertEqual "Incorrect number of bytes read" 29 len testSplitURI = it "check splitURI for local redirects" $ do let a1 = "http://asdf@ya.ru:8000/hello/?asd=asd&abc=2" r1 = S.pack "/hello/?asd=asd&abc=2" assertEqual "Incorrect split uri 1" (S.pack a1) (splitURI (fromJust $ parseURI a1) r1) let a2 = "http://asdf@ya.ru:8000/again/?asd=asd&abc=2" r2 = S.pack "/again/?asd=asd&abc=2" assertEqual "Incorrect split uri 2" (S.pack a2) (splitURI (fromJust $ parseURI a2) r2) let a3 = "http://ya.ru:8000/here/?asd=asd&abc=2" r3 = S.pack "/here/?asd=asd&abc=2" assertEqual "Incorrect split uri 3" (S.pack a3) (splitURI (fromJust $ parseURI a3) r3) let a4 = "http://ya.ru/?asd=asd&abc=2#papa" r4 = S.pack "/?asd=asd&abc=2#papa" assertEqual "Incorrect split uri 4" (S.pack a4) (splitURI (fromJust $ parseURI a4) r4) let a5 = "http://ya.ru/?asd=asd&abc=2#papa" r5 = S.pack "http://google.ru/" assertEqual "Incorrect split uri 5" r5 (splitURI (fromJust $ parseURI a5) r5) testGetFormatsRequest = it "GET includes a properly formatted request path" $ do let url = S.concat ["http://", localhost ] x' <- get url concatHandler' assertBool "Incorrect context path" (S.length x' > 0) testExcessiveRedirects = it "too many redirects result in an exception" $ do let url = S.concat ["http://", localhost, "/loop"] get url handler `shouldThrow` tooManyRedirects where handler :: Response -> InputStream ByteString -> IO () handler _ _ = do assertBool "Should have thrown exception before getting here" False testRepeatedResponseHeaders = it "repeated response headers are properly concatonated" $ do let url = S.concat ["http://", localhost, "/cookies"] get url handler where handler :: Response -> InputStream ByteString -> IO () handler r _ = do assertEqual "Invalid response headers" (Just "stone=diamond,metal=tungsten") (getHeader r "Set-Cookie") {- From http://stackoverflow.com/questions/6147435/is-there-an-assertexception-in-any-of-the-haskell-test-frameworks because "although HUnit doesn't have this, it's easy to write your own". Uh huh. Surely there's an easier way to do this. -} assertException :: (Exception e, Eq e) => e -> IO a -> IO () assertException ex action = handleJust isWanted (const $ return ()) $ do _ <- action assertFailure $ "Expected exception: " ++ show ex where isWanted = guard . (== ex) testGeneralHandler = it "GET with general purpose handler throws exception on 404" $ do let url = S.concat ["http://", localhost, "/booga"] get url concatHandler' `shouldThrow` httpClientError 404 tooManyRedirects :: Selector TooManyRedirects tooManyRedirects = const True -- :: Int -> Selector HttpClientError httpClientError :: Int -> HttpClientError -> Bool httpClientError expected (HttpClientError actual _) = expected == actual testEstablishConnection = it "public establish function behaves correctly" $ do let url = S.concat ["http://", localhost, "/static/statler.jpg"] x' <- withConnection (establishConnection url) $ (\c -> do let q = buildRequest1 $ do http GET "/static/statler.jpg" -- TODO be nice if we could replace that with 'url'; -- fix the routeRequests function in TestServer maybe? sendRequest c q emptyBody receiveResponse c concatHandler') let len = S.length x' assertEqual "Incorrect number of bytes read" 4611 len testParsingJson1 = it "GET with JSON handler behaves" $ do let url = S.concat ["http://", localhost, "/static/data-eu-gdp.json"] x <- get url jsonHandler let (Object o) = x let (Just v) = Map.lookup "label" o let (String t) = v assertEqual "Incorrect response" "Europe (EU27)" t testParsingJson2 = it "GET with JSON handler parses using Aeson" $ do let url = S.concat ["http://", localhost, "/static/data-jp-gdp.json"] x <- get url jsonHandler :: IO GrossDomesticProduct assertEqual "Incorrect response" "Japan" (gLabel x) assertEqual "Data not parsed as expected" 2008 (fst $ last $ gData x) -- L.putStr $ encodePretty x {- Go to the trouble to create a Haskell data type representing the JSON feed we're getting from the sample data files. The Generic trick doesn't work because data is a reserved word, of course. -} data GrossDomesticProduct = GrossDomesticProduct { gLabel :: Text, gData :: [(Int, Double)] } deriving (Show, Generic) instance FromJSON GrossDomesticProduct where parseJSON (Object o) = GrossDomesticProduct <$> o .: "label" <*> o .: "data" parseJSON _ = undefined instance ToJSON GrossDomesticProduct where toJSON (GrossDomesticProduct l d) = object ["label" .= l, "data" .= d] http-streams-0.8.6.1/tests/MockServer.hs0000644000000000000000000002064112746504266016302 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is made -- available to you by its authors as open source software: you can -- redistribute it and/or modify it under a BSD licence. -- {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# OPTIONS -fno-warn-dodgy-imports #-} module MockServer (runMockServer, localPort) where {- Per http://hackage.haskell.org/trac/ghc/ticket/7167, we suppress the warning resulting from this line, necessary on <7.6 -} import Prelude hiding (catch) import Control.Applicative import Control.Concurrent (forkIO, threadDelay) import Control.Exception (SomeException) import Control.Exception.Lifted (catch) import "mtl" Control.Monad.Trans (liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import Data.Maybe (fromMaybe) import Filesystem (getSize) import Filesystem.Path.CurrentOS (decodeString) import Snap.Core import Snap.Http.Server import Snap.Util.FileServe import System.IO (hFlush, hPutStrLn, stderr) import Network.Http.Client (Hostname, Port) localHost = "localhost" :: Hostname localPort = 56981 :: Port main :: IO () main = go {- Binding the port to the IPv4 localhost appears to settle the problem of localhost resolving ambigiously. If that doesn't work, we can comment out the setBind and the resultant 0.0.0.0 does seem to work. -} go :: IO () go = httpServe c site where c = setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ setHostname localHost $ setBind localHost $ setPort (fromIntegral localPort) $ setVerbose False emptyConfig runMockServer :: IO () runMockServer = do _ <- forkIO go threadDelay 2000000 return () -- -- Top level URL routing logic. -- site :: Snap () site = catch (routeRequests) (\e -> serveError "Splat\n" e) routeRequests :: Snap () routeRequests = route [("resource/:id", serveResource), ("static/:id", method GET serveStatic), ("time", serveTime), ("", ifTop handleAsText), ("bounce", serveRedirect), ("local", serveLocalRedirect), ("loop", serveRedirectEndlessly), ("empty", serveWithoutContent), ("postbox", method POST handlePostMethod), ("size", handleSizeRequest), ("api", handleRestfulRequest), ("cookies", serveRepeatedResponseHeaders)] <|> serveNotFound serveResource :: Snap () serveResource = do r <- getRequest let m = rqMethod r case m of GET -> handleGetMethod PUT -> handlePutWithExpectation _ -> serveMethodNotAllowed serveStatic :: Snap () serveStatic = do im' <- getParam "id" let i' = fromMaybe "" im' let f' = S.concat ["tests/", i'] let f = S.unpack f' l <- liftIO $ getSize $ decodeString f let t = fileType defaultMimeTypes f modifyResponse $ setContentType t modifyResponse $ setContentLength $ fromIntegral l b' <- liftIO $ S.readFile f writeBS b' serveTime :: Snap () serveTime = do writeBS "Sun 30 Dec 12, 05:39:56.746Z\n" -- -- Dispatch normal GET requests based on MIME type. -- handleGetMethod :: Snap () handleGetMethod = do r <- getRequest let mime0 = getHeader "Accept" r case mime0 of Just "text/html" -> handleAsBrowser _ -> handleAsText handleAsBrowser :: Snap () handleAsBrowser = do modifyResponse $ setResponseStatus 200 "OK" modifyResponse $ setContentType "text/html; charset=UTF-8" modifyResponse $ setHeader "Cache-Control" "max-age=1" sendFile "tests/hello.html" handleAsText :: Snap () handleAsText = do modifyResponse $ setContentType "text/plain" writeBS "Sounds good to me\n" handleRestfulRequest :: Snap () handleRestfulRequest = do modifyResponse $ setResponseStatus 200 "OK" modifyResponse $ setContentType "application/json" sendFile "tests/data-eu-gdp.json" serveRedirect :: Snap () serveRedirect = do modifyResponse $ setResponseStatus 307 "Temporary Redirect" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setHeader "Location" r' where r' = S.concat ["http://", localHost, ":", S.pack $ show $ localPort, "/time"] serveLocalRedirect :: Snap () serveLocalRedirect = do modifyResponse $ setResponseStatus 307 "Temporary Redirect" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setHeader "Location" r' where r' = S.pack "/time" serveRedirectEndlessly :: Snap () serveRedirectEndlessly = do modifyResponse $ setResponseStatus 307 "Temporary Redirect" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setHeader "Location" r' where r' = S.concat ["http://", localHost, ":", S.pack $ show $ localPort, "/loop"] {- Attempt to test the bug with 204 No Content not closing in absence of a Content-Length header, however Snap automatically adds one, it seems. So, after the fact, this is unused and the case is tested in TestServer.testDevoidOfContent. -} serveWithoutContent :: Snap () serveWithoutContent = do modifyResponse $ setResponseStatus 204 "No Content" modifyResponse $ setHeader "Cache-Control" "no-cache" serveRepeatedResponseHeaders :: Snap () serveRepeatedResponseHeaders = do modifyResponse $ addHeader "Set-Cookie" "stone=diamond" modifyResponse $ addHeader "Set-Cookie" "metal=tungsten" handlePostMethod :: Snap () handlePostMethod = do setTimeout 5 modifyResponse $ setResponseStatus 201 "Created" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setHeader "Location" "http://server.example.com/something/788" modifyResponse $ setContentType "text/plain" b' <- readRequestBody 1024 writeLBS b' handlePutWithExpectation :: Snap () handlePutWithExpectation = do setTimeout 5 modifyResponse $ setResponseStatus 201 "Created" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setContentType "text/plain" b' <- readRequestBody 1024 writeLBS b' handleSizeRequest :: Snap () handleSizeRequest = do r <- getRequest let mm = getHeader "Content-Type" r t <- case mm of Just m -> return m _ -> do serveUnsupported return "" modifyResponse $ setResponseStatus 200 "OK" modifyResponse $ setContentType t b' <- readRequestBody 65536 writeBS $ S.pack $ show $ L.length b' updateResource :: Snap () updateResource = do bs' <- readRequestBody 4096 let b' = fromLazy bs' im' <- getParam "id" let i' = fromMaybe "0" im' -- TODO something modifyResponse $ setResponseStatus 204 "Updated" -- "No Content" modifyResponse $ setHeader "Cache-Control" "no-cache" modifyResponse $ setContentLength 0 return () where fromLazy ls' = S.concat $ L.toChunks ls' serveNotFound :: Snap a serveNotFound = do modifyResponse $ setResponseStatus 404 "Not Found" modifyResponse $ setHeader "Content-Type" "text/html" writeBS "404 Not Found" r <- getResponse finishWith r serveBadRequest :: Snap () serveBadRequest = do modifyResponse $ setResponseStatus 400 "Bad Request" writeBS "400 Bad Request\n" serveMethodNotAllowed :: Snap () serveMethodNotAllowed = do modifyResponse $ setResponseStatus 405 "Method Not Allowed" modifyResponse $ setHeader "Allow" "GET, POST, PUT" writeBS "405 Method Not Allowed\n" r <- getResponse finishWith r serveUnsupported :: Snap () serveUnsupported = do modifyResponse $ setResponseStatus 415 "Unsupported Media Type" writeBS "415 Unsupported Media Type\n" r <- getResponse finishWith r -- -- The exception will be dumped to the server's stdout, while the supplied -- message will be sent out with the response (ideally only for debugging -- purposes, but easier than looking in log/error.log for details). -- serveError :: ByteString -> SomeException -> Snap () serveError x' e = do debug msg modifyResponse $ setResponseStatus 500 "Internal Server Error" writeBS x' r <- getResponse finishWith r where msg = show (e :: SomeException) debug :: String -> Snap () debug cs = do liftIO $ do hPutStrLn stderr "" hPutStrLn stderr cs hFlush stderr http-streams-0.8.6.1/LICENCE0000644000000000000000000000312013254164110013463 0ustar0000000000000000An HTTP client for use with io-streams Copyright © 2012-2017 Operational Dynamics Consulting, Pty Ltd and Others All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the project nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 OWNER OR CONTRIBUTORS 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. http-streams-0.8.6.1/Setup.hs0000644000000000000000000000340012134725454014145 0ustar0000000000000000-- -- HTTP client for use with io-streams -- -- Copyright © 2013 Operational Dynamics Consulting, Pty Ltd -- -- The code in this file, and the program it is a part of, is -- made available to you by its authors as open source software: -- you can redistribute it and/or modify it under the terms of -- the BSD licence. -- import Data.Char (toUpper) import Distribution.Text (display) import Distribution.PackageDescription (PackageDescription(..)) import Distribution.Simple import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) import Distribution.Simple.Setup (ConfigFlags) import Distribution.System (OS (..), buildOS) import System.IO (IOMode (..), Handle, hPutStrLn, withFile) main :: IO () main = defaultMainWithHooks $ simpleUserHooks { postConf = configure } {- Simple detection of which operating system we're building on; there's no need to link the Cabal logic into our library, so we'll keep using CPP in Network.Http.Inconvenience. -} configure :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () configure _ _ p _ = do withFile "config.h" WriteMode (\h -> do discoverOperatingSystem h discoverLibraryVersion h p) return () discoverOperatingSystem :: Handle -> IO () discoverOperatingSystem h = do hPutStrLn h ("#define " ++ s) where o = buildOS s = case o of Linux -> "__LINUX__" OSX -> "__MACOSX__" Windows -> "__WINDOWS__" _ -> "__" ++ up o ++ "__" up x = map toUpper (show x) discoverLibraryVersion :: Handle -> PackageDescription -> IO () discoverLibraryVersion h p = do hPutStrLn h ("#define VERSION \"http-streams/" ++ s ++ "\"") where i = package p v = pkgVersion i s = display v http-streams-0.8.6.1/http-streams.cabal0000644000000000000000000001162313272466230016134 0ustar0000000000000000cabal-version: 1.24 name: http-streams version: 0.8.6.1 synopsis: An HTTP client using io-streams description: /Overview/ . An HTTP client, using the Snap Framework's 'io-streams' library to hande the streaming IO. The API is optimized for ease of use for the rather common case of code needing to query web services and deal with the result. . The library is exported in a single module; see "Network.Http.Client" for full documentation. license: BSD3 license-file: LICENCE author: Andrew Cowie maintainer: Andrew Cowie copyright: © 2012-2018 Operational Dynamics Consulting, Pty Ltd and Others category: Web, IO-Streams tested-with: GHC == 8.2.2, GHC == 8.4.2 stability: experimental homepage: https://github.com/afcowie/http-streams/ bug-reports: https://github.com/afcowie/http-streams/issues extra-source-files: README.markdown CHANGELOG.markdown tests/MockServer.hs tests/TestSuite.hs tests/data-eu-gdp.json tests/data-us-gdp.json tests/data-jp-gdp.json tests/statler.jpg tests/example1.txt tests/example2.txt tests/example3.txt tests/example4.txt tests/example5.txt tests/hello.txt tests/hello.html build-type: Custom custom-setup setup-depends: base >= 4.5, Cabal >= 1.24 flag network-uri description: Get Network.URI from the network-uri package default: True library default-language: Haskell2010 build-depends: attoparsec, base >= 4.5 && <5, directory, base64-bytestring, blaze-builder >= 0.4, bytestring, case-insensitive, io-streams >= 1.3 && < 1.6, HsOpenSSL >= 0.11.2, openssl-streams >= 1.1 && < 1.4, mtl, transformers, text, unordered-containers, aeson, http-common >= 0.8.2 if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else build-depends: network-uri < 2.6, network < 2.6 hs-source-dirs: lib exposed-modules: Network.Http.Client, Network.Http.Connection, Network.Http.ResponseParser, Network.Http.Inconvenience other-modules: Network.Http.Utilities ghc-options: -Wall -Wwarn -fwarn-tabs -funbox-strict-fields -fno-warn-missing-signatures -fno-warn-unused-binds -fno-warn-unused-do-bind include-dirs: . ghc-prof-options: -fprof-auto-exported test-suite check type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: HUnit, HsOpenSSL, lifted-base, aeson-pretty, attoparsec, base, directory, blaze-builder, base64-bytestring, bytestring, case-insensitive, ghc-prim, hspec, hspec-expectations, io-streams, mtl, transformers, network >= 2.6, network-uri >= 2.6, openssl-streams >= 1.1 && < 1.4, snap-core >= 1.0 && < 1.1, snap-server >= 1.0 && < 1.1, system-fileio >= 0.3.10 && < 0.4, system-filepath >= 0.4.1 && < 0.5, text, unordered-containers, aeson, http-common >= 0.8.2, http-streams hs-source-dirs: tests main-is: check.hs other-modules: TestSuite MockServer ghc-options: -threaded -Wall -Wwarn -fwarn-tabs -funbox-strict-fields -fno-warn-missing-signatures -fno-warn-unused-binds -fno-warn-unused-do-bind include-dirs: . source-repository head type: git location: git://github.com/afcowie/http-streams.git -- vim: set tabstop=21 expandtab: http-streams-0.8.6.1/README.markdown0000644000000000000000000000344013135547527015223 0ustar0000000000000000An HTTP client ============== An HTTP client library for Haskell using the Snap Framework's [io-streams](https://hackage.haskell.org/package/io-streams) library to handle the streaming IO. A common case in writing RESTful web services is needing to make onward calls to further servers. This package is intended to make this easy to do. Though originally written for making calls from wep apps written with Snap, you can use this from any library or framework. Enjoy! Example ------- The underlying API is very simple: ```haskell main :: IO () main = do c <- openConnection "www.example.com" 80 let q = buildRequest1 $ do http GET "/" setAccept "text/html" sendRequest c q emptyBody receiveResponse c (\p i -> do putStr $ show p x <- Streams.read i S.putStr $ fromMaybe "" x) closeConnection c ``` There are also convenience functions for the common case of making straight-forward GET and POST requests; for instance: ```haskell get "http://www.example.com/" (\_ i -> Streams.connect i stdout) ``` will _{ahem}_ stream the response body to stdout. Perhaps more interesting (though less streams-oriented), is simply getting the response as a ByteString using one of the pre-defined handlers: ```haskell x' <- get "https://secure.example.com/" concatHandler ``` See the documentation in [Network.Http.Client](https://hackage.haskell.org/package/http-streams/docs/Network-Http-Client.html) for further examples and details of usage of the API. There's also a [blog post](http://blogs.operationaldynamics.com/andrew/software/haskell/http-streams-introduction) introducing the library with a discussion of the design and usage. Change Log ---------- Now included in separate file [CHANGELOG](CHANGELOG.markdown). AfC http-streams-0.8.6.1/CHANGELOG.markdown0000644000000000000000000000212513272465572015555 0ustar0000000000000000* _v0.8.6_ Internal modules are exposed. Mostly so the test suite would only depend on the library and not the code directly, but occasionally someone needed to poke at the internals. Usual warning against doing that applies. They are _not_ visible in the generated Haddock documentation. * _v0.8.4_ Support GHC 8.0 * _v0.8.3_ A pure version of `buildRequest` is now available as `buildRequest1`. Support for connecting to Unix domain sockets has been added. * _v0.7.0_ The Request, Response, Headers, and RequestBuilder types have been factored out and moved to **http-common**. They are still exported by **http-streams**. * _v0.6.0_ Entity body lengths (both for Requests and Responses) now Int64. Library depends on **io-streams** 1.1. * _v0.5.0_ Definition of Hostname and Port have been changed to ByteString and Word16, respectively. * _v0.4.0_ Type signature of `buildRequest` changed, removing the Connection parameter. This allows you to construct Request objects before opening a connection to the web server if you wish. * _v0.3.1_ Initial public release http-streams-0.8.6.1/tests/data-eu-gdp.json0000644000000000000000000000026112517347733016645 0ustar0000000000000000{ "label": "Europe (EU27)", "data": [[1999, 3.0], [2000, 3.9], [2001, 2.0], [2002, 1.2], [2003, 1.3], [2004, 2.5], [2005, 2.0], [2006, 3.1], [2007, 2.9], [2008, 0.9]] } http-streams-0.8.6.1/tests/data-us-gdp.json0000644000000000000000000000024712517347733016667 0ustar0000000000000000{ "label": "USA", "data": [[1999, 4.4], [2000, 3.7], [2001, 0.8], [2002, 1.6], [2003, 2.5], [2004, 3.6], [2005, 2.9], [2006, 2.8], [2007, 2.0], [2008, 1.1]] } http-streams-0.8.6.1/tests/data-jp-gdp.json0000644000000000000000000000025312517347733016646 0ustar0000000000000000{ "label": "Japan", "data": [[1999, -0.1], [2000, 2.9], [2001, 0.2], [2002, 0.3], [2003, 1.4], [2004, 2.7], [2005, 1.9], [2006, 2.0], [2007, 2.3], [2008, -0.7]] } http-streams-0.8.6.1/tests/statler.jpg0000644000000000000000000001100312517347733016036 0ustar0000000000000000JFIFC   %# , #&')*)-0-(0%()(C   (((((((((((((((((((((((((((((((((((((((((((((((((((" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ? Fw2znjG&Nx2HJj`o}_Ug׵'LV.-ݦu^/kQ2F4?*,x~ >/#4ϵ'q{dχzRgy`\gkQKL"vf3J|e)[˧C ƣ~ck}9vVhBL&Egse~H3'8 ֆ:\Qq0မS51Omͬs$ <|Džt{0#H1z}k׼? .њ7EPqNTNMI߉4 Qmpk#2zV ?Jw9-56N"3~yFZ\eAܠ=jDeLԃQ\P(;qJX"2:W.O)&2c'+)I)XP0OAӿ\p:SwP03Ih94̩o8wa9E C2J,rM\y҉>Ӎ鴓Qy'F`åDnef6,/|Xݰ[AV{ TKhQ]Pw8kGC8抴 +CX#֨ <⪙WZX鞵8R'%CcU/ʊdװvF39bUH]ܞgSS+0*) ArkBX! QRx8\;;D>9&+LY략hH s֧Tjh%~YTaXpGeYG"$*"Cd 1bwD12y2l =*̠ch'C"0zSNi d;umr)|.To-ArZc\A#Gwݹhƒ`zSI 3CɥUOMFVOQ5 :+2]YtZt}5V+Z(N:U3FTi ڊ)1=6M18wY>c\Mԓޒ"[bV'@=:ֵǖ`_Zӥt(0s[bVU=޳;oV>0&v ssZ &ާV>VUH_"S#z}+W'agd;9V'wV 6Pc?Mޗz=3ژ~PzSO 9CxѾ2'Q@I瓜ғ1Yh$@iGǭHGJ׽5rd*LZ͒sU淉2kS2O+ׂ<,p&mʱ'N؟8'q]|qE--T$*ںb:kcZhe2Y+W0˶zxJ/+Zju&T?#Pw>O֎dLt 0GLVխЂ)l W NKuZ"jsI2NACN˱3y'YZ.K0?kӼH*ze*Ɏ[~:7H3Ddٝj`zTsdc(s9wg޲NKR9ɨY$8| / h^qcv1#eQZ֌Ҋ)3l_8ᅝq^1$\s8MT^:kzD` \&O: ( OhzTdO4QAfہϥQV?http-streams-0.8.6.1/tests/example1.txt0000644000000000000000000000011412517347733016134 0ustar0000000000000000HTTP/1.1 200 OK Content-Type: text/plain Content-Length: 10 Hi there. http-streams-0.8.6.1/tests/example2.txt0000644000000000000000000000052312517347733016141 0ustar0000000000000000HTTP/1.1 200 OK Content-Type: text/html; charset=UTF-8 Server: Apache/2.2.22 Expires: Fri, 04 Jan 2013 06:48:57 GMT Date: Fri, 04 Jan 2013 06:48:56 GMT Content-Length: 133 Cache-Control: max-age=1 Hello

Hello!

Hello world. □

http-streams-0.8.6.1/tests/example3.txt0000644000000000000000000001110312517347733016136 0ustar0000000000000000HTTP/1.0 200 OK Connection: close Content-Type: text/plain JFIFC   %# , #&')*)-0-(0%()(C   (((((((((((((((((((((((((((((((((((((((((((((((((((" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ? Fw2znjG&Nx2HJj`o}_Ug׵'LV.-ݦu^/kQ2F4?*,x~ >/#4ϵ'q{dχzRgy`\gkQKL"vf3J|e)[˧C ƣ~ck}9vVhBL&Egse~H3'8 ֆ:\Qq0မS51Omͬs$ <|Džt{0#H1z}k׼? .њ7EPqNTNMI߉4 Qmpk#2zV ?Jw9-56N"3~yFZ\eAܠ=jDeLԃQ\P(;qJX"2:W.O)&2c'+)I)XP0OAӿ\p:SwP03Ih94̩o8wa9E C2J,rM\y҉>Ӎ鴓Qy'F`åDnef6,/|Xݰ[AV{ TKhQ]Pw8kGC8抴 +CX#֨ <⪙WZX鞵8R'%CcU/ʊdװvF39bUH]ܞgSS+0*) ArkBX! QRx8\;;D>9&+LY략hH s֧Tjh%~YTaXpGeYG"$*"Cd 1bwD12y2l =*̠ch'C"0zSNi d;umr)|.To-ArZc\A#Gwݹhƒ`zSI 3CɥUOMFVOQ5 :+2]YtZt}5V+Z(N:U3FTi ڊ)1=6M18wY>c\Mԓޒ"[bV'@=:ֵǖ`_Zӥt(0s[bVU=޳;oV>0&v ssZ &ާV>VUH_"S#z}+W'agd;9V'wV 6Pc?Mޗz=3ژ~PzSO 9CxѾ2'Q@I瓜ғ1Yh$@iGǭHGJ׽5rd*LZ͒sU淉2kS2O+ׂ<,p&mʱ'N؟8'q]|qE--T$*ںb:kcZhe2Y+W0˶zxJ/+Zju&T?#Pw>O֎dLt 0GLVխЂ)l W NKuZ"jsI2NACN˱3y'YZ.K0?kӼH*ze*Ɏ[~:7H3Ddٝj`zTsdc(s9wg޲NKR9ɨY$8| / h^qcv1#eQZ֌Ҋ)3l_8ᅝq^1$\s8MT^:kzD` \&O: ( OhzTdO4QAfہϥQV?http-streams-0.8.6.1/tests/example4.txt0000644000000000000000000000023412517347733016142 0ustar0000000000000000HTTP/1.1 200 OK Content-Type: text/plain Content-Length: 86 This is an HTTP response with a header that has trailing whitespace. Bad server, Bad! http-streams-0.8.6.1/tests/example5.txt0000644000000000000000000000007412517347733016145 0ustar0000000000000000HTTP/1.1 204 No Content Server: Ye Plain Olde Text File http-streams-0.8.6.1/tests/hello.txt0000644000000000000000000000001412517347733015522 0ustar0000000000000000Hello World http-streams-0.8.6.1/tests/hello.html0000644000000000000000000000014612517347733015655 0ustar0000000000000000 Hello

Hello!

Hello world.