stack upload uses HTTP digest authentication

snoyberg · snoyberg · commit f2db579aabc3 · 2016-09-13T16:40:28.000+03:00
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -16,6 +16,7 @@ Other enhancements:
 * `stack setup` detects systems where gcc enables PIE by default (such as Ubuntu
   16.10) and adjusts the GHC `configure` options accordingly.
   [#2542](https://github.com/commercialhaskell/stack/issues/2542)
+* Upload to Hackage with HTTP digest instead of HTTP basic.
 
 Bug fixes:
 
diff --git a/src/Stack/Upload.hs b/src/Stack/Upload.hs
@@ -39,6 +39,7 @@ import           Data.Aeson                            (FromJSON (..),
                                                         (.:), (.=))
 import qualified Data.ByteString.Char8                 as S
 import qualified Data.ByteString.Lazy                  as L
+import           Data.Maybe                            (fromMaybe)
 import           Data.Text                             (Text)
 import qualified Data.Text                             as T
 import           Data.Text.Encoding                    (encodeUtf8)
@@ -47,15 +48,16 @@ import           Data.Typeable                         (Typeable)
 import           Network.HTTP.Client                   (BodyReader, Manager,
                                                         Response,
                                                         RequestBody(RequestBodyLBS),
-                                                        applyBasicAuth, brRead,
+                                                        brRead,
                                                         newManager,
                                                         parseRequest,
                                                         requestHeaders,
                                                         responseBody,
                                                         responseStatus,
                                                         withResponse)
 import           Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody)
-import           Network.HTTP.Client.TLS               (tlsManagerSettings)
+import           Network.HTTP.Client.TLS               (tlsManagerSettings,
+                                                        applyDigestAuth)
 import           Network.HTTP.Types                    (statusCode)
 import           Path                                  (toFilePath)
 import           Prelude -- Fix redundant import warnings
@@ -203,13 +205,14 @@ mkUploader config us = do
         { upload_ = \tarName bytes -> do
             let formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)]
             req2 <- formDataBody formData req1
-            let req3 = applyBasicAuth
+            mreq3 <- applyDigestAuth
                     (encodeUtf8 $ hcUsername creds)
                     (encodeUtf8 $ hcPassword creds)
                     req2
+                    manager
             putStr $ "Uploading " ++ tarName ++ "... "
             hFlush stdout
-            withResponse req3 manager $ \res ->
+            withResponse (fromMaybe req2 mreq3) manager $ \res ->
                 case statusCode $ responseStatus res of
                     200 -> putStrLn "done!"
                     401 -> do
diff --git a/stack-7.8.yaml b/stack-7.8.yaml
@@ -48,7 +48,7 @@ extra-deps:
 - x509-validation-1.6.3
 - x509-store-1.6.1
 - x509-system-1.6.3
-- http-client-tls-0.3.0
+- http-client-tls-0.3.1
 - connection-0.2.5
 - regex-applicative-text-0.1.0.1
 - monad-unlift-0.1.1.0
diff --git a/stack-8.0.yaml b/stack-8.0.yaml
@@ -11,7 +11,7 @@ nix:
 extra-deps:
 - http-client-0.5.0
 - http-conduit-2.2.0
-- http-client-tls-0.3.0
+- http-client-tls-0.3.1
 - unicode-transforms-0.1.0.1
 - store-0.2.1.0
 - store-core-0.2.0.0
diff --git a/stack.cabal b/stack.cabal
@@ -187,7 +187,7 @@ library
                    , hit
                    , hpc
                    , http-client >= 0.5.0
-                   , http-client-tls >= 0.3.0
+                   , http-client-tls >= 0.3.1
                    , http-conduit >= 2.2.0
                    , http-types >= 0.8.6 && < 0.10
                    , lifted-async
diff --git a/stack.yaml b/stack.yaml
@@ -17,7 +17,7 @@ extra-deps:
 - store-core-0.2.0.0
 - th-orphans-0.13.1
 - http-client-0.5.0
-- http-client-tls-0.3.0
+- http-client-tls-0.3.1
 - http-conduit-2.2.0
 - optparse-applicative-0.13.0.0
 - text-metrics-0.1.0
