From 4a8d4dec2a2458a3eb4f7c3a785f447fef24422d Mon Sep 17 00:00:00 2001 From: Buck Evan Date: Sun, 10 Jun 2018 15:53:52 -0700 Subject: [PATCH 1/4] get-stack: check deps before sudo Don't need to invoke sudo if all deps are already installed. Avoiding the sudo prompt where possible is going to be an improvement. --- etc/scripts/get-stack.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/etc/scripts/get-stack.sh b/etc/scripts/get-stack.sh index 8433e0064e..77a6c26182 100755 --- a/etc/scripts/get-stack.sh +++ b/etc/scripts/get-stack.sh @@ -561,7 +561,9 @@ try_install_pkgs() { # Install packages using apt-get apt_get_install_pkgs() { - if ! sudocmd apt-get install -y ${QUIET:+-qq} "$@"; then + if dpkg-query -W "$@" > /dev/null; then + info "Already installed!" + elif ! sudocmd apt-get install -y ${QUIET:+-qq} "$@"; then die "Installing apt packages failed. Please run 'apt-get update' and try again." fi } From edc630463d949a7efc392c200bcc48acc9cb419b Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 26 Jun 2018 16:24:43 +0300 Subject: [PATCH 2/4] Deprecate the --upgrade-cabal flag (fixes #4070) --- ChangeLog.md | 6 ++++++ doc/GUIDE.md | 4 ---- src/Stack/Setup.hs | 7 ++++++- src/Stack/SetupCmd.hs | 2 +- 4 files changed, 13 insertions(+), 6 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index ec8b2dff9c..3569350b4d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -14,6 +14,12 @@ Behavior changes: * `stack build` will now announce when sublibraries of a package are being build, in the same way executables, tests, benchmarks and libraries are announced +* The `--upgrade-cabal` option to `stack setup` has been + deprecated. This feature no longer works with GHC 8.2 and + later. Furthermore, the reason for this flag originally being + implemented was drastically lessened once Stack started using the + snapshot's `Cabal` library for custom setups. See: + [#4070](https://github.com/commercialhaskell/stack/issues/4070). Other enhancements: diff --git a/doc/GUIDE.md b/doc/GUIDE.md index 36781d58d8..48c88aa875 100644 --- a/doc/GUIDE.md +++ b/doc/GUIDE.md @@ -1787,10 +1787,6 @@ users. Here's a quick rundown: * `stack upgrade` will build a new version of stack from source. * `--git` is a convenient way to get the most recent version from master for those testing and living on the bleeding edge. -* `stack setup --upgrade-cabal` can install a newer version of the Cabal - library, used for performing actual builds. You shouldn't generally do this, - since new Cabal versions may introduce incompatibilities with package sets, - but it can be useful if you're trying to test a specific bugfix. * `stack ls snapshots` will list all the local snapshots by default. You can also view the remote snapshots using `stack ls snapshots remote`. It also supports option for viewing only lts diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 5ac40f61b7..5055fcd04b 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -684,7 +684,8 @@ upgradeCabal :: (HasConfig env, HasGHCVariant env) -> UpgradeTo -> RIO env () upgradeCabal wc upgradeTo = do - logInfo "Manipulating the global Cabal is only for debugging purposes" + logWarn "Using deprecated --upgrade-cabal feature, this is not recommended" + logWarn "Manipulating the global Cabal is only for debugging purposes" let name = $(mkPackageName "Cabal") rmap <- resolvePackages Nothing mempty (Set.singleton name) installed <- getCabalPkgVer wc @@ -717,6 +718,10 @@ doCabalInstall :: (HasConfig env, HasGHCVariant env) -> Version -> RIO env () doCabalInstall wc installed wantedVersion = do + when (wantedVersion >= $(mkVersion "2.2")) $ do + logWarn "--upgrade-cabal will almost certainly fail for Cabal 2.2 or later" + logWarn "See: https://github.com/commercialhaskell/stack/issues/4070" + logWarn "Valiantly attempting to build it anyway, but I know this is doomed" withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do logInfo $ "Installing Cabal-" <> diff --git a/src/Stack/SetupCmd.hs b/src/Stack/SetupCmd.hs index 0f1e036ce1..5b25fb7494 100644 --- a/src/Stack/SetupCmd.hs +++ b/src/Stack/SetupCmd.hs @@ -63,7 +63,7 @@ cabalUpgradeParser = Specific <$> version' <|> latestParser <> OA.help "Install a specific version of Cabal" ) latestParser = OA.flag' Latest ( OA.long "upgrade-cabal" - <> OA.help "Install latest version of Cabal globally" ) + <> OA.help "DEPRECATED Install latest version of Cabal globally" ) setupParser :: OA.Parser SetupCmdOpts setupParser = SetupCmdOpts From 33e5a742d0e22d9f499a57e5ea3c2f6425496b4c Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Wed, 27 Jun 2018 08:38:55 +0200 Subject: [PATCH 3/4] Network stackclient refactor (#4119) --- .hlint.yaml | 41 +++++++++- .../Client/Repository/HttpLib/HttpClient.hs | 79 +++++++------------ src/Network/HTTP/Download.hs | 6 +- src/Network/HTTP/Download/Verified.hs | 5 +- src/Network/HTTP/StackClient.hs | 57 ++++++++++++- src/Stack/Config.hs | 4 +- src/Stack/Ls.hs | 8 +- src/Stack/New.hs | 2 +- src/Stack/PackageIndex.hs | 2 +- src/Stack/PackageLocation.hs | 2 +- src/Stack/Setup.hs | 2 +- src/Stack/Sig/Sign.hs | 4 +- src/Stack/Snapshot.hs | 2 +- src/Stack/Types/BuildPlan.hs | 2 +- src/Stack/Types/Resolver.hs | 2 +- src/Stack/Types/TemplateName.hs | 2 +- src/Stack/Upload.hs | 13 +-- .../Network/HTTP/Download/VerifiedSpec.hs | 2 +- 18 files changed, 142 insertions(+), 93 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index ddd2277f66..7b3944648b 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -45,12 +45,47 @@ - ignore: {name: "Use display", within: "warnMultiple"} - ignore: {name: "Use display", within: "Stack.PrettyPrint"} +- error: {lhs: "Network.HTTP.Client.MultipartFormData.formDataBody", rhs: "Network.HTTP.StackClient.formDataBody"} +- error: {lhs: "Network.HTTP.Client.MultipartFormData.partBS", rhs: "Network.HTTP.StackClient.partBS"} +- error: {lhs: "Network.HTTP.Client.MultipartFormData.partFileRequestBody", rhs: "Network.HTTP.StackClient.partFileRequestBody"} +- error: {lhs: "Network.HTTP.Client.MultipartFormData.partLBS", rhs: "Network.HTTP.StackClient.partLBS"} +- error: {lhs: "Network.HTTP.Client.Request.setUri", rhs: "Network.HTTP.StackClient.setUri"} +- error: {lhs: "Network.HTTP.Client.TLS.applyDigestAuth", rhs: "Network.HTTP.StackClient.applyDigestAuth"} +- error: {lhs: "Network.HTTP.Client.TLS.displayDigestAuthException", rhs: "Network.HTTP.StackClient.displayDigestAuthException"} +- error: {lhs: "Network.HTTP.Client.TLS.getGlobalManager", rhs: "Network.HTTP.StackClient.getGlobalManager"} +- error: {lhs: "Network.HTTP.Client.checkResponse", rhs: "Network.HTTP.StackClient.checkResponse"} +- error: {lhs: "Network.HTTP.Client.getUri", rhs: "Network.HTTP.StackClient.getUri"} +- error: {lhs: "Network.HTTP.Client.parseRequest", rhs: "Network.HTTP.StackClient.parseRequest"} +- error: {lhs: "Network.HTTP.Client.parseRequest_", rhs: "Network.HTTP.StackClient.parseRequest_"} +- error: {lhs: "Network.HTTP.Client.parseUrlThrow", rhs: "Network.HTTP.StackClient.parseUrlThrow"} +- error: {lhs: "Network.HTTP.Client.path", rhs: "Network.HTTP.StackClient.path"} +- error: {lhs: "Network.HTTP.Client.responseHeaders", rhs: "Network.HTTP.StackClient.responseHeaders"} +- error: {lhs: "Network.HTTP.Client.withResponse", rhs: "Network.HTTP.StackClient.withResponseByManager"} +- error: {lhs: "Network.HTTP.Conduit.requestHeaders", rhs: "Network.HTTP.StackClient.requestHeaders"} +- error: {lhs: "Network.HTTP.Simple.HttpException", rhs: "Network.HTTP.StackClient.HttpException"} +- error: {lhs: "Network.HTTP.Simple.addRequestHeader", rhs: "Network.HTTP.StackClient.addRequestHeader"} +- error: {lhs: "Network.HTTP.Simple.getResponseBody", rhs: "Network.HTTP.StackClient.getResponseBody"} +- error: {lhs: "Network.HTTP.Simple.getResponseHeaders", rhs: "Network.HTTP.StackClient.getResponseHeaders"} +- error: {lhs: "Network.HTTP.Simple.getResponseStatusCode", rhs: "Network.HTTP.StackClient.getResponseStatusCode"} - error: {lhs: "Network.HTTP.Simple.httpJSON", rhs: "Network.HTTP.StackClient.httpJSON"} -- error: {lhs: "Network.HTTP.Simple.httpLbs", rhs: "Network.HTTP.StackClient.httpLbs"} - error: {lhs: "Network.HTTP.Simple.httpLBS", rhs: "Network.HTTP.StackClient.httpLBS"} -- error: {lhs: "Network.HTTP.Simple.httpSink", rhs: "Network.HTTP.StackClient.httpSink"} +- error: {lhs: "Network.HTTP.Simple.httpLbs", rhs: "Network.HTTP.StackClient.httpLbs"} - error: {lhs: "Network.HTTP.Simple.httpNoBody", rhs: "Network.HTTP.StackClient.httpNoBody"} +- error: {lhs: "Network.HTTP.Simple.httpSink", rhs: "Network.HTTP.StackClient.httpSink"} +- error: {lhs: "Network.HTTP.Simple.setRequestBody", rhs: "Network.HTTP.StackClient.getRequestBody"} +- error: {lhs: "Network.HTTP.Simple.setRequestHeader", rhs: "Network.HTTP.StackClient.setRequestHeader"} +- error: {lhs: "Network.HTTP.Simple.setRequestManager", rhs: "Network.HTTP.StackClient.setRequestManager"} +- error: {lhs: "Network.HTTP.Simple.setRequestMethod", rhs: "Network.HTTP.StackClient.getRequestMethod"} - error: {lhs: "Network.HTTP.Simple.withResponse", rhs: "Network.HTTP.StackClient.withResponse"} -- error: {lhs: "Network.HTTP.Client.withResponse", rhs: "Network.HTTP.StackClient.withResponseByManager"} +- error: {lhs: "Network.HTTP.Types.Header", rhs: "Network.HTTP.StackClient.Header"} +- error: {lhs: "Network.HTTP.Types.HeaderName", rhs: "Network.HTTP.StackClient.HeaderName"} +- error: {lhs: "Network.HTTP.Types.Manager", rhs: "Network.HTTP.StackClient.Manager"} +- error: {lhs: "Network.HTTP.Types.Request", rhs: "Network.HTTP.StackClient.Request"} +- error: {lhs: "Network.HTTP.Types.RequestBody", rhs: "Network.HTTP.StackClient.RequestBody"} +- error: {lhs: "Network.HTTP.Types.Response", rhs: "Network.HTTP.StackClient.Response"} +- error: {lhs: "Network.HTTP.Types.hAccept", rhs: "Network.HTTP.StackClient.hAccept"} +- error: {lhs: "Network.HTTP.Types.hContentLength", rhs: "Network.HTTP.StackClient.hContentLength"} +- error: {lhs: "Network.HTTP.Types.hContentMD5", rhs: "Network.HTTP.StackClient.hContentMD5"} +- error: {lhs: "Network.HTTP.Types.methodPut", rhs: "Network.HTTP.StackClient.methodPut"} - ignore: {name: "Use alternative", within: "Network.HTTP.StackClient"} - ignore: {name: "Use withResponseByManager", within: "Network.HTTP.StackClient"} diff --git a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs index dbd33aa88e..258613e13f 100644 --- a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +++ b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs @@ -7,8 +7,7 @@ -- https://github.com/well-typed/hackage-security/tree/master/hackage-security-http-client -- to avoid extra dependencies module Hackage.Security.Client.Repository.HttpLib.HttpClient ( - withClient - , makeHttpLib + makeHttpLib -- ** Re-exports , Manager -- opaque ) where @@ -17,13 +16,10 @@ import Control.Exception import Control.Monad (void) import Data.ByteString (ByteString) import Network.URI -import Network.HTTP.Client (Manager) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.C8 -import qualified Network.HTTP.Client as HttpClient -import qualified Network.HTTP.Client.Internal as HttpClient +import Network.HTTP.StackClient (Manager) import qualified Network.HTTP.StackClient as StackClient -import qualified Network.HTTP.Types as HttpClient import Hackage.Security.Client hiding (Header) import Hackage.Security.Client.Repository.HttpLib @@ -34,21 +30,6 @@ import qualified Hackage.Security.Util.Lens as Lens Top-level API -------------------------------------------------------------------------------} --- | Initialization --- --- The proxy must be specified at initialization because @http-client@ does not --- allow to change the proxy once the 'Manager' is created. -withClient :: ProxyConfig HttpClient.Proxy -> (Manager -> HttpLib -> IO a) -> IO a -withClient proxyConfig callback = do - manager <- HttpClient.newManager (setProxy HttpClient.defaultManagerSettings) - callback manager $ makeHttpLib manager - where - setProxy = HttpClient.managerSetProxy $ - case proxyConfig of - ProxyConfigNone -> HttpClient.noProxy - ProxyConfigUse p -> HttpClient.useProxy p - ProxyConfigAuto -> HttpClient.proxyEnvironment Nothing - -- | Create an 'HttpLib' value from a preexisting 'Manager'. makeHttpLib :: Manager -> HttpLib makeHttpLib manager = HttpLib @@ -68,10 +49,10 @@ get :: Throws SomeRemoteError get manager reqHeaders uri callback = wrapCustomEx $ do -- TODO: setUri fails under certain circumstances; in particular, when -- the URI contains URL auth. Not sure if this is a concern. - request' <- HttpClient.setUri HttpClient.defaultRequest uri + request' <- StackClient.setUri StackClient.defaultRequest uri let request = setRequestHeaders reqHeaders request' checkHttpException $ StackClient.withResponseByManager request manager $ \response -> do - let br = wrapCustomEx $ HttpClient.responseBody response + let br = wrapCustomEx $ StackClient.responseBody response callback (getResponseHeaders response) br getRange :: Throws SomeRemoteError @@ -80,49 +61,49 @@ getRange :: Throws SomeRemoteError -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a) -> IO a getRange manager reqHeaders uri (from, to) callback = wrapCustomEx $ do - request' <- HttpClient.setUri HttpClient.defaultRequest uri + request' <- StackClient.setUri StackClient.defaultRequest uri let request = setRange from to $ setRequestHeaders reqHeaders request' checkHttpException $ StackClient.withResponseByManager request manager $ \response -> do - let br = wrapCustomEx $ HttpClient.responseBody response + let br = wrapCustomEx $ StackClient.responseBody response case () of - () | HttpClient.responseStatus response == HttpClient.partialContent206 -> + () | StackClient.responseStatus response == StackClient.partialContent206 -> callback HttpStatus206PartialContent (getResponseHeaders response) br - () | HttpClient.responseStatus response == HttpClient.ok200 -> + () | StackClient.responseStatus response == StackClient.ok200 -> callback HttpStatus200OK (getResponseHeaders response) br _otherwise -> - throwChecked $ HttpClient.HttpExceptionRequest request - $ HttpClient.StatusCodeException (void response) "" + throwChecked $ StackClient.HttpExceptionRequest request + $ StackClient.StatusCodeException (void response) "" -- | Wrap custom exceptions -- -- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@ -- but it is currently disabled -wrapCustomEx :: (Throws HttpClient.HttpException => IO a) +wrapCustomEx :: (Throws StackClient.HttpException => IO a) -> (Throws SomeRemoteError => IO a) -wrapCustomEx act = handleChecked (\(ex :: HttpClient.HttpException) -> go ex) act +wrapCustomEx act = handleChecked (\(ex :: StackClient.HttpException) -> go ex) act where go ex = throwChecked (SomeRemoteError ex) -checkHttpException :: Throws HttpClient.HttpException => IO a -> IO a -checkHttpException = handle $ \(ex :: HttpClient.HttpException) -> +checkHttpException :: Throws StackClient.HttpException => IO a -> IO a +checkHttpException = handle $ \(ex :: StackClient.HttpException) -> throwChecked ex {------------------------------------------------------------------------------- http-client auxiliary -------------------------------------------------------------------------------} -hAcceptRanges :: HttpClient.HeaderName +hAcceptRanges :: StackClient.HeaderName hAcceptRanges = "Accept-Ranges" -hAcceptEncoding :: HttpClient.HeaderName +hAcceptEncoding :: StackClient.HeaderName hAcceptEncoding = "Accept-Encoding" setRange :: Int -> Int - -> HttpClient.Request -> HttpClient.Request + -> StackClient.Request -> StackClient.Request setRange from to req = req { - HttpClient.requestHeaders = (HttpClient.hRange, rangeHeader) - : HttpClient.requestHeaders req + StackClient.requestHeaders = (StackClient.hRange, rangeHeader) + : StackClient.requestHeaders req } where -- Content-Range header uses inclusive rather than exclusive bounds @@ -131,42 +112,42 @@ setRange from to req = req { -- | Set request headers setRequestHeaders :: [HttpRequestHeader] - -> HttpClient.Request -> HttpClient.Request + -> StackClient.Request -> StackClient.Request setRequestHeaders opts req = req { - HttpClient.requestHeaders = trOpt disallowCompressionByDefault opts + StackClient.requestHeaders = trOpt disallowCompressionByDefault opts } where - trOpt :: [(HttpClient.HeaderName, [ByteString])] + trOpt :: [(StackClient.HeaderName, [ByteString])] -> [HttpRequestHeader] - -> [HttpClient.Header] + -> [StackClient.Header] trOpt acc [] = concatMap finalizeHeader acc trOpt acc (HttpRequestMaxAge0:os) = - trOpt (insert HttpClient.hCacheControl ["max-age=0"] acc) os + trOpt (insert StackClient.hCacheControl ["max-age=0"] acc) os trOpt acc (HttpRequestNoTransform:os) = - trOpt (insert HttpClient.hCacheControl ["no-transform"] acc) os + trOpt (insert StackClient.hCacheControl ["no-transform"] acc) os -- disable content compression (potential security issue) - disallowCompressionByDefault :: [(HttpClient.HeaderName, [ByteString])] + disallowCompressionByDefault :: [(StackClient.HeaderName, [ByteString])] disallowCompressionByDefault = [(hAcceptEncoding, [])] -- Some headers are comma-separated, others need multiple headers for -- multiple options. -- -- TODO: Right we we just comma-separate all of them. - finalizeHeader :: (HttpClient.HeaderName, [ByteString]) - -> [HttpClient.Header] + finalizeHeader :: (StackClient.HeaderName, [ByteString]) + -> [StackClient.Header] finalizeHeader (name, strs) = [(name, BS.intercalate ", " (reverse strs))] insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])] insert x y = Lens.modify (Lens.lookupM x) (++ y) -- | Extract the response headers -getResponseHeaders :: HttpClient.Response a -> [HttpResponseHeader] +getResponseHeaders :: StackClient.Response a -> [HttpResponseHeader] getResponseHeaders response = concat [ [ HttpResponseAcceptRangesBytes | (hAcceptRanges, "bytes") `elem` headers ] ] where - headers = HttpClient.responseHeaders response + headers = StackClient.responseHeaders response diff --git a/src/Network/HTTP/Download.hs b/src/Network/HTTP/Download.hs index 29986e49e4..6739485954 100644 --- a/src/Network/HTTP/Download.hs +++ b/src/Network/HTTP/Download.hs @@ -30,12 +30,8 @@ import Data.Conduit (yield) import qualified Data.Conduit.Binary as CB import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding (decodeUtf8With) -import Network.HTTP.Client (Request, Response, path, checkResponse, parseUrlThrow, parseRequest) -import Network.HTTP.Client.Conduit (requestHeaders) import Network.HTTP.Download.Verified -import Network.HTTP.StackClient (httpJSON, httpLbs, httpLBS, withResponse) -import Network.HTTP.Simple (getResponseBody, getResponseHeaders, getResponseStatusCode, - setRequestHeader) +import Network.HTTP.StackClient (Request, Response, httpJSON, httpLbs, httpLBS, withResponse, path, checkResponse, parseUrlThrow, parseRequest, setRequestHeader, getResponseHeaders, requestHeaders, getResponseBody, getResponseStatusCode) import Path.IO (doesFileExist) import System.Directory (createDirectoryIfMissing, removeFile) diff --git a/src/Network/HTTP/Download/Verified.hs b/src/Network/HTTP/Download/Verified.hs index 66ceb9be53..f6218ed0fb 100644 --- a/src/Network/HTTP/Download/Verified.hs +++ b/src/Network/HTTP/Download/Verified.hs @@ -41,10 +41,7 @@ import Data.Conduit.Binary (sourceHandle) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import GHC.IO.Exception (IOException(..),IOErrorType(..)) -import Network.HTTP.Client (getUri, path) -import Network.HTTP.StackClient (httpSink) -import Network.HTTP.Simple (Request, HttpException, getResponseHeaders) -import Network.HTTP.Types.Header (hContentLength, hContentMD5) +import Network.HTTP.StackClient (Request, HttpException, httpSink, getUri, path, getResponseHeaders, hContentLength, hContentMD5) import Path import Stack.Types.Runner import Stack.PrettyPrint diff --git a/src/Network/HTTP/StackClient.hs b/src/Network/HTTP/StackClient.hs index 31c4718e08..47b76d0965 100644 --- a/src/Network/HTTP/StackClient.hs +++ b/src/Network/HTTP/StackClient.hs @@ -13,6 +13,54 @@ module Network.HTTP.StackClient , setUserAgent , withResponse , withResponseByManager + , setRequestMethod + , setRequestHeader + , addRequestHeader + , setRequestBody + , setRequestManager + , getResponseHeaders + , getResponseBody + , getResponseStatusCode + , Network.HTTP.Client.responseHeaders + , Network.HTTP.Client.responseStatus + , Network.HTTP.Client.responseBody + , parseRequest + , parseRequest_ + , defaultRequest + , setUri + , getUri + , path + , checkResponse + , parseUrlThrow + , requestHeaders + , getGlobalManager + , applyDigestAuth + , displayDigestAuthException + , Request + , RequestBody(RequestBodyBS, RequestBodyLBS) + , Response + , Manager + , Header + , HeaderName + , HttpException(HttpExceptionRequest) + , HttpExceptionContent(StatusCodeException) + , hAccept + , hContentLength + , hContentMD5 + , hCacheControl + , hRange + , methodPut + , ok200 + , partialContent206 + , Proxy + , useProxy + , noProxy + , proxyEnvironment + , managerSetProxy + , formDataBody + , partFileRequestBody + , partBS + , partLBS ) where import Data.Aeson (FromJSON) @@ -21,9 +69,14 @@ import Data.ByteString.Lazy (ByteString) import Data.Conduit (ConduitM, transPipe) import Data.Void (Void) import qualified Network.HTTP.Client -import Network.HTTP.Client (BodyReader, Manager, Request, Response) -import Network.HTTP.Simple (setRequestHeader) +import Network.HTTP.Client (BodyReader, Manager, Request, RequestBody(..), Response, Manager, HttpExceptionContent(..), parseRequest, parseRequest_, defaultRequest, getUri, path, checkResponse, parseUrlThrow, responseStatus, responseBody, useProxy, noProxy, proxyEnvironment, managerSetProxy, Proxy) +import Network.HTTP.Client.Internal (setUri) +import Network.HTTP.Simple (setRequestMethod, setRequestBody, setRequestHeader, addRequestHeader, setRequestManager, HttpException(..), getResponseBody, getResponseStatusCode, getResponseHeaders) +import Network.HTTP.Types (hAccept, hContentLength, hContentMD5, hCacheControl, hRange, methodPut, Header, HeaderName, ok200, partialContent206) +import Network.HTTP.Conduit (requestHeaders) +import Network.HTTP.Client.TLS (getGlobalManager, applyDigestAuth, displayDigestAuthException) import qualified Network.HTTP.Simple +import Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody, partBS, partLBS) import UnliftIO (MonadIO, MonadUnliftIO, withRunInIO, withUnliftIO, unliftIO) diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 8f652a5741..a142b2cb5e 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -65,9 +65,7 @@ import qualified Distribution.Text import Distribution.Version (simplifyVersionRange, mkVersion') import GHC.Conc (getNumProcessors) import Lens.Micro (lens, set) -import Network.HTTP.Client (parseUrlThrow) -import Network.HTTP.StackClient (httpJSON) -import Network.HTTP.Simple (getResponseBody) +import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody) import Options.Applicative (Parser, strOption, long, help) import Path import Path.Extra (toFilePathNoTrailingSep) diff --git a/src/Stack/Ls.hs b/src/Stack/Ls.hs index 71e7a26f25..091c592dee 100644 --- a/src/Stack/Ls.hs +++ b/src/Stack/Ls.hs @@ -24,11 +24,8 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Typeable (Typeable) import qualified Data.Vector as V -import Network.HTTP.StackClient (httpJSON) -import Network.HTTP.Simple - (addRequestHeader, getResponseBody, parseRequest, - setRequestManager) -import Network.HTTP.Types.Header (hAccept) +import Network.HTTP.StackClient (httpJSON, getGlobalManager, addRequestHeader, getResponseBody, parseRequest, + setRequestManager, hAccept) import qualified Options.Applicative as OA import Options.Applicative ((<|>)) import Path @@ -39,7 +36,6 @@ import Stack.Options.DotParser (listDepsOptsParser) import System.Process.PagerEditor (pageText) import System.Directory (listDirectory) import System.IO (stderr, hPutStrLn) -import Network.HTTP.Client.TLS (getGlobalManager) data LsView = Local diff --git a/src/Stack/New.hs b/src/Stack/New.hs index 2965b40718..974b8df095 100644 --- a/src/Stack/New.hs +++ b/src/Stack/New.hs @@ -38,7 +38,7 @@ import Data.Time.Calendar import Data.Time.Clock import qualified Data.Yaml as Yaml import Network.HTTP.Download -import Network.HTTP.Simple (Request, HttpException, getResponseStatusCode, getResponseBody) +import Network.HTTP.StackClient (Request, HttpException, getResponseStatusCode, getResponseBody) import Path import Path.IO import Stack.Constants diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs index 47ddcb117f..66d11fdf79 100644 --- a/src/Stack/PackageIndex.hs +++ b/src/Stack/PackageIndex.hs @@ -50,7 +50,7 @@ import qualified Hackage.Security.Client.Repository.Remote as HS import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HS import qualified Hackage.Security.Util.Path as HS import qualified Hackage.Security.Util.Pretty as HS -import Network.HTTP.Client.TLS (getGlobalManager) +import Network.HTTP.StackClient (getGlobalManager) import Network.HTTP.Download import Network.URI (parseURI) import Path (toFilePath, parseAbsFile, mkRelDir, mkRelFile, (), parseRelDir) diff --git a/src/Stack/PackageLocation.hs b/src/Stack/PackageLocation.hs index e435fb43d2..c3ce58afb2 100644 --- a/src/Stack/PackageLocation.hs +++ b/src/Stack/PackageLocation.hs @@ -28,7 +28,7 @@ import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Distribution.PackageDescription (GenericPackageDescription) -import Network.HTTP.Client (parseUrlThrow) +import Network.HTTP.StackClient (parseUrlThrow) import Network.HTTP.Download.Verified import Path import Path.Extra diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 5ac40f61b7..6868fbca2c 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -64,7 +64,7 @@ import Distribution.System (OS, Arch (..), Platform (..)) import qualified Distribution.System as Cabal import Distribution.Text (simpleParse) import Lens.Micro (set) -import Network.HTTP.Simple (getResponseBody, getResponseStatusCode) +import Network.HTTP.StackClient (getResponseBody, getResponseStatusCode) import Network.HTTP.Download import Path import Path.CheckInstall (warnInstallSearchPathIssues) diff --git a/src/Stack/Sig/Sign.hs b/src/Stack/Sig/Sign.hs index 1343ac7cea..eb2cf6ca4d 100644 --- a/src/Stack/Sig/Sign.hs +++ b/src/Stack/Sig/Sign.hs @@ -21,10 +21,8 @@ import qualified Codec.Compression.GZip as GZip import Stack.Prelude import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as L -import Network.HTTP.Client (RequestBody (RequestBodyBS)) import Network.HTTP.Download -import Network.HTTP.Simple (setRequestMethod, setRequestBody, getResponseStatusCode) -import Network.HTTP.Types (methodPut) +import Network.HTTP.StackClient (RequestBody (RequestBodyBS), setRequestMethod, setRequestBody, getResponseStatusCode, methodPut) import Path import Stack.Package import Stack.Sig.GPG diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs index 71e64e3b39..05db62e28d 100644 --- a/src/Stack/Snapshot.hs +++ b/src/Stack/Snapshot.hs @@ -43,7 +43,7 @@ import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C -import Network.HTTP.Client (Request) +import Network.HTTP.StackClient (Request) import Network.HTTP.Download import qualified RIO import Network.URI (isURI) diff --git a/src/Stack/Types/BuildPlan.hs b/src/Stack/Types/BuildPlan.hs index bd1cb76897..04cf01e2e4 100644 --- a/src/Stack/Types/BuildPlan.hs +++ b/src/Stack/Types/BuildPlan.hs @@ -43,7 +43,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Distribution.ModuleName as C import qualified Distribution.Version as C -import Network.HTTP.Client (parseRequest) +import Network.HTTP.StackClient (parseRequest) import Stack.Prelude import Stack.Types.Compiler import Stack.Types.FlagName diff --git a/src/Stack/Types/Resolver.hs b/src/Stack/Types/Resolver.hs index afb17b8fab..0425972472 100644 --- a/src/Stack/Types/Resolver.hs +++ b/src/Stack/Types/Resolver.hs @@ -49,7 +49,7 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import Data.Text.Read (decimal) import Data.Time (Day) -import Network.HTTP.Client (Request, parseUrlThrow) +import Network.HTTP.StackClient (Request, parseUrlThrow) import Options.Applicative (ReadM) import qualified Options.Applicative.Types as OA import Path diff --git a/src/Stack/Types/TemplateName.hs b/src/Stack/Types/TemplateName.hs index a2598049a7..99fce7260b 100644 --- a/src/Stack/Types/TemplateName.hs +++ b/src/Stack/Types/TemplateName.hs @@ -13,7 +13,7 @@ import Data.Aeson.Types (typeMismatch) import qualified Data.Text as T import Data.Yaml (Value(Object), (.:?)) import Language.Haskell.TH -import Network.HTTP.Client (parseRequest) +import Network.HTTP.StackClient (parseRequest) import qualified Options.Applicative as O import Path import Path.Internal diff --git a/src/Stack/Upload.hs b/src/Stack/Upload.hs index ad173694b1..d791d281a9 100644 --- a/src/Stack/Upload.hs +++ b/src/Stack/Upload.hs @@ -25,17 +25,12 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Conduit.Binary as CB import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) -import Network.HTTP.Client (Response, - RequestBody(RequestBodyLBS), - Request) -import Network.HTTP.StackClient (withResponse, httpNoBody) -import Network.HTTP.Simple (getResponseStatusCode, +import Network.HTTP.StackClient (Request, RequestBody(RequestBodyLBS), Response, withResponse, httpNoBody, getGlobalManager, getResponseStatusCode, getResponseBody, setRequestHeader, - parseRequest) -import Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody, - partBS, partLBS) -import Network.HTTP.Client.TLS (getGlobalManager, + parseRequest, + formDataBody, partFileRequestBody, + partBS, partLBS, applyDigestAuth, displayDigestAuthException) import Stack.Types.Config diff --git a/src/test/Network/HTTP/Download/VerifiedSpec.hs b/src/test/Network/HTTP/Download/VerifiedSpec.hs index 8ce916f70a..7ee258a11a 100644 --- a/src/test/Network/HTTP/Download/VerifiedSpec.hs +++ b/src/test/Network/HTTP/Download/VerifiedSpec.hs @@ -3,7 +3,7 @@ module Network.HTTP.Download.VerifiedSpec where import Control.Retry (limitRetries) import Crypto.Hash -import Network.HTTP.Client.Conduit +import Network.HTTP.StackClient import Network.HTTP.Download.Verified import Path import Path.IO hiding (withSystemTempDir) From d444a80d9eb6e074aac142af133d00659bb262a2 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Fri, 29 Jun 2018 19:06:11 +0100 Subject: [PATCH 4/4] Fix #3992 Windows 10: Work around upstream git clone issue (#4121) --- src/Stack/Upgrade.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Stack/Upgrade.hs b/src/Stack/Upgrade.hs index 5ac317070e..742a783bb4 100644 --- a/src/Stack/Upgrade.hs +++ b/src/Stack/Upgrade.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} @@ -24,6 +24,10 @@ import Path import qualified Paths_stack as Paths import Stack.Build import Stack.Config +-- Following import is redundant on non-Windows operating systems +#ifdef WINDOWS +import Stack.DefaultColorWhen (defaultColorWhen) +#endif import Stack.Fetch import Stack.PackageIndex import Stack.PrettyPrint @@ -212,6 +216,13 @@ sourceUpgrade gConfigMonoid mresolver builtHash (SourceOpts gitRepo) = -- --git" not working for earlier versions. let args = [ "clone", repo , "stack", "--depth", "1", "--recursive", "--branch", branch] withWorkingDir (toFilePath tmp) $ proc "git" args runProcess_ +#ifdef WINDOWS + -- On Windows 10, an upstream issue with the `git clone` command + -- means that command clears, but does not then restore, the + -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. + -- The folowing hack re-enables the lost ANSI-capability. + _ <- liftIO defaultColorWhen +#endif return $ Just $ tmp $(mkRelDir "stack") Nothing -> do updateAllIndices