diff --git a/http-streams.cabal b/http-streams.cabal --- a/http-streams.cabal +++ b/http-streams.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: http-streams -version: 0.6.0.2 +version: 0.6.1.0 synopsis: An HTTP client using io-streams description: /Overview/ @@ -42,7 +42,8 @@ transformers, network, text, - unordered-containers + unordered-containers, + aeson hs-source-dirs: src exposed-modules: Network.Http.Client @@ -76,12 +77,14 @@ HUnit, HsOpenSSL, MonadCatchIO-transformers, + aeson-pretty, attoparsec, base, blaze-builder, base64-bytestring, bytestring, case-insensitive, + ghc-prim, hspec, hspec-expectations, io-streams, @@ -94,7 +97,8 @@ system-fileio >= 0.3.10 && < 0.4, system-filepath >= 0.4.1 && < 0.5, text, - unordered-containers + unordered-containers, + aeson hs-source-dirs: src,tests main-is: Check.hs diff --git a/src/Network/Http/Client.hs b/src/Network/Http/Client.hs --- a/src/Network/Http/Client.hs +++ b/src/Network/Http/Client.hs @@ -12,82 +12,85 @@ {-# 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: - -> 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 - -\ q <- 'buildRequest' $ do -\ 'http' GET \"\/\" -\ 'setAccept' \"text/html\" - -\ 'sendRequest' c q 'emptyBody' - -\ `receiveResponse` c (\\p i -> do -\ x <- Streams.read i -\ S.putStr $ fromMaybe \"\" x) - -\ '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. --} - +-- | +-- 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 +-- +-- \ q <- 'buildRequest' $ 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, @@ -127,6 +130,7 @@ -- * Processing HTTP response receiveResponse, + receiveResponseRaw, StatusCode, getStatusCode, getStatusMessage, @@ -134,6 +138,7 @@ debugHandler, concatHandler, concatHandler', + jsonHandler, -- * Resource cleanup closeConnection, @@ -169,4 +174,3 @@ import Network.Http.Inconvenience import Network.Http.RequestBuilder import Network.Http.Types - diff --git a/src/Network/Http/Connection.hs b/src/Network/Http/Connection.hs --- a/src/Network/Http/Connection.hs +++ b/src/Network/Http/Connection.hs @@ -26,6 +26,7 @@ getHostname, sendRequest, receiveResponse, + receiveResponseRaw, emptyBody, fileBody, inputStreamBody, @@ -390,6 +391,32 @@ 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' diff --git a/src/Network/Http/Inconvenience.hs b/src/Network/Http/Inconvenience.hs --- a/src/Network/Http/Inconvenience.hs +++ b/src/Network/Http/Inconvenience.hs @@ -27,6 +27,7 @@ put, baselineContextSSL, concatHandler', + jsonHandler, -- for testing TooManyRedirects(..), @@ -38,6 +39,7 @@ 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 @@ -59,6 +61,7 @@ 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) import Network.Http.Connection @@ -505,4 +508,66 @@ 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 wich 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 diff --git a/src/Network/Http/ResponseParser.hs b/src/Network/Http/ResponseParser.hs --- a/src/Network/Http/ResponseParser.hs +++ b/src/Network/Http/ResponseParser.hs @@ -84,8 +84,11 @@ let nm = case lookupHeader h "Content-Length" of Just x' -> Just (readDecimal x' :: Int64) - Nothing -> Nothing - + Nothing -> case sc of + 204 -> Just 0 + 304 -> Just 0 + 100 -> Just 0 + _ -> Nothing return Response { pStatusCode = sc,