diff --git a/HTTP.cabal b/HTTP.cabal
--- a/HTTP.cabal
+++ b/HTTP.cabal
@@ -1,5 +1,5 @@
 Name: HTTP
-Version: 4000.0.1
+Version: 4000.0.2
 Cabal-Version: >= 1.2
 Build-type: Simple
 License: BSD3
@@ -12,12 +12,15 @@
   Copyright (c) 2004, Ganesh Sittampalam
   Copyright (c) 2004-2005, Dominic Steinitz
   Copyright 2007 Robin Bate Boerop
+  Copyright 2008-2009 Sigbjorn Finne
 Author: Warrick Gray <warrick.gray@hotmail.com>
 Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
 Homepage: http://www.haskell.org/http/
+Category: Network
+Synopsis: A library for client-side HTTP
 Description: 
 
- A library for client-side HTTP, version 2. Rewrite of existing HTTP
+ A library for client-side HTTP, version 4. Rewrite of existing HTTP
  package to allow overloaded representation of HTTP request bodies
  and responses. Provides three such instances: lazy and strict 'ByteString',
  along with the good old @String@.
@@ -50,9 +53,11 @@
                  Network.HTTP.MD5Aux,
                  Network.HTTP.Utils
   GHC-options: -fwarn-missing-signatures -Wall
-  Build-depends: network, parsec, bytestring
+  Build-depends: network, parsec, bytestring, mtl
 
   if flag(old-base)
     Build-depends: base < 3
   else
-    Build-depends: base >= 3, array
+    Build-depends: base >= 3
+    
+  Build-depends: array
diff --git a/Network/Browser.hs b/Network/Browser.hs
--- a/Network/Browser.hs
+++ b/Network/Browser.hs
@@ -38,6 +38,9 @@
     browse,             -- BrowserAction a -> IO a
     request,            -- Request -> BrowserAction Response
     
+    getBrowserState,
+    withBrowserState,
+    
     setAllowRedirects,
     getAllowRedirects,
     
@@ -69,6 +72,7 @@
     ioAction,           -- :: IO a -> BrowserAction a
 
     defaultGETRequest,
+    defaultGETRequest_,
     formToRequest,
     uriDefaultTo,
     uriTrimHost
@@ -83,7 +87,7 @@
 import Network.HTTP
 import qualified Network.HTTP.MD5 as MD5 (hash)
 import qualified Network.HTTP.Base64 as Base64 (encode)
-import Network.Stream ( ConnError(..) )
+import Network.Stream ( ConnError(..), Result )
 import Network.BufferType
 
 import Network.HTTP.Utils ( trim, splitBy )
@@ -101,7 +105,6 @@
    , BufferMode(NoBuffering, LineBuffering)
    )
 import Data.Word (Word8)
-import Debug.Trace
 
 type Octet = Word8
 
@@ -111,7 +114,7 @@
 
 word, quotedstring :: Parser String
 quotedstring =
