Code/warnings cleanup

http-client/ChangeLog.md

@@ -1,3 +1,7 @@
+## Unreleased
+
+* Code cleanup/delete dead code
+
 ## 0.5.7.0
 
 * Support for Windows system proxy settings

http-client/Network/HTTP/Client.hs

@@ -236,8 +236,8 @@ data HistoriedResponse body = HistoriedResponse
 --
 -- Since 0.4.1
 responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader)
-responseOpenHistory req0 man0 = handle (throwIO . toHttpException req0) $ do
-    reqRef <- newIORef req0
+responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do
+    reqRef <- newIORef reqOrig
     historyRef <- newIORef id
     let go req0 = do
             (man, req) <- getModifiedRequestManager man0 req0
@@ -257,7 +257,7 @@ responseOpenHistory req0 man0 = handle (throwIO . toHttpException req0) $ do
                     body <- brReadSome (responseBody res) 1024
                     modifyIORef historyRef (. ((req, res { responseBody = body }):))
                     return (res, req'', True)
-    (_, res) <- httpRedirect' (redirectCount req0) go req0
+    (_, res) <- httpRedirect' (redirectCount reqOrig) go reqOrig
     reqFinal <- readIORef reqRef
     history <- readIORef historyRef
     return HistoriedResponse

http-client/Network/HTTP/Client/Core.hs

@@ -14,9 +14,6 @@ module Network.HTTP.Client.Core
     , httpRedirect'
     ) where
 
-#if !MIN_VERSION_base(4,6,0)
-import Prelude hiding (catch)
-#endif
 import Network.HTTP.Types
 import Network.HTTP.Client.Manager
 import Network.HTTP.Client.Types
@@ -250,7 +247,7 @@ httpRedirect' count0 http' req0 = go count0 req0 []
                 -- The connection may already be closed, e.g.
                 -- when using withResponseHistory. See
                 -- https://github.com/snoyberg/http-client/issues/169
-                `catch` \se ->
+                `Control.Exception.catch` \se ->
                     case () of
                       ()
                         | Just ConnectionClosed <-

http-client/Network/HTTP/Client/Headers.hs

@@ -12,7 +12,7 @@ import qualified Data.ByteString.Char8          as S8
 import qualified Data.CaseInsensitive           as CI
 import           Network.HTTP.Client.Connection
 import           Network.HTTP.Client.Types
-import           Network.HTTP.Client.Util       (timeout)
+import           System.Timeout                 (timeout)
 import           Network.HTTP.Types
 import Data.Word (Word8)
 

http-client/Network/HTTP/Client/Manager.hs

@@ -22,23 +22,13 @@ module Network.HTTP.Client.Manager
     , dropProxyAuthSecure
     ) where
 
-#ifndef MIN_VERSION_base
-#define MIN_VERSION_base(x,y,z) 1
-#endif
-#if !MIN_VERSION_base(4,6,0)
-import Prelude hiding (catch)
-#endif
-import Control.Applicative ((<|>))
-import Control.Arrow (first)
 import qualified Data.IORef as I
 import qualified Data.Map as Map
 
 import qualified Data.ByteString.Char8 as S8
 
-import Data.Char (toLower)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Read (decimal)
 
 import Control.Monad (unless, join, void)
 import Control.Exception (mask_, catch, throwIO, fromException, mask, IOException, Exception (..), handle)
@@ -52,12 +42,8 @@ import Network.HTTP.Types (status200)
 import Network.HTTP.Client.Types
 import Network.HTTP.Client.Connection
 import Network.HTTP.Client.Headers (parseStatusHeaders)
-import Network.HTTP.Client.Request (applyBasicProxyAuth, extractBasicAuthInfo)
 import Network.HTTP.Proxy
 import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar)
-import System.Environment (getEnvironment)
-import qualified Network.URI as U
-import Control.Monad (guard)
 
 -- | A value for the @managerRawConnection@ setting, but also allows you to
 -- modify the underlying @Socket@ to set additional settings. For a motivating
