diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs index cad511ef9f8..956241ab307 100644 --- a/cabal-install/src/Distribution/Client/HttpUtils.hs +++ b/cabal-install/src/Distribution/Client/HttpUtils.hs @@ -192,7 +192,7 @@ downloadURI transport verbosity uri path = do -- Only use the external http transports if we actually have to -- (or have been told to do so) let transport' - | uriScheme uri == "http:" + | isHttpURI uri , not (transportManuallySelected transport) = plainHttpTransport | otherwise = @@ -251,20 +251,35 @@ downloadURI transport verbosity uri path = do -- Utilities for repo url management -- +-- | If the remote repo is accessed over HTTPS, ensure that the transport +-- supports HTTPS. remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO () -remoteRepoCheckHttps verbosity transport repo - | uriScheme (remoteRepoURI repo) == "https:" - , not (transportSupportsHttps transport) = - dieWithException verbosity $ RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage - | otherwise = return () +remoteRepoCheckHttps verbosity transport repo = + transportCheckHttpsWithError verbosity transport (remoteRepoURI repo) $ + RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage +-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS. transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO () -transportCheckHttps verbosity transport uri - | uriScheme uri == "https:" +transportCheckHttps verbosity transport uri = + transportCheckHttpsWithError verbosity transport uri $ + TransportCheckHttps uri requiresHttpsErrorMessage + +-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS. +-- If not, fail with the given error. +transportCheckHttpsWithError + :: Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO () +transportCheckHttpsWithError verbosity transport uri err + | isHttpsURI uri , not (transportSupportsHttps transport) = - dieWithException verbosity $ TransportCheckHttps uri requiresHttpsErrorMessage + dieWithException verbosity err | otherwise = return () +isHttpsURI :: URI -> Bool +isHttpsURI uri = uriScheme uri == "https:" + +isHttpURI :: URI -> Bool +isHttpURI uri = uriScheme uri == "http:" + requiresHttpsErrorMessage :: String requiresHttpsErrorMessage = "requires HTTPS however the built-in HTTP implementation " @@ -280,12 +295,12 @@ requiresHttpsErrorMessage = remoteRepoTryUpgradeToHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo remoteRepoTryUpgradeToHttps verbosity transport repo | remoteRepoShouldTryHttps repo - , uriScheme (remoteRepoURI repo) == "http:" + , isHttpURI (remoteRepoURI repo) , not (transportSupportsHttps transport) , not (transportManuallySelected transport) = dieWithException verbosity $ TryUpgradeToHttps [name | (name, _, True, _) <- supportedTransports] | remoteRepoShouldTryHttps repo - , uriScheme (remoteRepoURI repo) == "http:" + , isHttpURI (remoteRepoURI repo) , transportSupportsHttps transport = return repo @@ -505,12 +520,18 @@ curlTransport prog = (Just (Left (uname, passwd)), _) -> Just $ Left (uname ++ ":" ++ passwd) (Nothing, Just a) -> Just $ Left a (Nothing, Nothing) -> Nothing + let authnSchemeArg + -- When using TLS, we can accept Basic authentication. Let curl + -- decide based on the scheme(s) offered by the server. + | isHttpsURI uri = "--anyauth" + -- When not using TLS, force Digest scheme + | otherwise = "--digest" case mbAuthStringToken of Just (Left up) -> progInvocation { progInvokeInput = Just . IODataText . unlines $ - [ "--digest" + [ authnSchemeArg , "--user " ++ up ] , progInvokeArgs = ["--config", "-"] ++ progInvokeArgs progInvocation diff --git a/changelog.d/pr-10089 b/changelog.d/pr-10089 new file mode 100644 index 00000000000..ed322194e21 --- /dev/null +++ b/changelog.d/pr-10089 @@ -0,0 +1,12 @@ +synopsis: `curl` transport now supports Basic authentication +packages: cabal-install +prs: #10089 + +description: { + +- The `curl` HTTP transport previously only supported the HTTP Digest + authentication scheme. Basic authentication is now supported + when using HTTPS; Curl will use the scheme offered by the server. + The `wget` transport already supports HTTPS. + +}