Merge pull request #32 from brandon-leapyear/chinn/support-basic-auth

Support basic auth
commercialhaskell · Mar 26, 2021 · c7923fc · c7923fc
2 parents 0a04a97 + edbd887
commit c7923fc
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 10 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -2,6 +2,7 @@
 
 ## v0.5.1.5
 * Switch back to hackage.haskell.org [#30](https://github.com/commercialhaskell/pantry/pull/30)
+* Pass through basic auth credentials specified in URLs [#32](https://github.com/commercialhaskell/pantry/pull/32)
 
 ## v0.5.1.4
 

diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 name:        pantry
-version:     0.5.1.4
+version:     0.5.1.5
 synopsis:    Content addressable Haskell package management
 description: Please see the README on Github at <https://github.com/commercialhaskell/pantry#readme>
 category:    Development

diff --git a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs
@@ -4,9 +4,9 @@
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings   #-}
--- Taken from
--- https://github.com/well-typed/hackage-security/tree/master/hackage-security-http-client
--- to avoid extra dependencies
+
+-- Adapted from `hackage-security-http-client` to use our own
+-- `Pantry.HTTP` implementation
 module Hackage.Security.Client.Repository.HttpLib.HttpClient (
     httpLib
   ) where
@@ -107,13 +107,16 @@ setRange from to =
 setRequestHeaders :: [HttpRequestHeader]
                   -> HTTP.Request -> HTTP.Request
 setRequestHeaders opts =
-    HTTP.setRequestHeaders (trOpt disallowCompressionByDefault opts)
+    setRequestHeaders' (trOpt disallowCompressionByDefault opts)
   where
+    setRequestHeaders' :: [HTTP.Header] -> HTTP.Request -> HTTP.Request
+    setRequestHeaders' = foldr (\(name, val) f -> f . HTTP.setRequestHeader name [val]) id
+
     trOpt :: [(HTTP.HeaderName, [ByteString])]
           -> [HttpRequestHeader]
           -> [HTTP.Header]
     trOpt acc [] =
-      concatMap finalizeHeader acc
+      map finalizeHeader acc
     trOpt acc (HttpRequestMaxAge0:os) =
       trOpt (insert HTTP.hCacheControl ["max-age=0"] acc) os
     trOpt acc (HttpRequestNoTransform:os) =
@@ -128,8 +131,8 @@ setRequestHeaders opts =
     --
     -- TODO: Right we we just comma-separate all of them.
     finalizeHeader :: (HTTP.HeaderName, [ByteString])
-                   -> [HTTP.Header]
-    finalizeHeader (name, strs) = [(name, BS.intercalate ", " (reverse strs))]
+                   -> HTTP.Header
+    finalizeHeader (name, strs) = (name, BS.intercalate ", " (reverse strs))
 
     insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
     insert _ _ [] = []

diff --git a/src/Pantry/HTTP.hs b/src/Pantry/HTTP.hs
@@ -21,8 +21,7 @@ import           Network.HTTP.Simple          as Export (HttpException (..),
                                                          getResponseBody,
                                                          getResponseHeaders,
                                                          getResponseStatus,
-                                                         setRequestHeader,
-                                                         setRequestHeaders)
+                                                         setRequestHeader)
 import qualified Network.HTTP.Simple          as HTTP hiding (withResponse)
 import           Network.HTTP.Types           as Export (Header, HeaderName,
                                                          Status, hCacheControl,