HTTP 4000.0.5 → 4000.0.6

raw patch · 7 files changed

+256/−219 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES +11/−0
• HTTP.cabal +1/−1
• Network/Browser.hs +124/−121
• Network/BufferType.hs +31/−8
• Network/HTTP/Base.hs +2/−2
• Network/HTTP/Headers.hs +74/−76
• Network/TCP.hs +13/−11

@@ -1,3 +1,14 @@+Version 4004.0.6: release 2009-04-21; changes from 4004.0.5++ * Patch release.+ * Network.Browser: use HTTP.HandleStream.sendHTTP_notify, not HTTP.sendHTTP_notify+   when issuing requests. The latter runs the risk of undoing request normalization.+ * Network.HTTP.Base.normalizeRequest: when normalizing proxy-bound requests,+   insert a Host: header if none present. Set it to the destination server authority,+   not the proxy.+ * Network.Browser: don't fail on seeing invalid cookie values, but report them+   as errors and continue.+ Version 4004.0.5: release 2009-03-30; changes from 4004.0.4   * Get serious about comments and Haddock documentation.

@@ -1,5 +1,5 @@ Name: HTTP-Version: 4000.0.5+Version: 4000.0.6 Cabal-Version: >= 1.2 Build-type: Simple License: BSD3

@@ -112,7 +112,8 @@    , parseURI, parseURIReference, relativeTo    ) import Network.StreamDebugger (debugByteStream)-import Network.HTTP+import Network.HTTP hiding ( sendHTTP_notify )+import Network.HTTP.HandleStream ( sendHTTP_notify ) import qualified Network.HTTP.MD5 as MD5 (hash) import qualified Network.HTTP.Base64 as Base64 (encode) import Network.Stream ( ConnError(..), Result )@@ -168,7 +169,7 @@ -- user if he/she is willing to accept an incoming cookie before -- adding it to the store. userCookieFilter :: URI -> Cookie -> IO Bool-userCookieFilter url cky =+userCookieFilter url cky = do     do putStrLn ("Set-Cookie received when requesting: " ++ show url)        case ckComment cky of           Nothing -> return ()@@ -198,64 +199,9 @@              ++ ";$Domain=" ++ ckDomain ck  -{- replace "error" call with [] in final version? -}-headerToCookies :: String -> Header -> [Cookie]-headerToCookies dom (Header HdrSetCookie val) = -    case parse cookies "" val of-        Left e  -> error ("Cookie parse failure on: " ++ val ++ " " ++ show e) -        Right x -> x-    where-        cookies :: Parser [Cookie]-        cookies = sepBy1 cookie (char ',')--        cookie :: Parser Cookie-        cookie =-            do { name <- word-               ; spaces_l-               ; char '='-               ; spaces_l-               ; val1 <- cvalue-               ; args <- cdetail-               ; return $ mkCookie name val1 args-               }--        cvalue :: Parser String-        -        spaces_l = many (satisfy isSpace)--        cvalue = quotedstring <|> many1 (satisfy $ not . (==';')) <|> return ""-       -        -- all keys in the result list MUST be in lower case-        cdetail :: Parser [(String,String)]-        cdetail = many $-            try (do { spaces_l-               ; char ';'-               ; spaces_l-               ; s1 <- word-               ; spaces_l-               ; s2 <- option "" (do { char '=' ; spaces_l ; v <- cvalue ; return v })-               ; return (map toLower s1,s2)-               })--        mkCookie :: String -> String -> [(String,String)] -> Cookie-        mkCookie nm cval more = -	  MkCookie { ckName    = nm-                   , ckValue   = cval-                   , ckDomain  = map toLower (fromMaybe dom (lookup "domain" more))-                   , ckPath    = lookup "path" more-                   , ckVersion = lookup "version" more-                   , ckComment = lookup "comment" more-                   }--headerToCookies _ _ = []--      - -- | @addCookie c@ adds a cookie to the browser state, removing duplicates. addCookie :: Cookie -> BrowserAction t ()-addCookie c = alterBS (\b -> b { bsCookies=c : fn (bsCookies b) })-    where-        fn = filter (not . (==c))+addCookie c = alterBS (\b -> b{bsCookies = c : filter (/=c) (bsCookies b) })  -- | @setCookies cookies@ replaces the set of cookies known to -- the browser to @cookies@. Useful when wanting to restore cookies@@ -570,7 +516,7 @@ withAuthority a rq = case a of         AuthBasic{}  -> "Basic " ++ base64encode (auUsername a ++ ':' : auPassword a)         AuthDigest{} ->-            "Digest username=\"" ++ auUsername a -- "+            "Digest username=\"" ++ auUsername a                ++ "\",realm=\"" ++ auRealm a               ++ "\",nonce=\"" ++ auNonce a               ++ "\",uri=\"" ++ digesturi@@ -720,11 +666,14 @@ withBrowserState :: BrowserState t -> BrowserAction t a -> BrowserAction t a withBrowserState bs act = BA $ \ _ -> lift act bs -newRequest :: BrowserAction t a -> BrowserAction t a-newRequest act = do+-- | @nextRequest act@ performs the browser action @act@ as+-- the next request, i.e., setting up a new request context+-- before doing so.+nextRequest :: BrowserAction t a -> BrowserAction t a+nextRequest act = do   let updReqID st =         let -        rid = 1 + bsRequestID st+        rid = succ (bsRequestID st)        in        rid `seq` st{bsRequestID=rid}   alterBS updReqID@@ -888,7 +837,7 @@ request :: HStream ty         => Request ty 	-> BrowserAction (HandleStream ty) (URI,Response ty)-request req = newRequest $ do+request req = nextRequest $ do                  res <- request' nullVal initialState req 		 reportEvent ResponseFinish (show (rqURI req)) 		 case res of@@ -901,7 +850,8 @@    initialState = nullRequestState    nullVal      = buf_empty bufferOps --- | Internal helper function, carrying along per-request counts.+-- | Internal helper function, explicitly carrying along per-request +-- counts. request' :: HStream ty          => ty 	 -> RequestState@@ -918,8 +868,7 @@      xs -> case break (==':') xs of { (as,_:bs) -> withAuth AuthBasic{auUsername=as,auPassword=bs,auRealm="/",auSite=uri} ; _ -> id}) $ do -}    when (not $ null cookies) -        (out $ "Adding cookies to request.  Cookie names: "  ++-               foldl spaceappend "" (map ckName cookies))+        (out $ "Adding cookies to request.  Cookie names: "  ++ unwords (map ckName cookies))     -- add credentials to request    rq' <-      if not (reqStopOnDeny rqState) @@ -969,7 +918,7 @@                       (parseURI str)            out $ "proxy uri host: " ++ uriRegName proxyURIAuth ++ ", port: " ++ uriPort proxyURIAuth-          dorequest proxyURIAuth final_req+	  dorequest proxyURIAuth final_req    mbMx <- getMaxErrorRetries    case e_rsp of     Left v @@ -981,19 +930,8 @@     Right rsp -> do       out ("Received:\n" ++ show rsp)       -- add new cookies to browser state-     let cookieheaders = retrieveHeaders HdrSetCookie rsp-     let newcookies = concat (map (headerToCookies $ uriAuthToString $ reqURIAuth rq) cookieheaders)--     when (not $ null newcookies)-          (out $ foldl (\x y -> x ++ "\n  " ++ show y) "Cookies received:" newcookies)-               -     filterfn    <- getCookieFilter-     newcookies' <- ioAction (filterM (filterfn uri) newcookies)-     mapM_ addCookie newcookies'--     when (not $ null newcookies)-          (out $ "Accepting cookies with names: " ++ foldl spaceappend "" (map ckName newcookies'))-       +     handleCookies uri (uriAuthToString $ reqURIAuth rq) +                       (retrieveHeaders HdrSetCookie rsp)      mbMxAuths <- getMaxAuthAttempts      case rspCode rsp of       (4,0,1) -- Credentials not sent or refused.@@ -1092,7 +1030,7 @@ 				     , reqStopOnDeny = True 				     } 				     rq-      (3,_,_) ->  redirect uri rsp+      (3,_,_) -> redirect uri rsp       _       -> return (Right (uri,rsp))     where      @@ -1121,52 +1059,50 @@                 err ("Parse of Location header in a redirect response failed: " ++ u)                 return (Right (uri,rsp)) -spaceappend :: String -> String -> String-spaceappend x y = x ++ ' ' : y- -- | The internal request handling state machine. dorequest :: (HStream ty)           => URIAuth 	  -> Request ty 	  -> BrowserAction (HandleStream ty) 	                   (Result (Response ty))-dorequest hst rqst = -            do { pool <- getBS bsConnectionPool-               ; conn <- ioAction $ filterM (\c -> c `isTCPConnectedTo` uriAuthToString hst) pool-               ; rsp <- case conn of-                    [] -> do { out ("Creating new connection to " ++ uriAuthToString hst)-                             ; let uPort = uriAuthPort Nothing{-ToDo: feed in complete URL-} hst-		             ; reportEvent OpenConnection (show (rqURI rqst))-                             ; c <- ioAction $ openStream (uriRegName hst) uPort-			     ; updateConnectionPool c-			     ; dorequest2 c rqst-                             }-                    (c:_) ->-                        do { out ("Recovering connection to " ++ uriAuthToString hst)-			   ; reportEvent ReuseConnection (show (rqURI rqst))-                           ; dorequest2 c rqst-                           }-	       ; case rsp of { Right (Response a b c _) -> reportEvent (ResponseEnd (a,b,c)) (show (rqURI rqst)) ; _ -> return ()}-               ; return rsp-               }-  where-   dorequest2 c r = do-     dbg <- getBS bsDebug-     st  <- getBrowserState-     onSendComplete <- -        case bsEvent st of-	  Nothing  -> return (return ())-	  Just evh -> return $ do-	               x <- buildBrowserEvent RequestSent (show (rqURI r)) (bsRequestID st)-		       (lift (evh x)) st-		       return ()-     ioAction $ -       case dbg of-         Nothing -> sendHTTP_notify c r onSendComplete-         Just f  -> do-	   c' <- debugByteStream (f++'-': uriAuthToString hst) c-	   sendHTTP_notify c' r onSendComplete-+dorequest hst rqst = do+  pool <- getBS bsConnectionPool+  conn <- ioAction $ filterM (\c -> c `isTCPConnectedTo` uriAuthToString hst) pool+  rsp <- +    case conn of+      [] -> do +        out ("Creating new connection to " ++ uriAuthToString hst)+        let uPort = uriAuthPort Nothing{-ToDo: feed in complete URL-} hst+	reportEvent OpenConnection (show (rqURI rqst))+        c <- ioAction $ openStream (uriRegName hst) uPort+	updateConnectionPool c+	dorequest2 c rqst+      (c:_) -> do+        out ("Recovering connection to " ++ uriAuthToString hst)+	reportEvent ReuseConnection (show (rqURI rqst))+        dorequest2 c rqst+  case rsp of +     Right (Response a b c _) -> +         reportEvent (ResponseEnd (a,b,c)) (show (rqURI rqst)) ; _ -> return ()+  return rsp+ where+  dorequest2 c r = do+    dbg <- getBS bsDebug+    st  <- getBrowserState+    let +     onSendComplete =+       maybe (return ())+             (\evh -> do+	        x <- buildBrowserEvent RequestSent (show (rqURI r)) (bsRequestID st)+		(lift (evh x)) st+		return ())+             (bsEvent st)+    ioAction $ +      maybe (sendHTTP_notify c r onSendComplete)+            (\ f -> do+               c' <- debugByteStream (f++'-': uriAuthToString hst) c+	       sendHTTP_notify c' r onSendComplete)+	    dbg  updateConnectionPool :: HStream hTy                      => HandleStream hTy@@ -1208,6 +1144,73 @@                         , rqURI=u                         }         _ -> error ("unexpected request: " ++ show m)+++handleCookies :: URI -> String -> [Header] -> BrowserAction t ()+handleCookies _   _              [] = return () -- cut short the silliness.+handleCookies uri dom cookieHeaders = do+  when (not $ null errs)+       (err $ unlines ("Errors parsing these cookie values: ":errs))+  when (not $ null newCookies)+       (out $ foldl (\x y -> x ++ "\n  " ++ show y) "Cookies received:" newCookies)+  filterfn    <- getCookieFilter+  newCookies' <- ioAction (filterM (filterfn uri) newCookies)+  when (not $ null newCookies')+       (out $ "Accepting cookies with names: " ++ unwords (map ckName newCookies'))+  mapM_ addCookie newCookies'+ where+  (errs, newCookies) = foldr (headerToCookies dom) ([],[]) cookieHeaders++headerToCookies :: String -> Header -> ([String], [Cookie]) -> ([String], [Cookie])+headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) = +    case parse cookies "" val of+        Left e  -> (val:accErr, accCookie)+        Right x -> (accErr, x ++ accCookie)+  where+   cookies :: Parser [Cookie]+   cookies = sepBy1 cookie (char ',')++   cookie :: Parser Cookie+   cookie =+       do { name <- word+          ; spaces_l+          ; char '='+          ; spaces_l+          ; val1 <- cvalue+          ; args <- cdetail+          ; return $ mkCookie name val1 args+          }++   cvalue :: Parser String+   +   spaces_l = many (satisfy isSpace)++   cvalue = quotedstring <|> many1 (satisfy $ not . (==';')) <|> return ""+   +   -- all keys in the result list MUST be in lower case+   cdetail :: Parser [(String,String)]+   cdetail = many $+       try (do { spaces_l+          ; char ';'+          ; spaces_l+          ; s1 <- word+          ; spaces_l+          ; s2 <- option "" (do { char '=' ; spaces_l ; v <- cvalue ; return v })+          ; return (map toLower s1,s2)+          })++   mkCookie :: String -> String -> [(String,String)] -> Cookie+   mkCookie nm cval more = +	  MkCookie { ckName    = nm+                   , ckValue   = cval+                   , ckDomain  = map toLower (fromMaybe dom (lookup "domain" more))+                   , ckPath    = lookup "path" more+                   , ckVersion = lookup "version" more+                   , ckComment = lookup "comment" more+                   }+headerToCookies _ _ acc = acc++         ------------------------------------------------------------------

@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Network.BufferType+-- Description :  Abstract representation of request and response buffer types. -- Copyright   :  (c) Warrick Gray 2002, Bjorn Bringert 2003-2004, Simon Foster 2004, 2007 Robin Bate Boerop, 2008 Sigbjorn Finne -- License     :  BSD --@@ -9,7 +10,14 @@ -- Stability   :  experimental -- Portability :  non-portable (not tested) ----- Operations over wire-transmitted values.+-- In order to give the user freedom in how request and response content+-- is represented, a sufficiently abstract representation is needed of+-- these internally. The "Network.BufferType" module provides this, defining+-- the 'BufferType' class and its ad-hoc representation of buffer operations+-- via the 'BufferOp' record.+--+-- This module provides definitions for the standard buffer types that the+-- package supports, i.e., for @String@ and @ByteString@ (strict and lazy.) --  ----------------------------------------------------------------------------- module Network.BufferType@@ -35,7 +43,7 @@ -- | The @BufferType@ class encodes, in a mixed-mode way, the interface -- that the library requires to operate over data embedded in HTTP -- requests and responses. That is, we use explicit dictionaries--- for the operations, but overload the name of these dicts.+-- for the operations, but overload the name of the dicts themselves. --  class BufferType bufType where    bufferOps :: BufferOp bufType@@ -49,9 +57,17 @@ instance BufferType String where    bufferOps = stringBufferOp --- Encode the I/O operations of the underlying buffer over a Handle --- in an (explicit) dictionary type. May not be needed, but gives+-- | @BufferOp@ encodes the I/O operations of the underlying buffer over +-- a Handle in an (explicit) dictionary type. May not be needed, but gives -- us flexibility in explicit overriding and wrapping up of these methods.+--+-- Along with IO operations is an ad-hoc collection of functions for working+-- with these abstract buffers, as needed by the internals of the code+-- that processes requests and responses.+--+-- We supply three default @BufferOp@ values, for @String@ along with the+-- strict and lazy versions of @ByteString@. To add others, provide @BufferOp@+-- definitions for  data BufferOp a  = BufferOp      { buf_hGet         :: Handle -> Int -> IO a@@ -73,6 +89,8 @@ instance Eq (BufferOp a) where   _ == _ = False +-- | @strictBufferOp@ is the 'BufferOp' definition over @ByteString@s,+-- the non-lazy kind. strictBufferOp :: BufferOp Strict.ByteString strictBufferOp =      BufferOp @@ -94,6 +112,8 @@    where     p_crlf = Strict.pack crlf +-- | @lazyBufferOp@ is the 'BufferOp' definition over @ByteString@s,+-- the non-strict kind. lazyBufferOp :: BufferOp Lazy.ByteString lazyBufferOp =      BufferOp @@ -115,12 +135,15 @@    where     p_crlf = Lazy.pack crlf +-- | @stringBufferOp@ is the 'BufferOp' definition over @String@s.+-- It is defined in terms of @strictBufferOp@ operations,+-- unpacking/converting to @String@ when needed. stringBufferOp :: BufferOp String stringBufferOp =BufferOp -      { buf_hGet         = \ h n -> Strict.hGet h n >>= return . Strict.unpack-      , buf_hGetContents = \ h -> Strict.hGetContents h >>= return . Strict.unpack-      , buf_hPut         = \ h s -> Strict.hPut h (Strict.pack s)-      , buf_hGetLine     = \ h   -> Strict.hGetLine h >>= return . Strict.unpack+      { buf_hGet         = \ h n -> buf_hGet strictBufferOp h n >>= return . Strict.unpack+      , buf_hGetContents = \ h -> buf_hGetContents strictBufferOp h >>= return . Strict.unpack+      , buf_hPut         = \ h s -> buf_hPut strictBufferOp h (Strict.pack s)+      , buf_hGetLine     = \ h   -> buf_hGetLine strictBufferOp h >>= return . Strict.unpack       , buf_append       = (++)       , buf_concat       = concat       , buf_fromStr      = id

@@ -705,8 +705,8 @@ 	   Nothing -> req -- no host/authority in sight..not much we can do...complain? 	   Just{}  -> req     (h,uri_abs) -      | forProxy  -> req -- Note: _not_ stubbing out user:pass-      | otherwise -> replaceHeader HdrHost h req{rqURI=uri_abs}+      | forProxy  -> insertHeaderIfMissing HdrHost h req +      | otherwise -> replaceHeader HdrHost h req{rqURI=uri_abs} -- Note: _not_ stubbing out user:pass  where    uri0     = rqURI req       -- stub out the user:pass 

@@ -8,56 +8,35 @@ -- Stability   :  experimental -- Portability :  non-portable (not tested) ----- * Changes by Robin Bate Boerop <robin@bateboerop.name>:---      - Made dependencies explicit in import statements.---      - Removed false dependencies in import statements.---      - Added missing type signatures.---      - Created Network.HTTP.Headers from Network.HTTP modules.------ See changes history and TODO list in Network.HTTP module.------ * Header notes:------     [@Host@]---                  Required by HTTP\/1.1, if not supplied as part---                  of a request a default Host value is extracted---                  from the request-uri.--- ---     [@Connection@] ---                  If this header is present in any request or---                  response, and it's value is "close", then---                  the current request\/response is the last ---                  to be allowed on that connection.+-- This module provides the data types for representing HTTP headers, and+-- operations for looking up header values and working with sequences of+-- header values in 'Request's and 'Response's. To avoid having to provide+-- separate set of operations for doing so, we introduce a type class 'HasHeaders'+-- to facilitate writing such processing using overloading instead. -- ---     [@Expect@]---                  Should a request contain a body, an Expect---                  header will be added to the request.  The added---                  header has the value \"100-continue\".  After---                  a 417 \"Expectation Failed\" response the request---                  is attempted again without this added Expect---                  header.---                  ---     [@TransferEncoding,ContentLength,...@]---                  if request is inconsistent with any of these---                  header values then you may not receive any response---                  or will generate an error response (probably 4xx).--- ----------------------------------------------------------------------------- module Network.HTTP.Headers-   ( HasHeaders(..)+   ( HasHeaders(..)     -- type class+    , Header(..)+   , mkHeader           -- :: HeaderName -> String -> Header+   , hdrName            -- :: Header     -> HeaderName+   , hdrValue           -- :: Header     -> String+    , HeaderName(..)-   , mkHeader -   , insertHeader-   , insertHeaderIfMissing-   , insertHeaders-   , retrieveHeaders-   , replaceHeader-   , findHeader-   , lookupHeader-   , parseHeaders+   , insertHeader          -- :: HasHeaders a => HeaderName -> String -> a -> a+   , insertHeaderIfMissing -- :: HasHeaders a => HeaderName -> String -> a -> a+   , insertHeaders         -- :: HasHeaders a => [Header] -> a -> a+   , retrieveHeaders       -- :: HasHeaders a => HeaderName -> a -> [Header]+   , replaceHeader         -- :: HasHeaders a => HeaderName -> String -> a -> a+   , findHeader            -- :: HasHeaders a => HeaderName -> a -> Maybe String+   , lookupHeader          -- :: HeaderName -> [Header] -> Maybe String +   , parseHeader           -- :: parseHeader :: String -> Result Header+   , parseHeaders          -- :: [String] -> Result [Header]+   +   , HeaderSetter    ) where  import Data.Char (toLower)@@ -67,6 +46,12 @@ -- | The @Header@ data type pairs header names & values. data Header = Header HeaderName String +hdrName :: Header -> HeaderName+hdrName (Header h _) = h++hdrValue :: Header -> String+hdrValue (Header _ v) = v+ -- | Header constructor as a function, hiding above rep. mkHeader :: HeaderName -> String -> Header mkHeader = Header@@ -74,17 +59,15 @@ instance Show Header where     show (Header key value) = shows key (':':' ':value ++ crlf) --- | HTTP Header Name type:---  Why include this at all?  I have some reasons---   1) prevent spelling errors of header names,---   2) remind everyone of what headers are available,---   3) might speed up searches for specific headers.------  Arguments against:---   1) makes customising header names laborious---   2) increases code volume.+-- | HTTP @HeaderName@ type, a Haskell data constructor for each+-- specification-defined header, prefixed with @Hdr@ and CamelCased,+-- (i.e., eliding the @-@ in the process.) Should you require using+-- a custom header, there's the @HdrCustom@ constructor which takes+-- a @String@ argument. ----- Long discussions can be had on this topic!+-- Encoding HTTP header names differently, as Strings perhaps, is an+-- equally fine choice..no decidedly clear winner, but let's stick+-- with data constructors here. --  data HeaderName      -- Generic Headers --@@ -147,8 +130,8 @@  | HdrCustom String -- not in header map below.     deriving(Eq) --- Translation between header names and values,--- good candidate for improvement.+-- | @headerMap@ is a straight assoc list for translating between header names +-- and values. headerMap :: [ (String,HeaderName) ] headerMap =    [ p "Cache-Control"        HdrCacheControl@@ -212,24 +195,28 @@                 [] -> error "headerMap incomplete"                 (h:_) -> fst h --- | This class allows us to write generic header manipulation functions--- for both 'Request' and 'Response' data types.+-- | @HasHeaders@ is a type class for types containing HTTP headers, allowing+-- you to write overloaded header manipulation functions+-- for both 'Request' and 'Response' data types, for instance. class HasHeaders x where     getHeaders :: x -> [Header]     setHeaders :: x -> [Header] -> x  -- Header manipulation functions-insertHeader, replaceHeader, insertHeaderIfMissing-    :: HasHeaders a => HeaderName -> String -> a -> a --- | Inserts a header with the given name and value.--- Allows duplicate header names.+type HeaderSetter a = HeaderName -> String -> a -> a++-- | @insertHeader hdr val x@ inserts a header with the given header name+-- and value. Does not check for existing headers with same name, allowing+-- duplicates to be introduce (use 'replaceHeader' if you want to avoid this.)+insertHeader :: HasHeaders a => HeaderSetter a insertHeader name value x = setHeaders x newHeaders     where         newHeaders = (Header name value) : getHeaders x --- | Adds the new header only if no previous header shares--- the same name.+-- | @insertHeaderIfMissing hdr val x@ adds the new header only if no previous+-- header with name @hdr@ exists in @x@.+insertHeaderIfMissing :: HasHeaders a => HeaderSetter a insertHeaderIfMissing name value x = setHeaders x (newHeaders $ getHeaders x)     where         newHeaders list@(h@(Header n _): rest)@@ -237,33 +224,39 @@             | otherwise  = h : newHeaders rest         newHeaders [] = [Header name value] --- | Removes old headers with duplicate name.+-- | @replaceHeader hdr val o@ replaces the header @hdr@ with the+-- value @val@, dropping any existing +replaceHeader :: HasHeaders a => HeaderSetter a replaceHeader name value h = setHeaders h newHeaders     where         newHeaders = Header name value : [ x | x@(Header n _) <- getHeaders h, name /= n ]           --- | Inserts multiple headers.+-- | @insertHeaders hdrs x@ appends multiple headers to @x@'s existing+-- set. insertHeaders :: HasHeaders a => [Header] -> a -> a insertHeaders hdrs x = setHeaders x (getHeaders x ++ hdrs) --- | Gets a list of headers with a particular 'HeaderName'.+-- | @retrieveHeaders hdrNm x@ gets a list of headers with 'HeaderName' @hdrNm@. retrieveHeaders :: HasHeaders a => HeaderName -> a -> [Header] retrieveHeaders name x = filter matchname (getHeaders x)     where-        matchname (Header n _)  |  n == name  =  True-        matchname _ = False+        matchname (Header n _) = n == name  --- | Lookup presence of specific HeaderName in a list of Headers--- Returns the value from the first matching header.+-- | @findHeader hdrNm x@ looks up @hdrNm@ in @x@, returning the first+-- header that matches, if any. findHeader :: HasHeaders a => HeaderName -> a -> Maybe String findHeader n x = lookupHeader n (getHeaders x) --- An anomally really:+-- | @lookupHeader hdr hdrs@ locates the first header matching @hdr@ in the+-- list @hdrs@. lookupHeader :: HeaderName -> [Header] -> Maybe String-lookupHeader v (Header n s:t)  |  v == n   =  Just s-                               | otherwise =  lookupHeader v t-lookupHeader _ _  =  Nothing+lookupHeader _ [] = Nothing+lookupHeader v (Header n s:t)  +  |  v == n   =  Just s+  | otherwise =  lookupHeader v t +-- | @parseHeader headerNameAndValueString@ tries to unscramble a+-- @header: value@ pairing and returning it as a 'Header'. parseHeader :: String -> Result Header parseHeader str =     case split ':' str of@@ -277,9 +270,14 @@         match :: String -> String -> Bool         match s1 s2 = map toLower s1 == map toLower s2     +-- | @parseHeaders hdrs@ takes a sequence of strings holding header+-- information and parses them into a set of headers (preserving their+-- order in the input argument.) Handles header values split up over+-- multiple lines. parseHeaders :: [String] -> Result [Header]-parseHeaders =-   catRslts [] . map (parseHeader . clean) . joinExtended ""+parseHeaders = catRslts [] . +                 map (parseHeader . clean) . +		     joinExtended ""    where         -- Joins consecutive lines where the second line         -- begins with ' ' or '\t'.

@@ -9,16 +9,8 @@ -- Stability   :  experimental -- Portability :  non-portable (not tested) ----- An easy access TCP library. Makes the use of TCP in Haskell much easier.--- This was originally part of Gray's\/Bringert's HTTP module.------ * Changes by Robin Bate Boerop <robin@bateboerop.name>:---      - Made dependencies explicit in import statements.---      - Removed false dependencies from import statements.---      - Removed unused exported functions.------ * Changes by Simon Foster:---      - Split module up into to separate Network.[Stream,TCP,HTTP] modules+-- Some utility functions for working with the Haskell @network@ package. Mostly+-- for internal use by the @Network.HTTP@ code, but  --       ----------------------------------------------------------------------------- module Network.TCP@@ -74,7 +66,7 @@ -----------------------------------------------------------------  -- | The 'Connection' newtype is a wrapper that allows us to make--- connections an instance of the Stream class, without ghc extensions.+-- connections an instance of the Stream class, without GHC extensions. -- While this looks sort of like a generic reference to the transport -- layer it is actually TCP specific, which can be seen in the -- implementation of the 'Stream Connection' instance.@@ -123,6 +115,16 @@ setStreamHooks :: HandleStream ty -> StreamHooks ty -> IO () setStreamHooks h sh = modifyMVar_ (getRef h) (\ c -> return c{connHooks=Just sh}) +-- | @HStream@ overloads the use of 'HandleStream's, letting you+-- overload the handle operations over the type that is communicated+-- across the handle. It is used in the context of @Network.HTTP@ to+-- buy us freedom in how HTTP 'Request' and 'Response' payloads are+-- represented. +--+-- The package provides instances for @ByteString@s and @String@, but+-- should you want to plug in your own payload representation, defining+-- your own @HStream@ instance is all it takes.+--  class BufferType bufType => HStream bufType where   openStream :: String -> Int -> IO (HandleStream bufType)   readLine   :: HandleStream bufType -> IO (Result bufType)