@@ -325,7 +311,7 @@ withManager settings f = newManager settings >>= f
 {-# DEPRECATED withManager "Use newManager instead" #-}
 
 safeConnClose :: Connection -> IO ()
-safeConnClose ci = connectionClose ci `catch` \(_ :: IOException) -> return ()
+safeConnClose ci = connectionClose ci `Control.Exception.catch` \(_ :: IOException) -> return ()
 
 nonEmptyMapM_ :: Monad m => (a -> m ()) -> NonEmptyList a -> m ()
 nonEmptyMapM_ f (One x _) = f x

http-client/Network/HTTP/Client/Request.hs

@@ -32,7 +32,7 @@ module Network.HTTP.Client.Request
 
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe, isJust, isNothing)
-import Data.Monoid (mempty, mappend)
+import Data.Monoid (mempty, mappend, (<>))
 import Data.String (IsString(..))
 import Data.Char (toLower)
 import Control.Applicative as A ((<$>))
@@ -140,17 +140,7 @@ parseRequest_ = either throw id . parseRequest
 -- | Add a 'URI' to the request. If it is absolute (includes a host name), add
 -- it as per 'setUri'; if it is relative, merge it with the existing request.
 setUriRelative :: MonadThrow m => Request -> URI -> m Request
-setUriRelative req uri =
-#ifndef MIN_VERSION_network
-#define MIN_VERSION_network(x,y,z) 1
-#endif
-#if MIN_VERSION_network(2,4,0)
-    setUri req $ uri `relativeTo` getUri req
-#else
-    case uri `relativeTo` getUri req of
-        Just uri' -> setUri req uri'
-        Nothing   -> throwM $ InvalidUrlException (show uri) "Invalid URL"
-#endif
+setUriRelative req uri = setUri req $ uri `relativeTo` getUri req
 
 -- | Extract a 'URI' from the request.
 --

http-client/Network/HTTP/Client/Response.hs

@@ -8,6 +8,7 @@ module Network.HTTP.Client.Response
     , lbsResponse
     ) where
 
+import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as L
 
@@ -119,3 +120,12 @@ getResponse connRelease timeout' req@(Request {..}) conn cont = do
         , responseCookieJar = Data.Monoid.mempty
         , responseClose' = ResponseClose (cleanup False)
         }
+
+-- | Does this response have no body?
+hasNoBody :: ByteString -- ^ request method
+          -> Int -- ^ status code
+          -> Bool
+hasNoBody "HEAD" _ = True
+hasNoBody _ 204 = True
+hasNoBody _ 304 = True
+hasNoBody _ i = 100 <= i && i < 200

http-client/Network/HTTP/Client/Util.hs

