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.1.1 +version: 0.7.0.1 synopsis: An HTTP client using io-streams description: /Overview/ @@ -30,7 +30,9 @@ default-language: Haskell2010 build-depends: attoparsec, + http-common, base >= 4 && <5, + directory, base64-bytestring, blaze-builder, bytestring, @@ -47,9 +49,7 @@ hs-source-dirs: src exposed-modules: Network.Http.Client - other-modules: Network.Http.Types, - Network.Http.Connection, - Network.Http.RequestBuilder, + other-modules: Network.Http.Connection, Network.Http.ResponseParser, Network.Http.Utilities, Network.Http.Inconvenience @@ -74,12 +74,14 @@ default-language: Haskell2010 build-depends: + http-common, HUnit, HsOpenSSL, MonadCatchIO-transformers, aeson-pretty, attoparsec, base, + directory, blaze-builder, base64-bytestring, bytestring, @@ -101,7 +103,7 @@ aeson hs-source-dirs: src,tests - main-is: Check.hs + main-is: check.hs ghc-options: -O2 -threaded 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 @@ -120,7 +120,6 @@ -- * Sending HTTP request Request, Response, - Headers, getHostname, sendRequest, emptyBody, @@ -167,10 +166,16 @@ establishConnection, -- * Testing support - makeConnection + makeConnection, + Headers, + getHeaders, + getHeadersFull, + + -- * Deprecated + getRequestHeaders ) where +import Network.Http.Types + import Network.Http.Connection 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 @@ -14,8 +14,6 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Http.Connection ( - Hostname, - Port, Connection(..), -- constructors only for testing makeConnection, @@ -24,6 +22,8 @@ openConnectionSSL, closeConnection, getHostname, + getRequestHeaders, + getHeadersFull, sendRequest, receiveResponse, receiveResponseRaw, @@ -42,7 +42,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import Data.Monoid (mappend, mempty) -import Data.Word (Word16) import Network.Socket import OpenSSL.Session (SSL, SSLContext) import qualified OpenSSL.Session as SSL @@ -50,19 +49,10 @@ import qualified System.IO.Streams as Streams import qualified System.IO.Streams.SSL as Streams hiding (connect) +import Network.Http.Internal import Network.Http.ResponseParser -import Network.Http.Types -{- - 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 - +-- -- | A connection to a web server. -- data Connection @@ -355,6 +345,37 @@ Just h' -> h' Nothing -> cHost c + +{-# DEPRECATED getRequestHeaders "use retreiveHeaders . getHeadersFull instead" #-} +getRequestHeaders :: Connection -> Request -> [(ByteString, ByteString)] +getRequestHeaders c q = + ("Host", getHostname c q) : kvs + where + h = qHeaders q + kvs = retreiveHeaders h + +-- +-- | Get the headers that will be sent with this request. You likely won't +-- need this but there are some corner cases where people need to make +-- calculations based on all the headers before they go out over the wire. +-- +-- If you'd like the request headers as an association list, import the header +-- functions: +-- +-- > import Network.Http.Types +-- +-- then use 'Network.Http.Types.retreiveHeaders' as follows: +-- +-- >>> let kvs = retreiveHeaders $ getHeadersFull c q +-- >>> :t kvs +-- :: [(ByteString, ByteString)] +-- +getHeadersFull :: Connection -> Request -> Headers +getHeadersFull c q = + h' + where + h = qHeaders q + h' = updateHeader h "Host" (getHostname c q) -- -- | Handle the response coming back from the server. This function 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 @@ -34,6 +34,8 @@ HttpClientError(..) ) where +#include "config.h" + import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as Builder (fromByteString, fromWord8, toByteString) @@ -68,7 +70,9 @@ import Network.Http.RequestBuilder import Network.Http.Types -#include "config.h" +#if defined __LINUX__ +import System.Directory (doesDirectoryExist) +#endif type URL = ByteString @@ -225,9 +229,13 @@ #elif defined __WINDOWS__ SSL.contextSetVerificationMode ctx SSL.VerifyNone #else - SSL.contextSetCADirectory ctx "/etc/ssl/certs" - SSL.contextSetVerificationMode ctx $ - SSL.VerifyPeer True True Nothing + fedora <- doesDirectoryExist "/etc/pki/tls" + if fedora + then do + SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt" + else do + SSL.contextSetCADirectory ctx "/etc/ssl/certs" + SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing #endif return ctx diff --git a/src/Network/Http/RequestBuilder.hs b/src/Network/Http/RequestBuilder.hs deleted file mode 100644 --- a/src/Network/Http/RequestBuilder.hs +++ /dev/null @@ -1,300 +0,0 @@ --- --- HTTP client for use with io-streams --- --- 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 CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - -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.Connection -import Network.Http.Types - -#include "config.h" - --- --- | 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. --- --- /Note/ --- --- The API of this function changed from version 0.3.1 to verison 0.4.0; --- the original requirement to pass a Connection object has been removed, --- thereby allowing you to build your Request before opening the --- connection to the web server. --- -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 h0 = qHeaders q - let h1 = updateHeader h0 "User-Agent" VERSION - 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/ResponseParser.hs b/src/Network/Http/ResponseParser.hs --- a/src/Network/Http/ResponseParser.hs +++ b/src/Network/Http/ResponseParser.hs @@ -45,7 +45,7 @@ import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Attoparsec as Streams -import Network.Http.Types +import Network.Http.Internal import Network.Http.Utilities {- diff --git a/src/Network/Http/Types.hs b/src/Network/Http/Types.hs deleted file mode 100644 --- a/src/Network/Http/Types.hs +++ /dev/null @@ -1,387 +0,0 @@ --- --- HTTP client for use with io-streams --- --- 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 #-} - -module Network.Http.Types ( - Request(..), - EntityBody(..), - ExpectMode(..), - Response(..), - StatusCode, - TransferEncoding(..), - ContentEncoding(..), - getStatusCode, - getStatusMessage, - getHeader, - Method(..), - Headers, - emptyHeaders, - updateHeader, - removeHeader, - buildHeaders, - lookupHeader, - 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) -import Data.Int (Int64) -import Data.List (foldl') -import Data.Monoid (mconcat, mempty) -import Data.Typeable (Typeable) - --- | 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 @Host:@ header is not set until --- 'Network.Http.Connection.sendRequest' is called, 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 library when --- @http-streams@ 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 - - -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 - -removeHeader :: Headers -> ByteString -> Headers -removeHeader x k = - Wrap result - where - !result = delete (mk k) m - !m = unWrap x - - -{- - Given a list of key,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 - - -data HttpParseException = HttpParseException String - deriving (Typeable, Show) - -instance Exception HttpParseException diff --git a/tests/Check.hs b/tests/Check.hs deleted file mode 100644 --- a/tests/Check.hs +++ /dev/null @@ -1,25 +0,0 @@ --- --- HTTP client for use with io-streams --- --- 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 a BSD licence. --- - -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS -fno-warn-unused-imports #-} - -module Main where - -import OpenSSL (withOpenSSL) -import Test.Hspec (hspec) - -import MockServer (runMockServer) -import TestSuite (suite) - -main :: IO () -main = withOpenSSL $ do - runMockServer - hspec suite diff --git a/tests/check.hs b/tests/check.hs new file mode 100644 --- /dev/null +++ b/tests/check.hs @@ -0,0 +1,25 @@ +-- +-- HTTP client for use with io-streams +-- +-- 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 a BSD licence. +-- + +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-unused-imports #-} + +module Main where + +import OpenSSL (withOpenSSL) +import Test.Hspec (hspec) + +import MockServer (runMockServer) +import TestSuite (suite) + +main :: IO () +main = withOpenSSL $ do + runMockServer + hspec suite