-    do { char '"' -- "
+    do { char '"' 
        ; str <- many (satisfy $ not . (=='"'))
        ; char '"'
        ; return str
@@ -125,16 +128,11 @@
 -- If second argument is not sufficient context for
 -- determining a full URI then anarchy reins.
 uriDefaultTo :: URI -> URI -> URI
-uriDefaultTo a b =
-    case a `relativeTo` b of
-        Nothing -> a
-        Just x  -> x
-
+uriDefaultTo a b = maybe a id (a `relativeTo` b)
 
 uriTrimHost :: URI -> URI
 uriTrimHost uri = uri { uriScheme="", uriAuthority=Nothing }
 
-
 ------------------------------------------------------------------
 ----------------------- Cookie Stuff -----------------------------
 ------------------------------------------------------------------
@@ -142,13 +140,15 @@
 -- Some conventions: 
 --     assume ckDomain is lowercase
 --
-data Cookie = MkCookie { ckDomain
-                       , ckName
-                       , ckValue :: String
-                       , ckPath
-                       , ckComment
-                       , ckVersion :: Maybe String
-                       }
+data Cookie 
+ = MkCookie 
+    { ckDomain  :: String
+    , ckName    :: String
+    , ckValue   :: String
+    , ckPath    :: Maybe String
+    , ckComment :: Maybe String
+    , ckVersion :: Maybe String
+    }
     deriving(Show,Read)
 
 
@@ -168,10 +168,8 @@
        case ckComment cky of
           Nothing -> return ()
           Just x  -> putStrLn ("Cookie Comment:\n" ++ x)
-       putStrLn ("Domain/Path: " ++ ckDomain cky ++ 
-            case ckPath cky of
-                Nothing -> ""
-                Just x  -> "/" ++ x)
+       let pth = maybe "" ('/':) (ckPath cky)
+       putStrLn ("Domain/Path: " ++ ckDomain cky ++ pth)
        putStrLn (ckName cky ++ '=' : ckValue cky)
        System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering
        System.IO.hSetBuffering System.IO.stdin System.IO.NoBuffering
@@ -187,21 +185,21 @@
 cookieToHeader :: Cookie -> Header
 cookieToHeader ck = Header HdrCookie text
     where
+        path = maybe "" (";$Path="++) (ckPath ck)
         text = "$Version=" ++ fromMaybe "0" (ckVersion ck)
-             ++ ';' : ckName ck ++ "=" ++ ckValue ck
+             ++ ';' : ckName ck ++ "=" ++ ckValue ck ++ path
              ++ (case ckPath ck of
                      Nothing -> ""
                      Just x  -> ";$Path=" ++ x)
              ++ ";$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
+        Right x -> x
     where
         cookies :: Parser [Cookie]
         cookies = sepBy1 cookie (char ',')
@@ -480,7 +478,7 @@
 
 
 -- | Retrieve a likely looking authority for a Request.
-anticipateChallenge :: HTTPRequest ty -> BrowserAction t (Maybe Authority)
+anticipateChallenge :: Request ty -> BrowserAction t (Maybe Authority)
 anticipateChallenge rq =
     let uri = rqURI rq in
     do { authlist <- getAuthFor (uriAuthToString $ reqURIAuth rq) (uriPath uri)
@@ -532,7 +530,7 @@
 -- the context of a specific request.  If a client nonce
 -- was to be used then this function might need to
 -- be of type ... -> BrowserAction String
-withAuthority :: Authority -> HTTPRequest ty -> String
+withAuthority :: Authority -> Request ty -> String
 withAuthority a rq = case a of
         AuthBasic{}  -> "Basic " ++ base64encode (auUsername a ++ ':' : auPassword a)
         AuthDigest{} ->
@@ -634,12 +632,15 @@
                 return (snd x)
 
 defaultBrowserState :: BrowserState t
-defaultBrowserState = 
-  BS { bsErr              = putStrLn
+defaultBrowserState = res
+ where
+   res = BS
+     { bsErr              = putStrLn
      , bsOut              = putStrLn
      , bsCookies          = []
      , bsCookieFilter     = defaultCookieFilter
-     , bsAuthorityGen     = (error "bsAuthGen wanted")
+     , bsAuthorityGen     = \ _uri _realm -> 
+          (bsErr res) ("No action for prompting/generating user+password credentials provided (use: setAuthorityGen); returning Nothing") >> return Nothing
      , bsAuthorities      = []
      , bsAllowRedirects   = True
      , bsAllowBasicAuth   = False
@@ -655,6 +656,12 @@
 getBS :: (BrowserState t -> a) -> BrowserAction t a
 getBS f = BA (\b -> return (b,f b))
 
+getBrowserState :: BrowserAction t (BrowserState t)
+getBrowserState = getBS id
+
+withBrowserState :: BrowserState t -> BrowserAction t a -> BrowserAction t a
+withBrowserState bs act = BA $ \ _ -> lift act bs
+
 -- | Do an io action
 ioAction :: IO a -> BrowserAction t a
 ioAction a = BA (\b -> a >>= \v -> return (b,v))
@@ -715,8 +722,8 @@
 
 -- Surely the most important bit:
 request :: HStream ty
-        => HTTPRequest ty
-	-> BrowserAction (HandleStream ty) (URI,HTTPResponse ty)
+        => Request ty
+	-> BrowserAction (HandleStream ty) (URI,Response ty)
 request req = request' nullVal initialState req
   where
    initialState = nullRequestState
@@ -725,8 +732,8 @@
 request' :: HStream ty
          => ty
 	 -> RequestState
-	 -> HTTPRequest ty
-	 -> BrowserAction (HandleStream ty) (URI,HTTPResponse ty)
+	 -> Request ty
+	 -> BrowserAction (HandleStream ty) (URI,Response ty)
 request' nullVal rqState rq = do
      -- add cookies to request
    let uri = rqURI rq
@@ -745,14 +752,16 @@
          Just x  -> return (insertHeader HdrAuthorization (withAuthority x rq) rq)
    let rq'' = insertHeaders (map cookieToHeader cookies) rq'
    p <- getProxy
-
-   out ("Sending:\n" ++ show rq'') 
+   let rq_to_go = normalizeRequestURI (uriToAuthorityString $ rqURI rq'') rq''
+   out ("Sending:\n" ++ show rq_to_go) 
    e_rsp <- 
      case p of
-       NoProxy       -> dorequest (reqURIAuth rq'') rq''
+       NoProxy       -> dorequest (reqURIAuth rq'') rq_to_go
        Proxy str ath -> do
-          let rq''' = maybe rq'' 
-	                   (\x -> insertHeader HdrProxyAuthorization (withAuthority x rq'') rq'')
+            -- note: don't split off the authority for proxies..
+          let rq_to_go' = maybe rq''
+	                    (\x -> insertHeader HdrProxyAuthorization
+			                        (withAuthority x rq'') rq'')
 		           ath
           let notURI 
 	       | null pt || null hst = 
@@ -775,7 +784,7 @@
                       (parseURI str)
 
           out $ "proxy uri host: " ++ uriRegName proxyURIAuth ++ ", port: " ++ uriPort proxyURIAuth
-          dorequest proxyURIAuth rq'''
+          dorequest proxyURIAuth rq_to_go'
    case e_rsp of
     Left v 
      | (reqRetries rqState < maxRetries) && (v == ErrorReset || v == ErrorClosed) ->
@@ -916,21 +925,26 @@
 
 
 dorequest :: (HStream ty)
-          => URIAuth -> HTTPRequest ty -> BrowserAction (HandleStream ty) (Either ConnError (HTTPResponse 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 aport = case uriPort hst of
-                                            (':':s) -> read s
+                                            (':':s) -> 
+					      case reads s of { ((v,_):_) -> v ; _ -> 80}
                                             _       -> 80
                              ; c <- ioAction $ openStream (uriRegName hst) aport
-                             ; let pool' = if length pool > 5
-                                           then init pool
-                                           else pool
-                             ; when (length pool > 5)
+			     ; let len_pool = length pool
+                             ; when (len_pool > 5)
                                     (ioAction $ close (last pool))
+                             ; let pool' 
+			            | len_pool > 5 = init pool
+				    | otherwise    = pool
                              ; alterBS (\b -> b { bsConnectionPool=c:pool' })
                              ; dorequest2 c rqst
                              }
@@ -951,7 +965,7 @@
 	   c' <- debugByteStream (f++'-': uriAuthToString hst) c
 	   sendHTTP c' r
  
-reqURIAuth :: HTTPRequest ty -> URIAuth
+reqURIAuth :: Request ty -> URIAuth
 reqURIAuth req = 
   case uriAuthority (rqURI req) of
     Just ua -> ua
@@ -967,18 +981,29 @@
 ------------------------------------------------------------------
 
 libUA :: String
-libUA = "haskell-libwww/0.1"
+libUA = "hs-HTTP/4.0.3"
 
-defaultGETRequest :: URI -> Request
-defaultGETRequest uri = 
+defaultGETRequest :: URI -> Request_String
+defaultGETRequest uri = defaultGETRequest_ uri
+
+
+defaultGETRequest_ :: BufferType a => URI -> Request a
+defaultGETRequest_ uri = req
+ where
+  empty = buf_empty (toBufOps req)
+  
+  req = 
     Request { rqURI=uri
-            , rqBody=""
+            , rqBody=empty
             , rqHeaders=[ Header HdrContentLength "0"
                         , Header HdrUserAgent libUA
                         ]
             , rqMethod=GET
             }
 
+  toBufOps :: BufferType a => Request a -> BufferOp a
+  toBufOps _ = bufferOps
+
 -- This form junk is completely untested...
 
 type FormVar = (String,String)
@@ -986,7 +1011,7 @@
 data Form = Form RequestMethod URI [FormVar]
 
 
-formToRequest :: Form -> Request
+formToRequest :: Form -> Request_String
 formToRequest (Form m u vs) =
     let enc = urlEncodeVars vs
     in case m of
diff --git a/Network/HTTP.hs b/Network/HTTP.hs
--- a/Network/HTTP.hs
+++ b/Network/HTTP.hs
@@ -8,39 +8,18 @@
 -- Stability   :  experimental
 -- Portability :  non-portable (not tested)
 --
--- An easy HTTP interface enjoy.
---
--- * Changes by Robin Bate Boerop <robin@bateboerop.name>:
---      - Made dependencies explicit in import statements.
---      - Removed false dependencies in import statements.
---      - Added missing type signatures.
---      - Moved Header-related code to Network.HTTP.Headers module.
---
--- * Changes by Simon Foster:
---      - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
---      - Created functions receiveHTTP and responseHTTP to allow server side interactions
---        (although 100-continue is unsupported and I haven't checked for standard compliancy).
---      - Pulled the transfer functions from sendHTTP to global scope to allow access by
---        above functions.
---
--- * Changes by Graham Klyne:
---      - export httpVersion
---      - use new URI module (similar to old, but uses revised URI datatype)
---
--- * Changes by Bjorn Bringert:
+-- An easy HTTP interface, toplevel module.
 --
---      - handle URIs with a port number
---      - added debugging toggle
---      - disabled 100-continue transfers to get HTTP\/1.0 compatibility
---      - change 'ioError' to 'throw'
---      - Added simpleHTTP_, which takes a stream argument.
+-- The 'Network.HTTP' module provides functionality for sending
+-- HTTP requests and processing their responses, along with a supporting
+-- cast of types and utility functions.
 --
--- * Changes from 0.1
---      - change 'openHTTP' to 'openTCP', removed 'closeTCP' - use 'close' from 'Stream' class.
---      - added use of inet_addr to openHTTP, allowing use of IP "dot" notation addresses.
---      - reworking of the use of Stream, including alterations to make 'sendHTTP' generic
---        and the addition of a debugging stream.
---      - simplified error handling.
+-- The actual functionality is implemented by modules in the @Network.HTTP.*@
+-- namespace, allowing the user to either use the default implementation 
+-- by importing @Network.HTTP@ or, for more fine-grained control, selectively
+-- import the modules in @Network.HTTP.*@. To wit, more than one kind of
+-- representation of the bulk data that flows across a HTTP connection is 
+-- supported. Now selectable by importing @Network.HTTP.HandleStream@ (say.)
 -- 
 -- * TODO
 --     - request pipelining
@@ -98,7 +77,8 @@
        , module Network.HTTP.Base
        , module Network.HTTP.Headers
 
-{-
+{- the functionality that Network.HTTP.HandleStream and Network.HTTP.Stream
+   exposes:
        , simpleHTTP     -- :: Request -> IO (Result Response)
        , simpleHTTP_    -- :: Stream s => s -> Request -> IO (Result Response)
        , sendHTTP       -- :: Stream s => s -> Request -> IO (Result Response)
@@ -106,7 +86,6 @@
        , respondHTTP    -- :: Stream s => s -> Response -> IO ()
 -}
        , module Network.TCP
-
        ) where
 
 -----------------------------------------------------------------
diff --git a/Network/HTTP/Base.hs b/Network/HTTP/Base.hs
--- a/Network/HTTP/Base.hs
+++ b/Network/HTTP/Base.hs
@@ -17,12 +17,14 @@
          httpVersion
 
           -- ** HTTP
-       , Request
-       , Response
+       , Request(..)
+       , Response(..)
        , RequestMethod(..)
        
-       , HTTPRequest(..)
-       , HTTPResponse(..)
+       , Request_String
+       , Response_String
+       , HTTPRequest
+       , HTTPResponse
        
           -- ** URL Encoding
        , urlEncode
@@ -61,6 +63,7 @@
        
        , catchIO
        , catchIO_
+       , responseParseError
        ) where
 
 import Network.URI
@@ -70,6 +73,7 @@
    )
 
 import Control.Monad ( guard )
+import Control.Monad.Error
 import Data.Char     ( ord, digitToInt, intToDigit, toLower )
 import Data.List     ( partition )
 import Data.Maybe    ( listToMaybe )
@@ -164,13 +168,23 @@
 	       ("OPTIONS", OPTIONS),
 	       ("TRACE",   TRACE)]
 
-type Request  = HTTPRequest  String
-type Response = HTTPResponse String
+-- 
+-- for backwards-ish compatibility; suggest
+-- migrating to new Req/Resp by adding type param.
+-- 
+type Request_String  = Request String
+type Response_String = Response String
 
+-- Hmm..I really want to use these for the record
+-- type, but it will upset codebases wanting to
+-- migrate (and live with using pre-HTTPbis versions.)
+type HTTPRequest a  = Request  a
+type HTTPResponse a = Response a
+
 -- | An HTTP Request.
 -- The 'Show' instance of this type is used for message serialisation,
 -- which means no body data is output.
-data HTTPRequest a =
+data Request a =
      Request { rqURI       :: URI   -- ^ might need changing in future
                                     --  1) to support '*' uri in OPTIONS request
                                     --  2) transparent support for both relative
@@ -191,7 +205,7 @@
 -- this show function is used to serialise
 -- a request for the transport link, we send
 -- the body separately where possible.
-instance Show (HTTPRequest a) where
+instance Show (Request a) where
     show (Request u m h _) =
         show m ++ sp ++ alt_uri ++ sp ++ httpVersion ++ crlf
         ++ foldr (++) [] (map show h) ++ crlf
@@ -200,7 +214,7 @@
                         then u { uriPath = '/' : uriPath u } 
                         else u
 
-instance HasHeaders (HTTPRequest a) where
+instance HasHeaders (Request a) where
     getHeaders = rqHeaders
     setHeaders rq hdrs = rq { rqHeaders=hdrs }
 
@@ -222,7 +236,7 @@
 -- which means no body data is output, additionally the output will
 -- show an HTTP version of 1.1 instead of the actual version returned
 -- by a server.
-data HTTPResponse a =
+data Response a =
     Response { rspCode     :: ResponseCode
              , rspReason   :: String
              , rspHeaders  :: [Header]
@@ -231,12 +245,12 @@
                    
 -- This is an invalid representation of a received response, 
 -- since we have made the assumption that all responses are HTTP/1.1
-instance Show (HTTPResponse a) where
+instance Show (Response a) where
     show (Response (a,b,c) reason headers _) =
         httpVersion ++ ' ' : map intToDigit [a,b,c] ++ ' ' : reason ++ crlf
         ++ foldr (++) [] (map show headers) ++ crlf
 
-instance HasHeaders (HTTPResponse a) where
+instance HasHeaders (Response a) where
     getHeaders = rspHeaders
     setHeaders rsp hdrs = rsp { rspHeaders=hdrs }
 
@@ -246,48 +260,48 @@
 
 -- Parsing a request
 parseRequestHead :: [String] -> Result RequestData
-parseRequestHead [] = Left ErrorClosed
-parseRequestHead (com:hdrs) =
-    requestCommand com `bindE` \(_version,rqm,uri) ->
-    parseHeaders hdrs `bindE` \hdrs' ->
-    Right (rqm,uri,hdrs')
-    where
-        requestCommand line =
-	  case words line of
-            _yes@(rqm:uri:version) -> 
-	     case (parseURIReference uri, lookup rqm rqMethodMap) of
-  	       (Just u, Just r) -> Right (version,r,u)
-	       _                -> Left parse_err
-	    _no 
-	     | null line -> Left ErrorClosed
-	     | otherwise -> Left parse_err
-          where
-	   parse_err = ErrorParse ("Request command line parse failure: " ++ line)
+parseRequestHead         [] = Left ErrorClosed
+parseRequestHead (com:hdrs) = do
+  (_version,rqm,uri) <- requestCommand com (words com)
+  hdrs'              <- parseHeaders hdrs
+  return (rqm,uri,hdrs')
+ where
+  requestCommand l _yes@(rqm:uri:version) =
+    case (parseURIReference uri, lookup rqm rqMethodMap) of
+     (Just u, Just r) -> return (version,r,u)
+     _                -> parse_err l
+  requestCommand l _
+   | null l    = failWith ErrorClosed
+   | otherwise = parse_err l
 
+  parse_err l = responseParseError "parseRequestHead"
+                   ("Request command line parse failure: " ++ l)
+
 -- Parsing a response
 parseResponseHead :: [String] -> Result ResponseData
-parseResponseHead [] = Left ErrorClosed
-parseResponseHead (sts:hdrs) = 
-    responseStatus sts `bindE` \(_version,code,reason) ->
-    parseHeaders hdrs `bindE` \hdrs' ->
-    Right (code,reason,hdrs')
-    where
-        responseStatus line =
-          case words line of
-            _yes@(version:code:reason) -> 
-	     Right (version,match code,concatMap (++" ") reason)
-            _no
-	     | null line -> Left ErrorClosed  -- an assumption
-	     | otherwise -> Left parse_err
-          where
-	   parse_err = (ErrorParse $ "Response status line parse failure: " ++ line)
+parseResponseHead []         = failWith ErrorClosed
+parseResponseHead (sts:hdrs) = do
+  (_version,code,reason) <- responseStatus sts (words sts)
+  hdrs'                  <- parseHeaders hdrs
+  return (code,reason,hdrs')
+ where
+  responseStatus _l _yes@(version:code:reason) =
+    return (version,match code,concatMap (++" ") reason)
+  responseStatus l _no 
+    | null l    = failWith ErrorClosed  -- an assumption
+    | otherwise = parse_err l
 
-        match [a,b,c] = (digitToInt a,
-                         digitToInt b,
-                         digitToInt c)
-        match _ = (-1,-1,-1)  -- will create appropriate behaviour
+  parse_err l = 
+    responseParseError 
+        "parseResponseHead"
+        ("Response status line parse failure: " ++ l)
 
+  match [a,b,c] = (digitToInt a,
+                   digitToInt b,
+                   digitToInt c)
+  match _ = (-1,-1,-1)  -- will create appropriate behaviour
 
+
         
 
 -----------------------------------------------------------------
@@ -390,7 +404,7 @@
 
 -- | @getAuth req@ fishes out the authority portion of the URL in a request's @Host@
 -- header.
-getAuth :: Monad m => HTTPRequest ty -> m URIAuthority
+getAuth :: Monad m => Request ty -> m URIAuthority
 getAuth r = 
    -- ToDo: verify that Network.URI functionality doesn't take care of this (now.)
   case parseURIAuthority auth of
@@ -412,8 +426,8 @@
   -- the Host header if there is one, otherwise from the request-URI.
   -- Then we make the request-URI an abs_path and make sure that there
   -- is a Host header.
-normalizeRequestURI :: URIAuthority -> HTTPRequest ty -> HTTPRequest ty
-normalizeRequestURI URIAuthority{host=h} r = 
+normalizeRequestURI :: {-URI-}String -> Request ty -> Request ty
+normalizeRequestURI h r = 
   replaceHeader HdrConnection "close" $
   insertHeaderIfMissing HdrHost h $
     r { rqURI = (rqURI r){ uriScheme = ""
@@ -421,7 +435,7 @@
 			 }}
 
 -- Adds a Host header if one is NOT ALREADY PRESENT
-normalizeHostHeader :: HTTPRequest ty -> HTTPRequest ty
+normalizeHostHeader :: Request ty -> Request ty
 normalizeHostHeader rq = 
   insertHeaderIfMissing HdrHost
                         (uriToAuthorityString $ rqURI rq)
@@ -438,9 +452,7 @@
 
 -- | Used when we know exactly how many bytes to expect.
 linearTransfer :: (Int -> IO (Result a)) -> Int -> IO (Result ([Header],a))
-linearTransfer readBlk n
-    = do info <- readBlk n
-         return $ info `bindE` \str -> Right ([],str)
+linearTransfer readBlk n = fmapE (\str -> Right ([],str)) (readBlk n)
 
 -- | Used when nothing about data is known,
 --   Unfortunately waiting for a socket closure
@@ -464,11 +476,11 @@
 		-> IO (Result a)
                 -> (Int -> IO (Result a))
                 -> IO (Result ([Header], a))
-chunkedTransfer bufOps readL readBlk = do
-    v <- chunkedTransferC bufOps readL readBlk 0
-    return $ v `bindE` \(ftrs,count,info) ->
-             let myftrs = Header HdrContentLength (show count) : ftrs              
-             in Right (myftrs,info)
+chunkedTransfer bufOps readL readBlk = 
+  fmapE (\ (ftrs,count,info) ->
+           let myftrs = Header HdrContentLength (show count) : ftrs              
+           in Right (myftrs,info))
+	(chunkedTransferC bufOps readL readBlk 0)
 
 chunkedTransferC :: BufferOp a
                  -> IO (Result a)
@@ -480,20 +492,20 @@
   case v of
     Left e -> return (Left e)
     Right line 
-     | size == 0 -> do
-         rs <- readTillEmpty2 bufOps readL []
-         return $
-           rs `bindE` \strs ->
-           parseHeaders (map (buf_toStr bufOps) strs) `bindE` \ftrs ->
-           Right (ftrs,n,buf_empty bufOps)
+     | size == 0 -> 
+        fmapE (\ strs -> do
+	         ftrs <- parseHeaders (map (buf_toStr bufOps) strs)
+                 return (ftrs,n,buf_empty bufOps))
+	      (readTillEmpty2 bufOps readL [])
+
      | otherwise -> do
          some <- readBlk size
          readL
-         more <- chunkedTransferC bufOps {-nullVal isNull isLineEnd toStr append -} readL readBlk (n+size)
-         return $ 
-           some `bindE` \cdata ->
-           more `bindE` \(ftrs,m,mdata) -> 
-           Right (ftrs,m,buf_append bufOps cdata mdata) 
+         more <- chunkedTransferC bufOps readL readBlk (n+size)
+         return $ do
+           cdata          <- some
+	   (ftrs,m,mdata) <- more
+           return (ftrs,m,buf_append bufOps cdata mdata) 
      where
       size 
        | buf_isEmpty bufOps line = 0
@@ -505,9 +517,8 @@
 -- | Maybe in the future we will have a sensible thing
 --   to do here, at that time we might want to change
 --   the name.
-uglyDeathTransfer :: IO (Result ([Header],a))
-uglyDeathTransfer 
-    = return $ Left $ ErrorParse "Unknown Transfer-Encoding"
+uglyDeathTransfer :: String -> IO (Result ([Header],a))
+uglyDeathTransfer loc = return (responseParseError loc "Unknown Transfer-Encoding")
 
 -- | Remove leading crlfs then call readTillEmpty2 (not required by RFC)
 readTillEmpty1 :: BufferOp a
@@ -550,3 +561,5 @@
 catchIO_ :: IO a -> IO a -> IO a
 catchIO_ a h = Prelude.catch a (const h)
 
+responseParseError :: String -> String -> Result a
+responseParseError loc v = failWith (ErrorParse (loc ++ ' ':v))
diff --git a/Network/HTTP/HandleStream.hs b/Network/HTTP/HandleStream.hs
--- a/Network/HTTP/HandleStream.hs
+++ b/Network/HTTP/HandleStream.hs
@@ -12,13 +12,13 @@
 --
 -----------------------------------------------------------------------------
 module Network.HTTP.HandleStream 
-       ( simpleHTTP     -- :: HTTPRequest ty -> IO (Result (HTTPResponse ty))
-       , simpleHTTP_    -- :: HStream ty => HandleStream ty -> HTTPRequest ty -> IO (Result (HTTPResponse ty))
-       , sendHTTP       -- :: HStream ty => HandleStream ty -> HTTPRequest ty -> IO (Result (HTTResponse ty))
-       , receiveHTTP    -- :: HStream ty => HandleStream ty -> IO (Result (HTTPRequest ty))
-       , respondHTTP    -- :: HStream ty => HandleStream ty -> HTTPResponse ty -> IO ()
+       ( simpleHTTP     -- :: Request ty -> IO (Result (Response ty))
+       , simpleHTTP_    -- :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
+       , sendHTTP       -- :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
+       , receiveHTTP    -- :: HStream ty => HandleStream ty -> IO (Result (Request ty))
+       , respondHTTP    -- :: HStream ty => HandleStream ty -> Response ty -> IO ()
        
-       , simpleHTTP_debug -- :: FilePath -> HTTPRequest DebugString -> IO (HTTPResponse DebugString)
+       , simpleHTTP_debug -- :: FilePath -> Request DebugString -> IO (Response DebugString)
        ) where
 
 -----------------------------------------------------------------
@@ -26,7 +26,7 @@
 -----------------------------------------------------------------
 
 import Network.BufferType
-import Network.Stream ( ConnError(..), bindE, Result )
+import Network.Stream ( ConnError(..), fmapE, Result )
 import Network.StreamDebugger ( debugByteStream )
 import Network.TCP (HStream(..), HandleStream )
 
@@ -48,13 +48,13 @@
 --              requires a Host header.
 --  Connection  Where no allowance is made for persistant connections
 --              the Connection header will be set to "close"
-simpleHTTP :: HStream ty => HTTPRequest ty -> IO (Result (HTTPResponse ty))
+simpleHTTP :: HStream ty => Request ty -> IO (Result (Response ty))
 simpleHTTP r = do 
   auth <- getAuth r
   c <- openStream (host auth) (fromMaybe 80 (port auth))
   simpleHTTP_ c r
 
-simpleHTTP_debug :: HStream ty => FilePath -> HTTPRequest ty -> IO (Result (HTTPResponse ty))
+simpleHTTP_debug :: HStream ty => FilePath -> Request ty -> IO (Result (Response ty))
 simpleHTTP_debug httpLogFile r = do 
   auth <- getAuth r
   c0 <- openStream (host auth) (fromMaybe 80 (port auth))
@@ -62,14 +62,14 @@
   simpleHTTP_ c r
 
 -- | Like 'simpleHTTP', but acting on an already opened stream.
-simpleHTTP_ :: HStream ty => HandleStream ty -> HTTPRequest ty -> IO (Result (HTTPResponse ty))
+simpleHTTP_ :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
 simpleHTTP_ s r = do 
   auth <- getAuth r
-  let r' = normalizeRequestURI auth r 
+  let r' = normalizeRequestURI (host auth) r 
   rsp <- sendHTTP s r'
   return rsp
 
-sendHTTP :: HStream ty => HandleStream ty -> HTTPRequest ty -> IO (Result (HTTPResponse ty))
+sendHTTP :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
 sendHTTP conn rq = do
   let a_rq = normalizeHostHeader rq
   rsp <- catchIO (sendMain conn a_rq)
@@ -91,7 +91,10 @@
 -- for an indefinite period before sending the request body.'
 --
 -- Since we would wait forever, I have disabled use of 100-continue for now.
-sendMain :: HStream ty => HandleStream ty -> HTTPRequest ty -> IO (Result (HTTPResponse ty))
+sendMain :: HStream ty
+         => HandleStream ty
+	 -> Request ty
+	 -> IO (Result (Response ty))
 sendMain conn rqst = do
       --let str = if null (rqBody rqst)
       --              then show rqst
@@ -111,8 +114,8 @@
 	       -> Bool {- allow retry? -}
                -> Bool {- is body sent? -}
                -> Result ResponseData
-               -> HTTPRequest ty
-               -> IO (Result (HTTPResponse ty))
+               -> Request ty
+               -> IO (Result (Response ty))
 switchResponse _ _ _ (Left e) _ = return (Left e)
                 -- retry on connreset?
                 -- if we attempt to use the same socket then there is an excellent
@@ -141,24 +144,18 @@
                      
      Done -> return (Right $ Response cd rn hdrs (buf_empty bufferOps))
 
-     DieHorribly str -> return $ Left $ ErrorParse ("Invalid response: " ++ str)
-
-     ExpectEntity -> do
-       rslt <- 
-        case tc of
-          Nothing -> 
-            case cl of
-              Nothing -> hopefulTransfer bo (readLine conn) []
-              Just x  -> 
-	        case reads x of
-		  ((v,_):_) ->  linearTransfer (readBlock conn) v
-		  _ -> return (Left (ErrorParse ("unrecognized content-length value " ++ x)))
-          Just x  -> 
-            case map toLower (trim x) of
-              "chunked" -> chunkedTransfer bo (readLine conn) (readBlock conn)
-              _         -> uglyDeathTransfer
-       return $ rslt `bindE` \(ftrs,bdy) -> Right (Response cd rn (hdrs++ftrs) bdy)
-
+     DieHorribly str -> return (responseParseError "Invalid response:" str)
+     ExpectEntity -> 
+       fmapE (\ (ftrs,bdy) -> Right (Response cd rn (hdrs++ftrs) bdy)) $
+        maybe (maybe (hopefulTransfer bo (readLine conn) [])
+	             (\ x -> 
+		        readsOne (linearTransfer (readBlock conn))
+		                 (return$responseParseError "unrecognized content-length value" x)
+				 x)
+		     cl)
+	      (ifChunked (chunkedTransfer bo (readLine conn) (readBlock conn))
+	                 (uglyDeathTransfer "sendHTTP"))
+              tc
       where
        tc = lookupHeader HdrTransferEncoding hdrs
        cl = lookupHeader HdrContentLength hdrs
@@ -166,49 +163,62 @@
                     
 -- reads and parses headers
 getResponseHead :: HStream ty => HandleStream ty -> IO (Result ResponseData)
-getResponseHead conn = do
-   lor <- readTillEmpty1 bufferOps (readLine conn)
-   return $ lor `bindE` \es -> parseResponseHead (map (buf_toStr bufferOps) es)
+getResponseHead conn = 
+   fmapE (\es -> parseResponseHead (map (buf_toStr bufferOps) es))
+         (readTillEmpty1 bufferOps (readLine conn))
 
 -- | Receive and parse a HTTP request from the given Stream. Should be used 
 --   for server side interactions.
-receiveHTTP :: HStream bufTy => HandleStream bufTy -> IO (Result (HTTPRequest bufTy))
+receiveHTTP :: HStream bufTy => HandleStream bufTy -> IO (Result (Request bufTy))
 receiveHTTP conn = getRequestHead >>= either (return . Left) processRequest
-    where
-        -- reads and parses headers
-        getRequestHead :: IO (Result RequestData)
-        getRequestHead =
-            do { lor <- readTillEmpty1 bufferOps (readLine conn)
-               ; return $ lor `bindE` \es -> parseRequestHead (map (buf_toStr bufferOps) es)
-               }
+  where
+    -- reads and parses headers
+   getRequestHead :: IO (Result RequestData)
+   getRequestHead = do
+      fmapE (\es -> parseRequestHead (map (buf_toStr bufferOps) es))
+            (readTillEmpty1 bufferOps (readLine conn))
 	
-	processRequest (rm,uri,hdrs) = do
-           rslt <- 
-	     case tc of
-               Nothing ->
-                 case cl of
-                   Nothing -> return (Right ([], buf_empty bo)) -- hopefulTransfer ""
-                   Just x  -> 
-		     case reads x of
-		       ((v,_):_) -> linearTransfer (readBlock conn) v
-		       _ -> return (Left (ErrorParse ("unrecognized content-length value " ++ x)))
-               Just x  ->
-                 case map toLower (trim x) of
-                   "chunked" -> chunkedTransfer bo (readLine conn) (readBlock conn)
-                   _         -> uglyDeathTransfer
-               
-           return $ rslt `bindE` \(ftrs,bdy) -> Right (Request uri rm (hdrs++ftrs) bdy)
-	  where
-	     -- FIXME : Also handle 100-continue.
-            tc = lookupHeader HdrTransferEncoding hdrs
-            cl = lookupHeader HdrContentLength hdrs
-	    bo = bufferOps
+   processRequest (rm,uri,hdrs) =
+      fmapE (\ (ftrs,bdy) -> Right (Request uri rm (hdrs++ftrs) bdy)) $
+	     maybe 
+	      (maybe (return (Right ([], buf_empty bo))) -- hopefulTransfer ""
+	             (\ x -> readsOne (linearTransfer (readBlock conn))
+			              (return$responseParseError "unrecognized Content-Length value" x)
+				      x)
+				      
+		     cl)
+  	      (ifChunked (chunkedTransfer bo (readLine conn) (readBlock conn))
+	                 (uglyDeathTransfer "receiveHTTP"))
+              tc
+    where
+     -- FIXME : Also handle 100-continue.
+     tc = lookupHeader HdrTransferEncoding hdrs
+     cl = lookupHeader HdrContentLength hdrs
+     bo = bufferOps
 
 -- | Very simple function, send a HTTP response over the given stream. This 
 --   could be improved on to use different transfer types.
-respondHTTP :: HStream ty => HandleStream ty -> HTTPResponse ty -> IO ()
+respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
 respondHTTP conn rsp = do 
   writeBlock conn (buf_fromStr bufferOps $ show rsp)
    -- write body immediately, don't wait for 100 CONTINUE
   writeBlock conn (rspBody rsp)
   return ()
+
+------------------------------------------------------------------------------
+
+readsOne :: Read a => (a -> b) -> b -> String -> b
+readsOne f n str = 
+ case reads str of
+   ((v,_):_) -> f v
+   _ -> n
+
+headerName :: String -> String
+headerName x = map toLower (trim x)
+
+ifChunked :: a -> a -> String -> a
+ifChunked a b s = 
+  case headerName s of
+    "chunked" -> a
+    _ -> b
+
diff --git a/Network/HTTP/Headers.hs b/Network/HTTP/Headers.hs
--- a/Network/HTTP/Headers.hs
+++ b/Network/HTTP/Headers.hs
@@ -60,14 +60,14 @@
    ) where
 
 import Data.Char (toLower)
-import Network.Stream (Result, ConnError(ErrorParse))
+import Network.Stream (Result, failParse)
 import Network.HTTP.Utils ( trim, split, crlf )
 
 -- | The @Header@ data type pairs header names & values.
 data Header = Header HeaderName String
 
 instance Show Header where
-    show (Header key value) = show key ++ ": " ++ value ++ crlf
+    show (Header key value) = shows key (':':' ':value ++ crlf)
 
 -- | HTTP Header Name type:
 --  Why include this at all?  I have some reasons
@@ -257,8 +257,8 @@
 parseHeader :: String -> Result Header
 parseHeader str =
     case split ':' str of
-        Nothing -> Left (ErrorParse $ "Unable to parse header: " ++ str)
-        Just (k,v) -> Right $ Header (fn k) (trim $ drop 1 v)
+        Nothing -> failParse ("Unable to parse header: " ++ str)
+        Just (k,v) -> return $ Header (fn k) (trim $ drop 1 v)
     where
         fn k = case map snd $ filter (match k . fst) headerMap of
                  [] -> (HdrCustom k)
@@ -273,17 +273,19 @@
    where
         -- Joins consecutive lines where the second line
         -- begins with ' ' or '\t'.
+        joinExtended old      [] = [old]
         joinExtended old (h : t)
-            | not (null h) && (head h == ' ' || head h == '\t')
-                = joinExtended (old ++ ' ' : tail h) t
-            | otherwise = old : joinExtended h t
-        joinExtended old [] = [old]
+	  | isLineExtension h    = joinExtended (old ++ ' ' : tail h) t
+          | otherwise            = old : joinExtended h t
+	
+	isLineExtension (x:_) = x == ' ' || x == '\t'
+	isLineExtension _ = False
 
         clean [] = []
         clean (h:t) | h `elem` "\t\r\n" = ' ' : clean t
                     | otherwise = h : clean t
 
-        -- tollerant of errors?  should parse
+        -- tolerant of errors?  should parse
         -- errors here be reported or ignored?
         -- currently ignored.
         catRslts :: [a] -> [Result a] -> Result [a]
diff --git a/Network/HTTP/Stream.hs b/Network/HTTP/Stream.hs
--- a/Network/HTTP/Stream.hs
+++ b/Network/HTTP/Stream.hs
@@ -96,11 +96,11 @@
 module Network.HTTP.Stream 
        ( module Network.Stream
 
-       , simpleHTTP     -- :: Request -> IO (Result Response)
-       , simpleHTTP_    -- :: Stream s => s -> Request -> IO (Result Response)
-       , sendHTTP       -- :: Stream s => s -> Request -> IO (Result Response)
-       , receiveHTTP    -- :: Stream s => s -> IO (Result Request)
-       , respondHTTP    -- :: Stream s => s -> Response -> IO ()
+       , simpleHTTP     -- :: Request_String -> IO (Result Response_String)
+       , simpleHTTP_    -- :: Stream s => s -> Request_String -> IO (Result Response_String)
+       , sendHTTP       -- :: Stream s => s -> Request_String -> IO (Result Response_String)
+       , receiveHTTP    -- :: Stream s => s -> IO (Result Request_String)
+       , respondHTTP    -- :: Stream s => s -> Response_String -> IO ()
        
        ) where
 
@@ -141,7 +141,7 @@
 --              requires a Host header.
 --  Connection  Where no allowance is made for persistant connections
 --              the Connection header will be set to "close"
-simpleHTTP :: Request -> IO (Result Response)
+simpleHTTP :: Request_String -> IO (Result Response_String)
 simpleHTTP r = 
     do 
        auth <- getAuth r
@@ -149,11 +149,11 @@
        simpleHTTP_ c r
 
 -- | Like 'simpleHTTP', but acting on an already opened stream.
-simpleHTTP_ :: Stream s => s -> Request -> IO (Result Response)
+simpleHTTP_ :: Stream s => s -> Request_String -> IO (Result Response_String)
 simpleHTTP_ s r =
     do 
        auth <- getAuth r
-       let r' = normalizeRequestURI auth r 
+       let r' = normalizeRequestURI (host auth) r 
        rsp <- if debug then do
 	        s' <- debugStream httpLogFile s
 	        sendHTTP s' r'
@@ -163,7 +163,7 @@
        --; close s 
        return rsp
 
-sendHTTP :: Stream s => s -> Request -> IO (Result Response)
+sendHTTP :: Stream s => s -> Request_String -> IO (Result Response_String)
 sendHTTP conn rq = 
     do { let a_rq = normalizeHostHeader rq
        ; rsp <- catchIO (main a_rq)
@@ -186,7 +186,7 @@
 -- for an indefinite period before sending the request body.'
 --
 -- Since we would wait forever, I have disabled use of 100-continue for now.
-        main :: Request -> IO (Result Response)
+        main :: Request_String -> IO (Result Response_String)
         main rqst =
             do 
 	       --let str = if null (rqBody rqst)
@@ -202,7 +202,7 @@
         getResponseHead :: IO (Result ResponseData)
         getResponseHead =
             do { lor <- readTillEmpty1 stringBufferOp (readLine conn)
-               ; return $ lor `bindE` parseResponseHead
+               ; return $ lor >>= parseResponseHead
                }
 
         -- Hmmm, this could go bad if we keep getting "100 Continue"
@@ -211,8 +211,8 @@
         switchResponse :: Bool {- allow retry? -}
                        -> Bool {- is body sent? -}
                        -> Result ResponseData
-                       -> Request
-                       -> IO (Result Response)
+                       -> Request_String
+                       -> IO (Result Response_String)
             
         switchResponse _ _ (Left e) _ = return (Left e)
                 -- retry on connreset?
@@ -248,7 +248,7 @@
                     return (Right $ Response cd rn hdrs "")
 
                 DieHorribly str ->
-                    return $ Left $ ErrorParse ("Invalid response: " ++ str)
+                    return $ responseParseError "sendHTTP" ("Invalid response: " ++ str)
 
                 ExpectEntity ->
                     let tc = lookupHeader HdrTransferEncoding hdrs
@@ -263,20 +263,22 @@
                               case map toLower (trim x) of
                                   "chunked" -> chunkedTransfer stringBufferOp
 				                               (readLine conn) (readBlock conn)
-                                  _         -> uglyDeathTransfer
-                       ; return $ rslt `bindE` \(ftrs,bdy) -> Right (Response cd rn (hdrs++ftrs) bdy) 
+                                  _         -> uglyDeathTransfer "sendHTTP"
+                       ; return $ do
+		            (ftrs,bdy) <- rslt
+			    return (Response cd rn (hdrs++ftrs) bdy)
                        }
 
 -- | Receive and parse a HTTP request from the given Stream. Should be used 
 --   for server side interactions.
-receiveHTTP :: Stream s => s -> IO (Result Request)
+receiveHTTP :: Stream s => s -> IO (Result Request_String)
 receiveHTTP conn = getRequestHead >>= processRequest
     where
         -- reads and parses headers
         getRequestHead :: IO (Result RequestData)
         getRequestHead =
             do { lor <- readTillEmpty1 stringBufferOp (readLine conn)
-               ; return $ lor `bindE` parseRequestHead
+               ; return $ lor >>= parseRequestHead
                }
 	
         processRequest (Left e) = return $ Left e
@@ -293,14 +295,15 @@
                               case map toLower (trim x) of
                                   "chunked" -> chunkedTransfer stringBufferOp
 				                               (readLine conn) (readBlock conn)
-                                  _         -> uglyDeathTransfer
+                                  _         -> uglyDeathTransfer "receiveHTTP"
                
-               return $ rslt `bindE` \(ftrs,bdy) -> Right (Request uri rm (hdrs++ftrs) bdy)
-
+               return $ do
+	          (ftrs,bdy) <- rslt
+		  return (Request uri rm (hdrs++ftrs) bdy)
 
 -- | Very simple function, send a HTTP response over the given stream. This 
 --   could be improved on to use different transfer types.
-respondHTTP :: Stream s => s -> Response -> IO ()
+respondHTTP :: Stream s => s -> Response_String -> IO ()
 respondHTTP conn rsp = do writeBlock conn (show rsp)
                           -- write body immediately, don't wait for 100 CONTINUE
                           writeBlock conn (rspBody rsp)
diff --git a/Network/Stream.hs b/Network/Stream.hs
--- a/Network/Stream.hs
+++ b/Network/Stream.hs
@@ -25,8 +25,14 @@
    , ConnError(..)
    , Result
    , bindE
+   , fmapE
+
+   , failParse -- :: String -> Result a
+   , failWith  -- :: ConnError -> Result a
    ) where
 
+import Control.Monad.Error
+
 data ConnError 
  = ErrorReset 
  | ErrorClosed
@@ -34,10 +40,27 @@
  | ErrorMisc String
    deriving(Show,Eq)
 
+instance Error ConnError where
+  noMsg = strMsg "unknown error"
+  strMsg x = ErrorMisc x
+
+failParse :: String -> Result a
+failParse x = failWith (ErrorParse x)
+
+failWith :: ConnError -> Result a
+failWith x = Left x
+
 bindE :: Result a -> (a -> Result b) -> Result b
 bindE (Left e)  _ = Left e
 bindE (Right v) f = f v
 
+fmapE :: (a -> Result b) -> IO (Result a) -> IO (Result b)
+fmapE f a = do
+ x <- a
+ case x of
+   Left  e -> return (Left e)
+   Right r -> return (f r) 
+  
 -- | This is the type returned by many exported network functions.
 type Result a = Either ConnError   {- error  -}
                        a           {- result -}
diff --git a/Network/TCP.hs b/Network/TCP.hs
--- a/Network/TCP.hs
+++ b/Network/TCP.hs
@@ -50,6 +50,7 @@
 import Network.Stream
    ( ConnError(..)
    , Result
+   , failWith
    )
 import Network.BufferType
 
@@ -57,7 +58,6 @@
 import Network.Socket ( socketToHandle )
 
 import Data.Char  ( toLower )
-import Data.Maybe ( fromMaybe )
 import Data.Word  ( Word8 )
 import Control.Concurrent
 import Control.Monad ( liftM )
@@ -247,86 +247,74 @@
 
 
 readBlockBS :: HandleStream a -> Int -> IO (Result a)
-readBlockBS ref n = do
-   conn <- readMVar (getRef ref)
-   x <- 
-    case conn of
-     ConnClosed -> return (Left ErrorClosed)
-     MkConn{}   -> bufferGetBlock ref n -- (connBuffer conn) (connInput conn) (connHandle conn) n
-   fromMaybe (return ()) (fmap (\ h -> hook_readBlock h (buf_toStr $ connBuffer conn) n x) (connHooks' conn))
+readBlockBS ref n = onNonClosedDo ref $ \ conn -> do
+   x <- bufferGetBlock ref n
+   maybe (return ())
+         (\ h -> hook_readBlock h (buf_toStr $ connBuffer conn) n x)
+	 (connHooks' conn)
    return x
 
 -- This function uses a buffer, at this time the buffer is just 1000 characters.
 -- (however many bytes this is is left to the user to decypher)
 readLineBS :: HandleStream a -> IO (Result a)
-readLineBS ref = do
-   conn <- readMVar (getRef ref)
-   x <- 
-    case conn of
-     ConnClosed -> return (Left ErrorClosed)
-     MkConn{}   -> bufferReadLine ref -- (connBuffer conn) (connHandle conn) (connInput conn)
-   fromMaybe (return ()) (fmap (\ h -> hook_readLine h (buf_toStr $ connBuffer conn) x) (connHooks' conn))
+readLineBS ref = onNonClosedDo ref $ \ conn -> do
+   x <- bufferReadLine ref
+   maybe (return ())
+         (\ h -> hook_readLine h (buf_toStr $ connBuffer conn) x)
+	 (connHooks' conn)
    return x
 
 -- The 'Connection' object allows no outward buffering, 
 -- since in general messages are serialised in their entirety.
 writeBlockBS :: HandleStream a -> a -> IO (Result ())
-writeBlockBS ref b = do
-  conn <- readMVar (getRef ref)
-  x    <- 
-   case conn of
-    ConnClosed -> return (Left ErrorClosed)
-    MkConn{} -> bufferPutBlock (connBuffer conn) (connHandle conn) b
-  fromMaybe (return ()) (fmap (\ h -> hook_writeBlock h (buf_toStr $ connBuffer conn) b x) (connHooks' conn))
+writeBlockBS ref b = onNonClosedDo ref $ \ conn -> do
+  x    <- bufferPutBlock (connBuffer conn) (connHandle conn) b
+  maybe (return ())
+        (\ h -> hook_writeBlock h (buf_toStr $ connBuffer conn) b x)
+	(connHooks' conn)
   return x
 
 closeIt :: HandleStream ty -> (ty -> Bool) -> IO ()
 closeIt c p = do
   closeConnection c (readLineBS c >>= \ x -> case x of { Right xs -> return (p xs); _ -> return True})
   conn <- readMVar (getRef c)
-  fromMaybe (return ()) (fmap (\ h -> hook_close h) (connHooks' conn))
-
+  maybe (return ())
+        (hook_close)
+	(connHooks' conn)
 
 bufferGetBlock :: HandleStream a -> Int -> IO (Result a)
-bufferGetBlock ref n = do
-   conn <- readMVar (getRef ref)
-   case conn of
-     ConnClosed -> return (Left ErrorClosed)
-     MkConn{} -> do
-       case connInput conn of
-         Just c -> do
-	   let (a,b) = buf_splitAt (connBuffer conn) n c
-	   modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b})
-	   return (Right a)
-         _ -> do
-	   Prelude.catch (buf_hGet (connBuffer conn) (connHandle conn) n >>= return.Right)
-                         (\ e -> if isEOFError e 
-			          then return (Right (buf_empty (connBuffer conn)))
-				  else return (Left (ErrorMisc (show e))))
+bufferGetBlock ref n = onNonClosedDo ref $ \ conn -> do
+   case connInput conn of
+    Just c -> do
+      let (a,b) = buf_splitAt (connBuffer conn) n c
+      modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b})
+      return (return a)
+    _ -> do
+      Prelude.catch (buf_hGet (connBuffer conn) (connHandle conn) n >>= return.return)
+                    (\ e -> if isEOFError e 
+			     then return (return (buf_empty (connBuffer conn)))
+			     else return (fail (show e)))
 
 bufferPutBlock :: BufferOp a -> Handle -> a -> IO (Result ())
 bufferPutBlock ops h b = 
-  Prelude.catch (buf_hPut ops h b >> hFlush h >> return (Right ()))
-                (\ e -> return (Left (ErrorMisc (show e))))
+  Prelude.catch (buf_hPut ops h b >> hFlush h >> return (return ()))
+                (\ e -> return (fail (show e)))
 
 bufferReadLine :: HandleStream a -> IO (Result a) -- BufferOp a -> Handle -> IO (Result a)
-bufferReadLine ref = do
-  conn <- readMVar (getRef ref)
-  case conn of
-    ConnClosed -> return (Left ErrorClosed)
-    MkConn{} -> do
-      case connInput conn of
-        Just c -> do
-	  let (a,b0)  = buf_span (connBuffer conn) (/='\n') c
-	  let (newl,b1) = buf_splitAt (connBuffer conn) 1 b0
-	  modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b1})
-	  return (Right (buf_append (connBuffer conn) a newl))
-	_ -> Prelude.catch 
-              (buf_hGetLine (connBuffer conn) (connHandle conn) >>= return . Right . appendNL (connBuffer conn))
+bufferReadLine ref = onNonClosedDo ref $ \ conn -> do
+  case connInput conn of
+   Just c -> do
+    let (a,b0)  = buf_span (connBuffer conn) (/='\n') c
+    let (newl,b1) = buf_splitAt (connBuffer conn) 1 b0
+    modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b1})
+    return (return (buf_append (connBuffer conn) a newl))
+   _ -> Prelude.catch 
+              (buf_hGetLine (connBuffer conn) (connHandle conn) >>= 
+	            return . return . appendNL (connBuffer conn))
               (\ e -> 
                  if isEOFError e
-                  then return (Right (buf_empty (connBuffer conn)))
-                  else return (Left (ErrorMisc (show e))))
+                  then return (return   (buf_empty (connBuffer conn)))
+                  else return (fail (show e)))
  where
    -- yes, this s**ks.. _may_ have to be addressed if perf
    -- suggests worthiness.
@@ -334,3 +322,11 @@
   
   nl :: Word8
   nl = fromIntegral (fromEnum '\n')
+
+onNonClosedDo :: HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
+onNonClosedDo h act = do
+  x <- readMVar (getRef h)
+  case x of
+    ConnClosed{} -> return (failWith ErrorClosed)
+    c -> act c
+