http-common-0.8.2.0/0000755000000000000000000000000012517553574012330 5ustar0000000000000000http-common-0.8.2.0/LICENCE0000644000000000000000000000312012517553574013311 0ustar0000000000000000An HTTP client for use with io-streams Copyright © 2012-2014 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-common-0.8.2.0/http-common.cabal0000644000000000000000000000413312517553574015562 0ustar0000000000000000cabal-version: >= 1.10 name: http-common version: 0.8.2.0 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-2015 Operational Dynamics Consulting, Pty Ltd and Others category: Web tested-with: GHC == 7.8 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: lib 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: http-common-0.8.2.0/Setup.hs0000644000000000000000000000005612517553574013765 0ustar0000000000000000import Distribution.Simple main = defaultMain http-common-0.8.2.0/lib/0000755000000000000000000000000012517553574013076 5ustar0000000000000000http-common-0.8.2.0/lib/Network/0000755000000000000000000000000012517553574014527 5ustar0000000000000000http-common-0.8.2.0/lib/Network/Http/0000755000000000000000000000000012517553574015446 5ustar0000000000000000http-common-0.8.2.0/lib/Network/Http/Types.hs0000644000000000000000000000271512517553574017113 0ustar0000000000000000-- -- HTTP types for use with io-streams and pipes -- -- 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_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, buildRequest1, http, setHostname, setAccept, setAccept', setAuthorizationBasic, ContentType, setContentType, setContentLength, setExpectContinue, setTransferEncoding, 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 http-common-0.8.2.0/lib/Network/Http/RequestBuilder.hs0000644000000000000000000002336512517553574020752 0ustar0000000000000000-- -- HTTP types for use with io-streams and pipes -- -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd and Others -- -- 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, buildRequest1, http, setHostname, setAccept, setAccept', setAuthorizationBasic, ContentType, setContentType, setContentLength, setExpectContinue, setTransferEncoding, 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.Applicative 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 (Functor, Applicative, Monad, MonadState Request) -- -- | Run a RequestBuilder, yielding a Request object you can use on the -- given connection. -- -- > let q = buildRequest1 $ 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. -- buildRequest1 :: RequestBuilder α -> Request buildRequest1 mm = do let (RequestBuilder s) = (mm) let q = Request { qHost = Nothing, qMethod = GET, qPath = "/", qBody = Empty, qExpect = Normal, qHeaders = emptyHeaders } execState s q -- -- | Run a RequestBuilder from within a monadic action. -- -- Older versions of this library had 'buildRequest' in IO; there's -- no longer a need for that, but this code path will continue to -- work for existing users. -- -- > q <- buildRequest $ do -- > http GET "/" -- buildRequest :: Monad ν => RequestBuilder α -> ν Request buildRequest = return . buildRequest1 {-# INLINE buildRequest #-} -- -- | 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 PUT -> Chunking POST -> Chunking _ -> Empty 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 -- -- | Override the default setting about how the entity body will be sent. -- -- This function is special: this explicitly sets the @Transfer-Encoding:@ -- header to @chunked@ and will instruct the library to actually tranfer the -- body as a stream ("chunked transfer encoding"). See 'setContentLength' for -- forcing the opposite. You /really/ won't need this in normal operation, but -- some people are control freaks. -- setTransferEncoding :: RequestBuilder () setTransferEncoding = do deleteHeader "Content-Length" setEntityBody Chunking setHeader "Transfer-Encoding" "chunked" -- -- | 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 http-common-0.8.2.0/lib/Network/Http/Internal.hs0000644000000000000000000003175512517553574017571 0ustar0000000000000000-- -- HTTP types for use with io-streams and pipes -- -- 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 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 } deriving (Eq) instance Show Request where show q = {-# SCC "Request.show" #-} S.unpack $ S.filter (/= '\r') $ Builder.toByteString $ composeRequestBytes q "" data EntityBody = Empty | Chunking | Static Int64 deriving (Show, Eq, Ord) data ExpectMode = Normal | Continue deriving (Show, Eq, Ord) {- 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 = case qPath q of "" -> Builder.fromChar '/' path -> Builder.copyByteString path 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 } deriving (Eq) 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