http-io-streams 0.1.0.0 → 0.1.1.0

raw patch · 9 files changed

+251/−29 lines, 9 filesdep +brotli-streamsdep ~networkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: brotli-streams

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• http-common/lib/Network/Http/Internal.hs +22/−4
• http-common/lib/Network/Http/RequestBuilder.hs +4/−3
• http-common/lib/Network/Http/Types.hs +1/−0
• http-io-streams.cabal +11/−3
• http-streams/lib/Network/Http/Client.hs +11/−0
• http-streams/lib/Network/Http/Connection.hs +41/−4
• http-streams/lib/Network/Http/Inconvenience.hs +132/−2
• http-streams/lib/Network/Http/ResponseParser.hs +22/−13

@@ -1,3 +1,10 @@+### 0.1.1.0++* New alternative connection-setup API (`ConnectionAddress` et al.)+* New function `getHeaderMap` for exporting all response headers at once+* Add convenience functions `bytestringBody`, `lazyBytestringBody`, `utf8TextBody`, `utf8LazyTextBody`+* Add support for Brotli HTTP compression+ ## 0.1.0.0  * First version. Released on an unsuspecting world.

@@ -10,6 +10,7 @@ --  {-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings  #-} {-# OPTIONS_HADDOCK hide, prune #-}@@ -32,6 +33,7 @@     getStatusCode,     getStatusMessage,     getHeader,+    getHeaderMap,     Method(..),     Headers,     emptyHeaders,@@ -43,6 +45,8 @@     HttpType (getHeaders),     HttpParseException(..), +    hasBrotli,+     -- for testing     composeRequestBytes,     composeResponseBytes@@ -70,7 +74,7 @@  import Data.Int (Int64) import Data.List (foldl')-import Data.Monoid (mconcat, mempty)+import Data.Monoid as Mon (mconcat, mempty) import Data.Typeable (Typeable) import Data.Word (Word16) @@ -84,6 +88,14 @@  type Port = Word16 +{-# INLINE hasBrotli #-}+hasBrotli :: Bool+#if defined(MIN_VERSION_brotli_streams)+hasBrotli = True+#else+hasBrotli = False+#endif+ -- -- | HTTP Methods, as per RFC 2616 --@@ -178,7 +190,7 @@         headerFields,         crlf]   where-    requestline = mconcat+    requestline = Mon.mconcat        [method,         sp,         uri,@@ -250,7 +262,7 @@  data TransferEncoding = None | Chunked -data ContentEncoding = Identity | Gzip | Deflate+data ContentEncoding = Identity | Gzip | Deflate | Br {- Brotli -} | UnknownCE !ByteString     deriving (Show)  @@ -292,7 +304,13 @@   where     h = pHeaders p +-- | Expose all headers in the response as (case-insenstiive) key-value 'Map'ping. --+-- @since 0.1.1.0+getHeaderMap :: Response -> Map (CI ByteString) ByteString+getHeaderMap = unWrap . pHeaders++-- -- | Accessors common to both the outbound and return sides of an HTTP -- connection. --@@ -366,7 +384,7 @@     show x = S.unpack $ S.filter (/= '\r') $ Builder.toByteString $ joinHeaders $ unWrap x  joinHeaders :: Map (CI ByteString) ByteString -> Builder-joinHeaders m = Map.foldrWithKey combine mempty m+joinHeaders m = Map.foldrWithKey combine Mon.mempty m  combine :: CI ByteString -> ByteString -> Builder -> Builder combine k v acc =

@@ -43,7 +43,7 @@ import qualified Data.ByteString.Char8 as S import Data.Int (Int64) import Data.List (intersperse)-import Data.Monoid (mconcat)+import Data.Monoid as Mon (mconcat)  import Network.Http.Internal @@ -101,7 +101,8 @@ http m p' = do     q <- get     let h1 = qHeaders q-    let h2 = updateHeader h1 "Accept-Encoding" "gzip"+    let h2 = updateHeader h1 "Accept-Encoding" $ if hasBrotli then "br, gzip"+                                                              else "gzip"      let e  = case m of             PUT  -> Chunking@@ -135,7 +136,7 @@     v' :: ByteString     v' = if p == 80         then h'-        else Builder.toByteString $ mconcat+        else Builder.toByteString $ Mon.mconcat            [Builder.fromByteString h',             Builder.fromString ":",             Builder.fromShow p]

@@ -49,6 +49,7 @@     getStatusCode,     getStatusMessage,     getHeader,+    getHeaderMap,     Method(..),      -- * Headers

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                http-io-streams-version:             0.1.0.0+version:             0.1.1.0  synopsis:            HTTP client based on io-streams description:@@ -30,9 +30,14 @@   type:              git   location:          https://github.com/hvr/http-io-streams.git +flag brotli+  manual:  True+  default: True+  description: Build with support for <http://brotli.org Brotli> (<https://tools.ietf.org/html/rfc7932 RFC7932>) compression algorithm for <https://en.wikipedia.org/wiki/HTTP_compression HTTP compression>.+ common settings   build-depends:-    , base                 >= 4.5 && < 4.13+    , base                 >= 4.5 && < 4.14     , blaze-builder       ^>= 0.4.1.0     , bytestring          ^>= 0.10.0.0     , case-insensitive    ^>= 1.2.0.11@@ -51,13 +56,16 @@   import: settings    -- http-streams+  if flag(brotli)+    build-depends:+      brotli-streams      ^>= 0.0.0.0    build-depends:     , HsOpenSSL           ^>= 0.11.2     , attoparsec          ^>= 0.13.2.2     , directory           ^>= 1.2.0.1 || ^>= 1.3.0.0     , io-streams          ^>= 1.5.0.1-    , network             ^>= 2.6.0.0 || ^>= 2.7.0.0+    , network             ^>= 2.6.0.0 || ^>= 2.7.0.0 || ^>= 2.8.0.0 || ^>= 3.0.0.0 || ^>= 3.1.0.0     , network-uri         ^>= 2.6.0.0     , openssl-streams     ^>= 1.2.1.3     , text                ^>= 1.2.3.0

@@ -121,6 +121,10 @@     getHostname,     sendRequest,     emptyBody,+    bytestringBody,+    lazyBytestringBody,+    utf8TextBody,+    utf8LazyTextBody,     fileBody,     inputStreamBody,     encodedFormBody,@@ -133,6 +137,7 @@     getStatusCode,     getStatusMessage,     getHeader,+    getHeaderMap,     debugHandler,     concatHandler,     concatHandler',@@ -164,6 +169,12 @@     baselineContextSSL,     modifyContextSSL,     establishConnection,++    -- * Alternative 'ConnectionAddress' API+    ConnectionAddress(..),+    connectionAddressFromURI,+    connectionAddressFromURL,+    openConnectionAddress,      -- -- * Testing support     -- makeConnection,

@@ -32,17 +32,25 @@     UnexpectedCompression,     emptyBody,     fileBody,+    bytestringBody,+    lazyBytestringBody,+    utf8TextBody,+    utf8LazyTextBody,     inputStreamBody,     debugHandler,     concatHandler ) where  import Blaze.ByteString.Builder (Builder)-import qualified Blaze.ByteString.Builder as Builder (flush, fromByteString, toByteString)+import qualified Blaze.ByteString.Builder as Builder (flush, fromByteString, toByteString, fromLazyByteString)+import qualified Blaze.ByteString.Builder.Char.Utf8 as Builder (fromText, fromLazyText) import qualified Blaze.ByteString.Builder.HTTP as Builder (chunkedTransferEncoding, chunkedTransferTerminator) import Control.Exception (bracket) import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as S+import Data.Text (Text)+import qualified Data.Text.Lazy as TL (Text) import Network.Socket import OpenSSL (withOpenSSL) import OpenSSL.Session (SSL, SSLContext)@@ -277,13 +285,11 @@     o2 <- Streams.builderStream o1      return Connection {-        cHost  = path',+        cHost  = S.pack path,         cClose = close s,         cOut   = o2,         cIn    = i     }-  where-    path'  = S.pack path  -- -- | Having composed a 'Request' object with the headers and metadata for@@ -493,6 +499,37 @@ emptyBody :: OutputStream Builder -> IO () emptyBody _ = return () +-- | Convenience function for sending a strict 'ByteString' as the body of the request.+--+-- >     sendRequest c q (bytestringBody "PING")+--+-- @since 0.1.1.0+bytestringBody :: ByteString -> OutputStream Builder -> IO ()+bytestringBody bs = Streams.write (Just $! Builder.fromByteString bs)++-- | Convenience function for sending a lazy 'BL.ByteString' as the body of the request.+--+-- >     sendRequest c q (lazyBytestringBody "PING")+--+-- @since 0.1.1.0+lazyBytestringBody :: BL.ByteString -> OutputStream Builder -> IO ()+lazyBytestringBody bs = Streams.write (Just $ Builder.fromLazyByteString bs)++-- | Convenience function for sending a 'Text' value as the (UTF-8 encoded) body of the request.+--+-- >     sendRequest c q (utf8TextBody "PING")+--+-- @since 0.1.1.0+utf8TextBody :: Text -> OutputStream Builder -> IO ()+utf8TextBody t = Streams.write (Just $! Builder.fromText t)++-- | Convenience function for sending a lazy 'TL.Text' value as the (UTF-8 encoded) body of the request.+--+-- >     sendRequest c q (utf8LazyTextBody "PING")+--+-- @since 0.1.1.0+utf8LazyTextBody :: TL.Text -> OutputStream Builder -> IO ()+utf8LazyTextBody t = Streams.write (Just $ Builder.fromLazyText t)  -- -- | Specify a local file to be sent to the server as the body of the

@@ -2,6 +2,7 @@ -- HTTP client for use with io-streams -- -- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd+--           © 2018-2019 Herbert Valerio Riedel -- -- 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:@@ -30,6 +31,11 @@     TooManyRedirects(..),     HttpClientError(..), +    ConnectionAddress(..),+    connectionAddressFromURI,+    connectionAddressFromURL,+    openConnectionAddress,+         -- for testing     splitURI ) where@@ -39,11 +45,12 @@                                                       fromWord8, toByteString) import qualified Blaze.ByteString.Builder.Char8 as Builder (fromString) import Control.Exception (Exception, bracket, throw)+import Control.Monad (when, unless) 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.Char (intToDigit, toLower, digitToInt, isHexDigit) import Data.Set (Set) import qualified Data.Set as Set import Data.IORef (IORef, newIORef, readIORef, writeIORef)@@ -52,7 +59,7 @@ import qualified Data.Text.Encoding as T import Data.Typeable (Typeable) import Data.Word (Word16)-import GHC.Exts+import GHC.Exts (Int(..),word2Int#, uncheckedShiftRL#) import GHC.Word (Word8 (..)) import Network.URI (URI (..), URIAuth (..), isAbsoluteURI,                     parseRelativeReference, parseURI, uriToString)@@ -81,6 +88,16 @@  ------------------------------------------------------------------------------ +unescBytes :: [Char] -> ByteString+unescBytes = S.pack . go+  where+    go [] = []+    go ('%':h:l:rest)+      | isHexDigit h, isHexDigit l = toEnum b : go rest+      where+        b = (16 * digitToInt h) + digitToInt l+    go (c:rest) = c : go rest+ -- -- | URL-escapes a string (see -- <http://tools.ietf.org/html/rfc2396.html#section-2.4>)@@ -206,6 +223,119 @@     ports = case uriPort auth of         ""  -> 443         _   -> read $ tail $ uriPort auth :: Word16+++-- | HTTP connection target+--+-- See also 'connectionAddressFromURL' and 'connectionAddressFromURI'.+--+-- @since 0.1.1.0+data ConnectionAddress+  = ConnectionAddressHttp     !Hostname !Word16 -- ^ Represents @http:\/\/host:port@+  | ConnectionAddressHttps    !Hostname !Word16 -- ^ Represents @https:\/\/host:port@+  | ConnectionAddressHttpUnix !ByteString -- ^ Represents @http+unix:\/\/%2Fsome%2Fpath%2Fsocket@ or @unix:\/some\/path\/socket@ ('ByteString' denotes raw filepath and must be at most 104 bytes long)+  deriving Show++-- | Open a 'Connection' to the specified 'ConnectionAddress'+--+-- This is a simple wrapper over 'openConnection', 'openConnectionSSL', and 'openConnectionUnix'.+--+-- A subtle difference between @'openConnectionUnix' fp@ and @'openConnectionAddress' ('ConnectionAddressHttpUnix' fp)@ is that the latter sends an empty (but valid) @Host:@ HTTP header by default (unless overriden by 'setHostname'); moreover 'openConnectionUnix' only works with 'FilePath's containing only code-points within the ISO-8859-1 range.+--+-- This operation is often used in combination with 'withConnection'.+--+-- @since 0.1.1.0+openConnectionAddress :: ConnectionAddress -> IO Connection+openConnectionAddress ca = case ca of+  ConnectionAddressHttp  host port  -> openConnection host port+  ConnectionAddressHttps host ports -> do+    ctx <- readIORef global+    openConnectionSSL ctx host ports+  ConnectionAddressHttpUnix fp -> do+    c <- openConnectionUnix (S.unpack fp)+    return c { cHost = mempty } -- NB: HTTP RFC allows empty Host: headers++-- | Decode 'URL' into 'ConnectionAddress', user-info-part, (escaped) URL path, and optional fragment.+--+-- The 'URL' argument is expected to be properly escaped according to RFC 3986.+--+-- This is a wrapper over 'connectionAddressFromURI'+--+-- @since 0.1.1.0+connectionAddressFromURL :: URL -> Either String (ConnectionAddress, String, ByteString, String)+connectionAddressFromURL r' = do+  r <- either (\_ -> Left "invalid UTF-8 encoding") return (T.decodeUtf8' r')+  u <- maybe (Left "invalid URI syntax") return (parseURI (T.unpack r))+  connectionAddressFromURI u++-- | Decode 'URI' (from the @network-uri@ package) into 'ConnectionAddress', user-info part, (escaped) URL path, and optional fragment.+--+-- See also 'connectionAddressFromURL'+--+-- @since 0.1.1.0+connectionAddressFromURI :: URI -> Either String (ConnectionAddress, String, ByteString, String)+connectionAddressFromURI u = fmap addxinfo $+    case map toLower (uriScheme u) of+        "http:"      -> do+          _ <- getUrlPath+          return (ConnectionAddressHttp host (port 80), urlpath)+        "https:"     -> do+          _ <- getUrlPath+          return (ConnectionAddressHttps host (port 443), urlpath)+        "unix:" -> do+          noPort+          noHost+          when (null (uriPath u)) $+            Left "invalid empty path in unix: URI"+          unless (null (uriQuery u)) $+            Left "invalid query component in unix: URI"+          unless (null (uriFragment u)) $+            Left "invalid fragment component in unix: URI"+          let rfp = unescBytes (uriPath u)+          when (S.length rfp > 104) $+            Left "unix domain socket path must be at most 104 bytes long"+          when (S.elem '\x00' rfp) $+            Left "unix domain socket path must not contain NUL bytes"+          return (ConnectionAddressHttpUnix rfp, "")+        "http+unix:" -> do+          noPort+          fp <- getUnixPath+          return (ConnectionAddressHttpUnix fp, urlpath)+        _ -> Left ("Unknown URI scheme " ++ uriScheme u)+  where+    addxinfo (ca,p) = (ca, uriUserInfo auth, p, uriFragment u)++    auth = case uriAuthority u of+        Just x  -> x+        Nothing -> URIAuth "" "" ""++    noPort = if null (uriPort auth) then Right () else Left "invalid port number in URI"+    noHost = case uriAuthority u of+               Nothing -> return ()+               Just (URIAuth "" "" "") -> return ()+               Just _ -> Left "invalid host component in uri"++    getUrlPath = case uriRegName auth of+                   "" -> Left "missing/empty host component in uri"+                   p  -> Right p++    getUnixPath = case uriRegName auth of+                   "" -> Left "missing/empty host component in uri"+                   fp -> do+                     let rfp = unescBytes fp+                     when (S.length rfp > 104) $+                       Left "unix domain socket path must be at most 104 bytes long"+                     when (S.elem '\x00' rfp) $+                       Left "unix domain socket path must not contain NUL bytes"+                     Right rfp++    urlpath = S.pack (uriPath u ++ uriQuery u)++    host = S.pack (uriRegName auth)++    port def = case uriPort auth of+      ""  -> def+      _   -> read $ tail $ uriPort auth :: Word16   --

@@ -16,6 +16,7 @@ --  {-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings  #-} {-# OPTIONS_HADDOCK hide, not-home #-}@@ -50,6 +51,17 @@ import Network.Http.Internal import Network.Http.Utilities +#if defined(MIN_VERSION_brotli_streams)+import qualified System.IO.Streams.Brotli as Brotli++brotliDecompress :: InputStream ByteString -> IO (InputStream ByteString)+brotliDecompress = Brotli.decompress+#else+brotliDecompress :: InputStream ByteString -> IO (InputStream ByteString)+brotliDecompress _ = throwIO (UnexpectedCompression "br")+#endif++ {-     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@@ -79,9 +91,12 @@             Nothing -> None      let ce = case lookupHeader h "Content-Encoding" of-            Just x' -> if mk x' == "gzip"-                        then Gzip-                        else Identity+            Just x' -> case mk x' of+                         "gzip"     -> Gzip+                         "br"       -> Br+                         "deflate"  -> Deflate+                         "identity" -> Identity+                         _          -> UnknownCE x'             Nothing -> Identity      let nm = case lookupHeader h "Content-Length" of@@ -132,8 +147,10 @@      i3 <- case c of         Identity    -> App.pure i2-        Gzip        -> readCompressedBody i2-        Deflate     -> throwIO (UnexpectedCompression $ show c)+        Gzip        -> Streams.gunzip i2+        Br          -> brotliDecompress i2+        Deflate     -> throwIO (UnexpectedCompression "deflate")+        UnknownCE x -> throwIO (UnexpectedCompression (S.unpack x))      return i3   where@@ -267,11 +284,3 @@ 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