diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index a50dd6b8a8fea3ba4143d89062d8886faddc680f..c678865d49ae9d9fed160fe1c0ca5d64922c3f32 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -27,6 +27,10 @@ import Network.Browser import Control.Applicative #endif import qualified Control.Exception as Exception +import Control.Exception + ( evaluate ) +import Control.DeepSeq + ( force ) import Control.Monad ( when, guard ) import qualified Data.ByteString.Lazy.Char8 as BS @@ -56,6 +60,8 @@ import System.FilePath ( (<.>) ) import System.Directory ( doesFileExist, renameFile ) +import System.IO + ( withFile, IOMode(ReadMode), hGetContents, hClose ) import System.IO.Error ( isDoesNotExistError ) import Distribution.Simple.Program @@ -70,7 +76,6 @@ import Distribution.Simple.Program.Run ( IOEncoding(..), getEffectiveEnvironment ) import Numeric (showHex) import System.Directory (canonicalizePath) -import System.IO (hClose) import System.FilePath (takeFileName, takeDirectory) import System.Random (randomRIO) import System.Exit (ExitCode(..)) @@ -340,9 +345,10 @@ curlTransport prog = resp <- getProgramInvocationOutput verbosity (programInvocation prog args) - headers <- readFile tmpFile - (code, _err, etag') <- parseResponse uri resp headers - return (code, etag') + withFile tmpFile ReadMode $ \hnd -> do + headers <- hGetContents hnd + (code, _err, etag') <- parseResponse uri resp headers + evaluate $ force (code, etag') posthttp = noPostYet @@ -387,8 +393,9 @@ curlTransport prog = (code, err, _etag) <- parseResponse uri resp "" return (code, err) - -- on success these curl involcations produces an output like "200" + -- on success these curl invocations produces an output like "200" -- and on failure it has the server error response first + parseResponse :: URI -> String -> String -> IO (Int, String, Maybe ETag) parseResponse uri resp headers = let codeerr = case reverse (lines resp) of @@ -450,8 +457,9 @@ wgetTransport prog = "boundary=" ++ boundary ] out <- runWGet verbosity (addUriAuth auth uri) args (code, _etag) <- parseOutput uri out - resp <- readFile responseFile - return (code, resp) + withFile responseFile ReadMode $ \hnd -> do + resp <- hGetContents hnd + evaluate $ force (code, resp) puthttpfile verbosity uri path auth headers = withTempFile (takeDirectory path) "response" $ \responseFile responseHandle -> do @@ -466,8 +474,9 @@ wgetTransport prog = out <- runWGet verbosity (addUriAuth auth uri) args (code, _etag) <- parseOutput uri out - resp <- readFile responseFile - return (code, resp) + withFile responseFile ReadMode $ \hnd -> do + resp <- hGetContents hnd + evaluate $ force (code, resp) addUriAuth Nothing uri = uri addUriAuth (Just (user, pass)) uri = uri diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index f9357d6e4cca2e5b677612d9c721c816802193a2..78cbe6f1113a413645e1125c47eef4f266c5afaf 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -367,6 +367,7 @@ executable cabal Cabal >= 1.25 && < 1.26, containers >= 0.4 && < 0.6, cryptohash-sha256 >= 0.11 && < 0.12, + deepseq >= 1.3 && < 1.5, filepath >= 1.3 && < 1.5, hashable >= 1.0 && < 2, HTTP >= 4000.1.5 && < 4000.4, @@ -453,6 +454,7 @@ Test-Suite unit-tests bytestring, Cabal, containers, + deepseq, mtl, pretty, process, @@ -613,6 +615,7 @@ test-suite integration-tests2 Cabal, containers, cryptohash-sha256, + deepseq, directory, filepath, hackage-security,