@@ -5,169 +5,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 module Network.HTTP.Client.Util
-    ( hGetSome
-    , (<>)
-    , readDec
-    , hasNoBody
-    , fromStrict
-    , timeout
+    ( readDec
     ) where
 
-import Data.Monoid (Monoid, mappend)
-
-import qualified Data.ByteString.Char8 as S8
-
-#ifndef MIN_VERSION_bytestring
-#define MIN_VERSION_bytestring(x,y,z) 1
-#endif
-
-#if MIN_VERSION_bytestring(0,10,0)
-import Data.ByteString.Lazy (fromStrict)
-#else
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as S
-#endif
-
 import qualified Data.Text as T
 import qualified Data.Text.Read
-import System.Timeout (timeout)
-
-#ifndef MIN_VERSION_base
-#define MIN_VERSION_base(x,y,z) 1
-#endif
-#if MIN_VERSION_base(4,3,0)
-import Data.ByteString (hGetSome)
-#else
-import GHC.IO.Handle.Types
-import System.IO                (hWaitForInput, hIsEOF)
-import System.IO.Error          (mkIOError, illegalOperationErrorType)
-
--- | Like 'hGet', except that a shorter 'ByteString' may be returned
--- if there are not enough bytes immediately available to satisfy the
--- whole request.  'hGetSome' only blocks if there is no data
--- available, and EOF has not yet been reached.
-hGetSome :: Handle -> Int -> IO S.ByteString
-hGetSome hh i
-    | i >  0    = let
-                   loop = do
-                     s <- S.hGetNonBlocking hh i
-                     if not (S.null s)
-                        then return s
-                        else do eof <- hIsEOF hh
-                                if eof then return s
-                                       else hWaitForInput hh (-1) >> loop
-                                         -- for this to work correctly, the
-                                         -- Handle should be in binary mode
-                                         -- (see GHC ticket #3808)
-                  in loop
-    | i == 0    = return S.empty
-    | otherwise = illegalBufferSize hh "hGetSome" i
-
-illegalBufferSize :: Handle -> String -> Int -> IO a
-illegalBufferSize handle fn sz =
-    ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)
-    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
-    where
-      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []
-#endif
-
-infixr 5 <>
-(<>) :: Data.Monoid.Monoid m => m -> m -> m
-(<>) = Data.Monoid.mappend
 
 readDec :: Integral i => String -> Maybe i
 readDec s =
     case Data.Text.Read.decimal $ T.pack s of
         Right (i, t)
             | T.null t -> Just i
         _ -> Nothing
-
-hasNoBody :: S8.ByteString -- ^ request method
-          -> Int -- ^ status code
-          -> Bool
-hasNoBody "HEAD" _ = True
-hasNoBody _ 204 = True
-hasNoBody _ 304 = True
-hasNoBody _ i = 100 <= i && i < 200
-
-#if !MIN_VERSION_bytestring(0,10,0)
-{-# INLINE fromStrict #-}
-fromStrict :: S.ByteString -> L.ByteString
-fromStrict x = L.fromChunks [x]
-#endif
-
--- Disabling the custom timeout code for now. See: https://github.com/snoyberg/http-client/issues/116
-{-
-data TimeoutHandler = TimeoutHandler {-# UNPACK #-} !TimeSpec (IO ())
-newtype TimeoutManager = TimeoutManager (IORef ([TimeoutHandler], Bool))
-
-newTimeoutManager :: IO TimeoutManager
-newTimeoutManager = fmap TimeoutManager $ newIORef ([], False)
-
-timeoutManager :: TimeoutManager
-timeoutManager = unsafePerformIO newTimeoutManager
-{-# NOINLINE timeoutManager #-}
-
-spawnWorker :: TimeoutManager -> IO ()
-spawnWorker (TimeoutManager ref) = void $ forkIO $ fix $ \loop -> do
-    threadDelay 500000
-    join $ atomicModifyIORef ref $ \(hs, isCleaning) -> assert (not isCleaning) $
-        if null hs
-            then (([], False), return ())
-            else (([], True), ) $ do
-                now <- getTime Monotonic
-                front <- go now id hs
-                atomicModifyIORef ref $ \(hs', isCleaning') ->
-                    assert isCleaning' $ ((front hs', False), ())
-                loop
-  where
-    go now =
-        go'
-      where
-        go' front [] = return front
-        go' front (h@(TimeoutHandler time action):hs)
-            | time < now = do
-                _ :: Either SomeException () <- try action
-                go' front hs
-            | otherwise = go' (front . (h:)) hs
-
-addHandler :: TimeoutManager -> TimeoutHandler -> IO ()
-addHandler man@(TimeoutManager ref) h = mask_ $ join $ atomicModifyIORef ref
-    $ \(hs, isCleaning) ->
-        let hs' = h : hs
-            action
-                | isCleaning || not (null hs) = return ()
-                | otherwise = spawnWorker man
-         in ((hs', isCleaning), action)
-
--- | Has same semantics as @System.Timeout.timeout@, but implemented in such a
--- way to avoid high-concurrency contention issues. See:
---
--- https://github.com/snoyberg/http-client/issues/98
-timeout :: Int -> IO a -> IO (Maybe a)
-timeout delayU inner = do
-    TimeSpec nowS nowN <- getTime Monotonic
-    let (delayS, delayU') = delayU `quotRem` 1000000
-        delayN = delayU' * 1000
-        stopN' = nowN + delayN
-        stopS' = nowS + delayS
-        (stopN, stopS)
-            | stopN' > 1000000000 = (stopN' - 1000000000, stopS' + 1)
-            | otherwise = (stopN', stopS')
-        toStop = TimeSpec stopS stopN
-    toThrow <- newIORef True
-    tid <- myThreadId
-    let handler = TimeoutHandler toStop $ do
-            toThrow' <- readIORef toThrow
-            when toThrow' $ throwTo tid TimeoutTriggered
-    eres <- try $ do
-        addHandler timeoutManager handler
-        inner `finally` writeIORef toThrow False
-    return $ case eres of
-        Left TimeoutTriggered -> Nothing
-        Right x -> Just x
-
-data TimeoutTriggered = TimeoutTriggered
-    deriving (Show, Typeable)
-instance Exception TimeoutTriggered
--}

http-client/Network/HTTP/Proxy.hs

@@ -56,7 +56,7 @@ module Network.HTTP.Proxy(  ProxyProtocol(..), EnvHelper(..),
                             httpProtocol,
                             ProxySettings ) where
 
-import           Control.Applicative         ((<$>), (<|>))
+import qualified Control.Applicative         as A
 import           Control.Arrow               (first)
 import           Control.Monad               (guard)
 import qualified Data.ByteString.Char8       as S8
@@ -99,8 +99,8 @@ instance Show ProxyProtocol where
     show HTTPProxy  = "http"
     show HTTPSProxy = "https"
 
-data ProxySettings = ProxySettings { proxyHost :: Proxy,
-                                     proxyAuth :: Maybe (UserName, Password) }
+data ProxySettings = ProxySettings { _proxyHost :: Proxy,
+                                     _proxyAuth :: Maybe (UserName, Password) }
                                      deriving Show
 
 httpProtocol :: Bool -> ProxyProtocol
@@ -114,7 +114,7 @@ data EnvHelper = EHFromRequest
 headJust :: [Maybe a] -> Maybe a
 headJust []               = Nothing
 headJust (Nothing:xs)     = headJust xs
-headJust ((y@(Just x)):_) = y
+headJust ((y@(Just _)):_) = y
 
 systemProxyHelper :: Maybe T.Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
 systemProxyHelper envOveride prot eh = do
@@ -171,7 +171,7 @@ registryProxyLoc = (hive, path)
 registryProxyString :: IO (Maybe (String, String))
 registryProxyString = catch
   (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do
-    enable <- toBool . maybe 0 id <$> regQueryValueDWORD hkey "ProxyEnable"
+    enable <- toBool . maybe 0 id A.<$> regQueryValueDWORD hkey "ProxyEnable"
     if enable
         then do
             server <- regQueryValue hkey (Just "ProxyServer")
@@ -318,7 +318,7 @@ regQueryValueDWORD :: HKEY -> String -> IO (Maybe DWORD)
 regQueryValueDWORD hkey name = alloca $ \ptr -> do
   key <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
   if key == rEG_DWORD then
-      Just <$> peek ptr
+      Just A.<$> peek ptr
   else return Nothing
 
 -- defined(mingw32_HOST_OS)
@@ -332,7 +332,7 @@ envHelper :: EnvName -> IO (HostAddress -> Maybe ProxySettings)
 envHelper name = do
   env <- getEnvironment
   let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env
-      lookupEnvVar n = lookup (T.unpack n) env <|> Map.lookup n lenv
+      lookupEnvVar n = lookup (T.unpack n) env A.<|> Map.lookup n lenv
       noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy")
 
   case lookupEnvVar name of

http-client/http-client.cabal

@@ -42,7 +42,7 @@ library
                      , http-types        >= 0.8
                      , blaze-builder     >= 0.3
                      , time              >= 1.2
-                     , network           >= 2.3
+                     , network           >= 2.4
                      , streaming-commons >= 0.1.0.2 && < 0.2
                      , containers
                      , transformers

http-client/test-nonet/Network/HTTP/Client/RequestSpec.hs

@@ -7,8 +7,9 @@ import Control.Monad (join, forM_, (<=<))
 import Data.IORef
 import Data.Maybe (isJust, fromMaybe, fromJust)
 import Network.HTTP.Client.Internal
-import Network.URI (URI(..), URIAuth(..), parseURI) 
+import Network.URI (URI(..), URIAuth(..), parseURI)
 import Test.Hspec
+import Data.Monoid ((<>))
 
 spec :: Spec
 spec = do