diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown deleted file mode 100644 --- a/CHANGELOG.markdown +++ /dev/null @@ -1,34 +0,0 @@ -* _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 diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,34 @@ +* _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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,5 +1,3 @@ -An HTTP client for use with io-streams - Copyright © 2012-2020 Athae Eredh Siniath and Others All rights reserved. diff --git a/README.markdown b/README.markdown deleted file mode 100644 --- a/README.markdown +++ /dev/null @@ -1,67 +0,0 @@ -An 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 - diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,67 @@ +An 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 web 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.md). + +AfC + diff --git a/http-streams.cabal b/http-streams.cabal --- a/http-streams.cabal +++ b/http-streams.cabal @@ -1,12 +1,10 @@ cabal-version: 1.24 name: http-streams -version: 0.8.7.2 +version: 0.8.8.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 + handle 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. . @@ -17,13 +15,13 @@ license-file: LICENSE author: Andrew Cowie maintainer: Andrew Cowie -copyright: © 2012-2020 Athae Eredh Siniath and Others +copyright: © 2012-2021 Athae Eredh Siniath and Others category: Web, IO-Streams -tested-with: GHC == 8.8.3 +tested-with: GHC == 8.10.4 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 +homepage: https://github.com/aesiniath/http-streams/ +bug-reports: https://github.com/aesiniath/http-streams/issues +extra-source-files: README.md CHANGELOG.md tests/MockServer.hs tests/TestSuite.hs tests/data-eu-gdp.json @@ -143,7 +141,7 @@ source-repository head type: git - location: git://github.com/afcowie/http-streams.git + location: git://github.com/aesiniath/http-streams.git -- vim: set tabstop=21 expandtab: diff --git a/lib/Network/Http/Client.hs b/lib/Network/Http/Client.hs --- a/lib/Network/Http/Client.hs +++ b/lib/Network/Http/Client.hs @@ -126,9 +126,11 @@ getHostname, sendRequest, emptyBody, + simpleBody, fileBody, inputStreamBody, encodedFormBody, + jsonBody, -- * Processing HTTP response receiveResponse, diff --git a/lib/Network/Http/Connection.hs b/lib/Network/Http/Connection.hs --- a/lib/Network/Http/Connection.hs +++ b/lib/Network/Http/Connection.hs @@ -33,6 +33,7 @@ unsafeReceiveResponse, UnexpectedCompression, emptyBody, + simpleBody, fileBody, inputStreamBody, debugHandler, @@ -189,7 +190,7 @@ } where hints = defaultHints { - addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV], + addrFlags = [AI_NUMERICSERV], addrSocketType = Stream } h2' = if p == 80 @@ -514,6 +515,16 @@ emptyBody :: OutputStream Builder -> IO () emptyBody _ = return () +{-| +Sometimes you just want to send some bytes to the server as a the body of your +request. This is easy to use, but if you're doing anything massive use +'inputStreamBody'; if you're sending a file use 'fileBody'; if you have an +object that needs to be sent as JSON use 'jsonBody' +-} +simpleBody :: ByteString -> OutputStream Builder -> IO () +simpleBody x' o = do + let b = Builder.fromByteString x' + Streams.write (Just b) o -- -- | Specify a local file to be sent to the server as the body of the @@ -536,7 +547,6 @@ 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 diff --git a/lib/Network/Http/Inconvenience.hs b/lib/Network/Http/Inconvenience.hs --- a/lib/Network/Http/Inconvenience.hs +++ b/lib/Network/Http/Inconvenience.hs @@ -28,6 +28,7 @@ put, baselineContextSSL, concatHandler', + jsonBody, jsonHandler, TooManyRedirects(..), HttpClientError(..), @@ -38,11 +39,11 @@ ) where import Blaze.ByteString.Builder (Builder) -import qualified Blaze.ByteString.Builder as Builder (fromByteString, +import qualified Blaze.ByteString.Builder as Builder (fromByteString, fromLazyByteString, 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.Aeson (FromJSON, ToJSON, Result (..), fromJSON, json', encode) import Data.Bits (Bits (..)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S @@ -60,7 +61,7 @@ import GHC.Word (Word8 (..)) import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseRelativeReference, - parseURI, escapeURIString, isUnescapedInURI, uriToString) + parseURI, escapeURIString, isAllowedInURI, uriToString) import OpenSSL (withOpenSSL) import OpenSSL.Session (SSLContext) import qualified OpenSSL.Session as SSL @@ -267,7 +268,7 @@ Just u -> u Nothing -> error ("Can't parse URI " ++ r) where - r = escapeURIString isUnescapedInURI $ T.unpack $ T.decodeUtf8 r' + r = escapeURIString isAllowedInURI $ T.unpack $ T.decodeUtf8 r' ------------------------------------------------------------------------------ @@ -562,6 +563,21 @@ 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've got an object of a type with a 'ToJSON' instance and you need to +send that object as JSON up to a web service API, this can help. + +You use this partially applied: + +> sendRequest c q (jsonBody thing) + +-} +jsonBody :: ToJSON a => a -> OutputStream Builder -> IO () +jsonBody thing o = do + let b = Builder.fromLazyByteString (encode thing) + Streams.write (Just b) o -- -- | If you're working with a data stream that is in @application/json@, diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -24,7 +24,7 @@ import Control.Exception (Exception, bracket, handleJust) import Control.Monad (forM_, guard) import Data.Aeson (FromJSON, ToJSON, Value (..), json, object, parseJSON, - toJSON, (.:), (.=)) + toJSON, (.:), (.=), encode) import Data.Aeson.Encode.Pretty import Data.Bits import qualified Data.HashMap.Strict as Map @@ -107,6 +107,7 @@ testGetRedirects testSplitURI testParseURL + testParseURLHasEscaped testGetLocalRedirects testGetFormatsRequest testExcessiveRedirects @@ -114,6 +115,8 @@ testEstablishConnection testParsingJson1 testParsingJson2 + testPostWithSimple + testPostWithJson describe "Corner cases in protocol compliance" $ do testSendBodyFor PUT @@ -608,6 +611,11 @@ assertEqual "Incorrect URL parsing" (URI "http:" (Just $ URIAuth "" "example.com" "") "/%CE%B1" "" "") url +testParseURLHasEscaped = + it "Parse URL with chars already encoded" $ do + let url = parseURL (Text.encodeUtf8 $ Text.pack "http://example.com/hello%20world") + assertEqual "Incorrect URL parsing" + (URI "http:" (Just $ URIAuth "" "example.com" "") "/hello%20world" "" "") url testGetFormatsRequest = it "GET includes a properly formatted request path" $ do @@ -726,3 +734,35 @@ ["label" .= l, "data" .= d] + +testPostWithSimple = + it "PUT with static data" $ do + let url = S.concat ["http://", localhost, "/resource/y98"] + + x' <- put url "text/plain" (simpleBody b') concatHandler + + assertEqual "Object was encoded to JSON as expected" + "Hello" + x' + where + b' :: ByteString + b' = S.pack "Hello" + +testPostWithJson = + it "PUT with json data" $ do + let url = S.concat ["http://", localhost, "/resource/y99"] + + x' <- put url "application/json" (jsonBody obj) concatHandler + + assertEqual "Object was encoded to JSON as expected" + "{\"data\":[[2000,1],[2020,0]],\"label\":\"Sealand\"}" + x' + where + obj :: GrossDomesticProduct + obj = GrossDomesticProduct { + gLabel = "Sealand", + gData = [(2000,1),(2020,0)] + } + + obj' :: ByteString + obj' = L.toStrict (encode obj)