diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,32 @@ +An HTTP client for use with io-streams + +Copyright © 2012 Operational Dynamics Consulting, Pty Ltd +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/http-common.cabal b/http-common.cabal new file mode 100644 --- /dev/null +++ b/http-common.cabal @@ -0,0 +1,66 @@ +cabal-version: >= 1.10 +name: http-common +version: 0.7.0.1 +synopsis: Common types for HTTP clients and servers +description: + /Overview/ + . + Base types used by a variety of HTTP clients and servers. See http-streams + "Network.Http.Client" or pipes-http "Pipes.Http.Client" for full + documentation. You can import @Network.Http.Types@ if you like, but both + http-streams and pipes-http re-export this package's types and functions. + +license: BSD3 +license-file: LICENCE +author: Andrew Cowie +maintainer: Andrew Cowie +copyright: © 2012-2013 Operational Dynamics Consulting, Pty Ltd and Others +category: Web +tested-with: GHC == 7.6 +stability: experimental +homepage: http://research.operationaldynamics.com/projects/http-streams/ +bug-reports: https://github.com/afcowie/http-common/issues + +build-type: Simple + +library + default-language: Haskell2010 + + build-depends: base >= 4 && <5, + directory, + base64-bytestring, + blaze-builder, + bytestring, + case-insensitive, + mtl, + transformers, + network, + text, + unordered-containers + + hs-source-dirs: src + exposed-modules: Network.Http.Types, + Network.Http.RequestBuilder, + Network.Http.Internal + other-modules: + + ghc-options: -O2 + -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: -prof -fprof-auto-top + + +source-repository head + type: git + location: git://github.com/afcowie/http-common.git + + +-- vim: set tabstop=21 expandtab: diff --git a/src/Network/Http/Internal.hs b/src/Network/Http/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Http/Internal.hs @@ -0,0 +1,454 @@ +-- +-- HTTP types for use with io-streams and pipes +-- +-- Copyright © 2012-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. +-- + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide, prune #-} + +-- +-- | If you're not http-streams or pipes-http and you're importing this, +-- you're Doing It Wrong. +-- + +module Network.Http.Internal ( + Hostname, + Port, + Request(..), + EntityBody(..), + ExpectMode(..), + Response(..), + StatusCode, + TransferEncoding(..), + ContentEncoding(..), + getStatusCode, + getStatusMessage, + getHeader, + Method(..), + Headers, + emptyHeaders, + updateHeader, + removeHeader, + buildHeaders, + lookupHeader, + retrieveHeaders, + HttpType (getHeaders), + HttpParseException(..), + + -- for testing + composeRequestBytes, + composeResponseBytes +) where + +import Prelude hiding (lookup) + +import Blaze.ByteString.Builder (Builder) +import qualified Blaze.ByteString.Builder as Builder (copyByteString, + copyByteString, + fromByteString, + fromByteString, + toByteString) +import qualified Blaze.ByteString.Builder.Char8 as Builder (fromChar, + fromShow, + fromString) +import Control.Exception (Exception) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S +import Data.CaseInsensitive (CI, mk, original) +import Data.HashMap.Strict (HashMap, delete, empty, foldrWithKey, insert, + insertWith, lookup, toList) +import Data.Int (Int64) +import Data.List (foldl') +import Data.Monoid (mconcat, mempty) +import Data.Typeable (Typeable) +import Data.Word (Word16) + +{- + This is a String because that's what the uri package works in. There + was a fairly detailed disucssion on haskell-cafe about this, with + the conclusion that URLs are composed of characters, not octets. +-} + +type Hostname = ByteString + +type Port = Word16 + +-- +-- | HTTP Methods, as per RFC 2616 +-- +data Method + = GET + | HEAD + | POST + | PUT + | DELETE + | TRACE + | OPTIONS + | CONNECT + | PATCH + | Method ByteString + deriving (Show, Read, Ord) + + +instance Eq Method where + GET == GET = True + HEAD == HEAD = True + POST == POST = True + PUT == PUT = True + DELETE == DELETE = True + TRACE == TRACE = True + OPTIONS == OPTIONS = True + CONNECT == CONNECT = True + PATCH == PATCH = True + GET == Method "GET" = True + HEAD == Method "HEAD" = True + POST == Method "POST" = True + PUT == Method "PUT" = True + DELETE == Method "DELETE" = True + TRACE == Method "TRACE" = True + OPTIONS == Method "OPTIONS" = True + CONNECT == Method "CONNECT" = True + PATCH == Method "PATCH" = True + Method a == Method b = a == b + m@(Method _) == other = other == m + _ == _ = False + +-- +-- | A description of the request that will be sent to the server. Note +-- unlike other HTTP libraries, the request body is /not/ a part of this +-- object; that will be streamed out by you when actually sending the +-- request with 'sendRequest'. +-- +-- 'Request' has a useful @Show@ instance that will output the request +-- line and headers (as it will be sent over the wire but with the @\\r@ +-- characters stripped) which can be handy for debugging. +-- +-- Note that the actual @Host:@ header is not set until the request is sent, +-- so you will not see it in the Show instance (unless you call 'setHostname' +-- to override the value inherited from the @Connection@). +-- +data Request + = Request { + qMethod :: !Method, + qHost :: !(Maybe ByteString), + qPath :: !ByteString, + qBody :: !EntityBody, + qExpect :: !ExpectMode, + qHeaders :: !Headers + } + +instance Show Request where + show q = {-# SCC "Request.show" #-} + S.unpack $ S.filter (/= '\r') $ Builder.toByteString $ composeRequestBytes q "" + + +data EntityBody = Empty | Chunking | Static Int64 + +data ExpectMode = Normal | Continue + +{- + The bit that builds up the actual string to be transmitted. This + is on the critical path for every request, so we'll want to revisit + this to improve performance. + + - Rewrite rule for Method? + - How can serializing the Headers be made efficient? + + This code includes the RFC compliant CR-LF sequences as line + terminators, which is why the Show instance above has to bother + with removing them. +-} + +composeRequestBytes :: Request -> ByteString -> Builder +composeRequestBytes q h' = + mconcat + [requestline, + hostLine, + headerFields, + crlf] + where + requestline = mconcat + [method, + sp, + uri, + sp, + version, + crlf] + + method = case qMethod q of + GET -> Builder.fromString "GET" + HEAD -> Builder.fromString "HEAD" + POST -> Builder.fromString "POST" + PUT -> Builder.fromString "PUT" + DELETE -> Builder.fromString "DELETE" + TRACE -> Builder.fromString "TRACE" + OPTIONS -> Builder.fromString "OPTIONS" + CONNECT -> Builder.fromString "CONNECT" + PATCH -> Builder.fromString "PATCH" + (Method x) -> Builder.fromByteString x + + uri = Builder.copyByteString $ qPath q + + version = Builder.fromString "HTTP/1.1" + + hostLine = mconcat + [Builder.fromString "Host: ", + hostname, + crlf] + + hostname = case qHost q of + Just x' -> Builder.copyByteString x' + Nothing -> Builder.copyByteString h' + + headerFields = joinHeaders $ unWrap $ qHeaders q + + +crlf = Builder.fromString "\r\n" + +sp = Builder.fromChar ' ' + + +type StatusCode = Int + +-- +-- | A description of the response received from the server. Note +-- unlike other HTTP libraries, the response body is /not/ a part +-- of this object; that will be streamed in by you when calling +-- 'receiveResponse'. +-- +-- Like 'Request', 'Response' has a @Show@ instance that will output +-- the status line and response headers as they were received from the +-- server. +-- +data Response + = Response { + pStatusCode :: !StatusCode, + pStatusMsg :: !ByteString, + pTransferEncoding :: !TransferEncoding, + pContentEncoding :: !ContentEncoding, + pContentLength :: !(Maybe Int64), + pHeaders :: !Headers + } + +instance Show Response where + show p = {-# SCC "Response.show" #-} + S.unpack $ S.filter (/= '\r') $ Builder.toByteString $ composeResponseBytes p + + +data TransferEncoding = None | Chunked + +data ContentEncoding = Identity | Gzip | Deflate + deriving (Show) + + +-- +-- | Get the HTTP response status code. +-- +getStatusCode :: Response -> StatusCode +getStatusCode = pStatusCode +{-# INLINE getStatusCode #-} + +-- +-- | Get the HTTP response status message. Keep in mind that this is +-- /not/ normative; whereas 'getStatusCode' values are authoritative. +-- +getStatusMessage :: Response -> ByteString +getStatusMessage = pStatusMsg +{-# INLINE getStatusMessage #-} + +-- +-- | Lookup a header in the response. HTTP header field names are +-- case-insensitive, so you can specify the name to lookup however you +-- like. If the header is not present @Nothing@ will be returned. +-- +-- > let n = case getHeader p "Content-Length" of +-- > Just x' -> read x' :: Int +-- > Nothing -> 0 +-- +-- which of course is essentially what goes on inside the client library when +-- it receives a response from the server and has to figure out how many bytes +-- to read. +-- +-- There is a fair bit of complexity in some of the other HTTP response +-- fields, so there are a number of specialized functions for reading +-- those values where we've found them useful. +-- +getHeader :: Response -> ByteString -> Maybe ByteString +getHeader p k = + lookupHeader h k + where + h = pHeaders p + +-- +-- | Accessors common to both the outbound and return sides of an HTTP +-- connection. +-- +class HttpType τ where + + -- + -- | Get the Headers from a Request or Response. Most people do not need + -- this; for most cases you just need to get a header or two from the + -- response, for which you can use 'getHeader'. On the other hand, if you + -- do need to poke around in the raw headers, + -- + -- @ import Network.Http.Types @ + -- + -- will give you functions like 'lookupHeader' and 'updateHeader' to to + -- work with. + -- + getHeaders :: τ -> Headers + +instance HttpType Request where + getHeaders q = qHeaders q + +instance HttpType Response where + getHeaders p = pHeaders p + + +composeResponseBytes :: Response -> Builder +composeResponseBytes p = + mconcat + [statusline, + headerFields, + crlf] + where + statusline = mconcat + [version, + sp, + code, + sp, + message, + crlf] + + code = Builder.fromShow $ pStatusCode p + + message = Builder.copyByteString $ pStatusMsg p + + version = Builder.fromString "HTTP/1.1" + + headerFields = joinHeaders $ unWrap $ pHeaders p + + +-- +-- | The map of headers in a 'Request' or 'Response'. Note that HTTP +-- header field names are case insensitive, so if you call 'setHeader' +-- on a field that's already defined but with a different capitalization +-- you will replace the existing value. +-- +{- + This is a fair bit of trouble just to avoid using a typedef here. + Probably worth it, though; every other HTTP client library out there + exposes the gory details of the underlying map implementation, and + to use it you need to figure out all kinds of crazy imports. Indeed, + this code used here in the Show instance for debugging has been + copied & pasted around various projects of mine since I started + writing Haskell. It's quite tedious, and very arcane! So, wrap it + up. +-} +newtype Headers = Wrap { + unWrap :: HashMap (CI ByteString) ByteString +} + +instance Show Headers where + show x = S.unpack $ S.filter (/= '\r') $ Builder.toByteString $ joinHeaders $ unWrap x + +joinHeaders :: HashMap (CI ByteString) ByteString -> Builder +joinHeaders m = foldrWithKey combine mempty m + +combine :: CI ByteString -> ByteString -> Builder -> Builder +combine k v acc = + mconcat [acc, key, Builder.fromString ": ", value, crlf] + where + key = Builder.copyByteString $ original k + value = Builder.fromByteString v +{-# INLINE combine #-} + +emptyHeaders :: Headers +emptyHeaders = + Wrap empty + +-- +-- | Set a header field to the specified value. This will overwrite +-- any existing value for the field. Remember that HTTP fields names +-- are case insensitive! +-- +updateHeader :: Headers -> ByteString -> ByteString -> Headers +updateHeader x k v = + Wrap result + where + !result = insert (mk k) v m + !m = unWrap x + +-- +-- | Remove a header from the map. If a field with that name is not present, +-- then this will have no effect. +-- +removeHeader :: Headers -> ByteString -> Headers +removeHeader x k = + Wrap result + where + !result = delete (mk k) m + !m = unWrap x + + +-- +-- | Given a list of field-name,field-value pairs, construct a Headers map. +-- +{- + This is only going to be used by RequestBuilder and ResponseParser, + obviously. And yes, as usual, we go to a lot of trouble to splice out the + function doing the work, in the name of type sanity. +-} +buildHeaders :: [(ByteString, ByteString)] -> Headers +buildHeaders hs = + Wrap result + where + result = foldl' addHeader empty hs + +{- + insertWith is used here for the case where a header is repeated + (for example, Set-Cookie) and the values need to be intercalated + with ',' as per RFC 2616 §4.2. +-} +addHeader + :: HashMap (CI ByteString) ByteString + -> (ByteString,ByteString) + -> HashMap (CI ByteString) ByteString +addHeader m (k,v) = + insertWith f (mk k) v m + where + f new old = S.concat [old, ",", new] + + +lookupHeader :: Headers -> ByteString -> Maybe ByteString +lookupHeader x k = + lookup (mk k) m + where + !m = unWrap x + + +-- +-- | Get the headers as a field-name,field-value association list. +-- +retrieveHeaders :: Headers -> [(ByteString, ByteString)] +retrieveHeaders x = + map down $ toList m + where + !m = unWrap x + +down :: (CI ByteString, ByteString) -> (ByteString, ByteString) +down (k, v) = + (original k, v) + +data HttpParseException = HttpParseException String + deriving (Typeable, Show) + +instance Exception HttpParseException diff --git a/src/Network/Http/RequestBuilder.hs b/src/Network/Http/RequestBuilder.hs new file mode 100644 --- /dev/null +++ b/src/Network/Http/RequestBuilder.hs @@ -0,0 +1,289 @@ +-- +-- HTTP types for use with io-streams and pipes +-- +-- Copyright © 2012-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. +-- + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} + +module Network.Http.RequestBuilder ( + RequestBuilder, + buildRequest, + http, + setHostname, + setAccept, + setAccept', + setAuthorizationBasic, + ContentType, + setContentType, + setContentLength, + setExpectContinue, + setHeader +) where + +import Blaze.ByteString.Builder (Builder) +import qualified Blaze.ByteString.Builder as Builder (fromByteString, + toByteString) +import qualified Blaze.ByteString.Builder.Char8 as Builder (fromShow, + fromString) +import Control.Monad.State +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as BS64 +import Data.ByteString.Char8 () +import qualified Data.ByteString.Char8 as S +import Data.Int (Int64) +import Data.List (intersperse) +import Data.Monoid (mconcat) + +import Network.Http.Internal + +-- +-- | The RequestBuilder monad allows you to abuse do-notation to +-- conveniently setup a 'Request' object. +-- +newtype RequestBuilder α = RequestBuilder (State Request α) + deriving (Monad, MonadState Request) + +-- +-- | Run a RequestBuilder, yielding a Request object you can use on the +-- given connection. +-- +-- > q <- buildRequest $ do +-- > http POST "/api/v1/messages" +-- > setContentType "application/json" +-- > setHostname "clue.example.com" 80 +-- > setAccept "text/html" +-- > setHeader "X-WhoDoneIt" "The Butler" +-- +-- Obviously it's up to you to later actually /send/ JSON data. +-- +buildRequest :: RequestBuilder α -> IO Request +buildRequest mm = do + let (RequestBuilder s) = (mm) + let q = Request { + qHost = Nothing, + qMethod = GET, + qPath = "/", + qBody = Empty, + qExpect = Normal, + qHeaders = emptyHeaders + } + return $ execState s q + + +-- +-- | Begin constructing a Request, starting with the request line. +-- +http :: Method -> ByteString -> RequestBuilder () +http m p' = do + q <- get + let h1 = qHeaders q + let h2 = updateHeader h1 "Accept-Encoding" "gzip" + + let e = case m of + GET -> Empty + TRACE -> Empty + _ -> Chunking + + let h3 = case e of + Chunking -> updateHeader h2 "Transfer-Encoding" "chunked" + _ -> h2 + + put q { + qMethod = m, + qPath = p', + qBody = e, + qHeaders = h3 + } + +-- +-- | Set the [virtual] hostname for the request. In ordinary conditions +-- you won't need to call this, as the @Host:@ header is a required +-- header in HTTP 1.1 and is set directly from the name of the server +-- you connected to when calling 'Network.Http.Connection.openConnection'. +-- +setHostname :: Hostname -> Port -> RequestBuilder () +setHostname h' p = do + q <- get + put q { + qHost = Just v' + } + where + v' :: ByteString + v' = if p == 80 + then h' + else Builder.toByteString $ mconcat + [Builder.fromByteString h', + Builder.fromString ":", + Builder.fromShow p] + +-- +-- | Set a generic header to be sent in the HTTP request. The other +-- methods in the RequestBuilder API are expressed in terms of this +-- function, but we recommend you use them where offered for their +-- stronger types. +-- +setHeader :: ByteString -> ByteString -> RequestBuilder () +setHeader k' v' = do + q <- get + let h0 = qHeaders q + let h1 = updateHeader h0 k' v' + put q { + qHeaders = h1 + } + +deleteHeader :: ByteString -> RequestBuilder () +deleteHeader k' = do + q <- get + let h0 = qHeaders q + let h1 = removeHeader h0 k' + put q { + qHeaders = h1 + } + +{-# INLINE setEntityBody #-} +setEntityBody :: EntityBody -> RequestBuilder () +setEntityBody e = do + q <- get + put q { + qBody = e + } + +{-# INLINE setExpectMode #-} +setExpectMode :: ExpectMode -> RequestBuilder () +setExpectMode e = do + q <- get + put q { + qExpect = e + } + +-- +-- | Indicate the content type you are willing to receive in a reply +-- from the server. For more complex @Accept:@ headers, use +-- 'setAccept''. +-- +setAccept :: ByteString -> RequestBuilder () +setAccept v' = do + setHeader "Accept" v' + +-- +-- | Indicate the content types you are willing to receive in a reply +-- from the server in order of preference. A call of the form: +-- +-- > setAccept' [("text/html", 1.0), +-- > ("application/xml", 0.8), +-- > ("*/*", 0)] +-- +-- will result in an @Accept:@ header value of +-- @text\/html; q=1.0, application\/xml; q=0.8, \*\/\*; q=0.0@ as you +-- would expect. +-- +setAccept' :: [(ByteString,Float)] -> RequestBuilder () +setAccept' tqs = do + setHeader "Accept" v' + where + v' = Builder.toByteString v + v = mconcat $ intersperse (Builder.fromString ", ") $ map format tqs + + format :: (ByteString,Float) -> Builder + format (t',q) = + mconcat + [Builder.fromByteString t', + Builder.fromString "; q=", + Builder.fromShow q] + + +-- +-- | Set username and password credentials per the HTTP basic +-- authentication method. +-- +-- > setAuthorizationBasic "Aladdin" "open sesame" +-- +-- will result in an @Authorization:@ header value of +-- @Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==@. +-- +-- Basic authentication does /not/ use a message digest function to +-- encipher the password; the above string is only base-64 encoded and +-- is thus plain-text visible to any observer on the wire and all +-- caches and servers at the other end, making basic authentication +-- completely insecure. A number of web services, however, use SSL to +-- encrypt the connection that then use HTTP basic authentication to +-- validate requests. Keep in mind in these cases the secret is still +-- sent to the servers on the other side and passes in clear through +-- all layers after the SSL termination. Do /not/ use basic +-- authentication to protect secure or user-originated privacy-sensitve +-- information. +-- +{- + This would be better using Builder, right? +-} +setAuthorizationBasic :: ByteString -> ByteString -> RequestBuilder () +setAuthorizationBasic user' passwd' = do + setHeader "Authorization" v' + where + v' = S.concat ["Basic ", msg'] + msg' = BS64.encode str' + str' = S.concat [user', ":", passwd'] + + +type ContentType = ByteString + + +-- +-- | Set the MIME type corresponding to the body of the request you are +-- sending. Defaults to @\"text\/plain\"@, so usually you need to set +-- this if 'PUT'ting. +-- +setContentType :: ContentType -> RequestBuilder () +setContentType v' = do + setHeader "Content-Type" v' + +-- +-- | Specify the length of the request body, in bytes. +-- +-- RFC 2616 requires that we either send a @Content-Length@ header or +-- use @Transfer-Encoding: chunked@. If you know the exact size ahead +-- of time, then call this function; the body content will still be +-- streamed out by @io-streams@ in more-or-less constant space. +-- +-- This function is special: in a PUT or POST request, @http-streams@ +-- will assume chunked transfer-encoding /unless/ you specify a content +-- length here, in which case you need to ensure your body function +-- writes precisely that many bytes. +-- +-- +setContentLength :: Int64 -> RequestBuilder () +setContentLength n = do + deleteHeader "Transfer-Encoding" + setHeader "Content-Length" (S.pack $ show n) + setEntityBody $ Static n + +-- +-- | Specify that this request should set the expectation that the +-- server needs to approve the request before you send it. +-- +-- This function is special: in a PUT or POST request, @http-streams@ +-- will wait for the server to reply with an HTTP/1.1 100 Continue +-- status before sending the entity body. This is handled internally; +-- you will get the real response (be it successful 2xx, client error, +-- 4xx, or server error 5xx) in 'receiveResponse'. In theory, it +-- should be 417 if the expectation failed. +-- +-- Only bother with this if you know the service you're talking to +-- requires clients to send an @Expect: 100-continue@ header and will +-- handle it properly. Most servers don't do any precondition checking, +-- automatically send an intermediate 100 response, and then just read +-- the body regardless, making this a bit of a no-op in most cases. +-- +setExpectContinue :: RequestBuilder () +setExpectContinue = do + setHeader "Expect" "100-continue" + setExpectMode Continue + diff --git a/src/Network/Http/Types.hs b/src/Network/Http/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Http/Types.hs @@ -0,0 +1,68 @@ +-- +-- HTTP types for use with io-streams and pipes +-- +-- Copyright © 2012-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. +-- + +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- +-- | Basic types used in HTTP communications. This modules is re-exported by +-- both "Network.Http.Client" and "Pipes.Http.Client", so if you're using +-- either of those you don't need to explicitly import this module. +-- + +module Network.Http.Types ( + -- * Requests + Hostname, + Port, + Request, + EntityBody(..), + ExpectMode(..), + + RequestBuilder, + buildRequest, + http, + setHostname, + setAccept, + setAccept', + setAuthorizationBasic, + ContentType, + setContentType, + setContentLength, + setExpectContinue, + setHeader, + + -- * Responses + Response, + StatusCode, + TransferEncoding(..), + ContentEncoding(..), + getStatusCode, + getStatusMessage, + getHeader, + Method(..), + + -- * Headers + Headers, + emptyHeaders, + updateHeader, + removeHeader, + buildHeaders, + lookupHeader, + retrieveHeaders, + HttpType (getHeaders), + + -- * Exceptions + HttpParseException(..) + +) where + +import Network.Http.Internal +import Network.Http.RequestBuilder