work around default Accept-Encoding in http-client

1 files changed, 15 insertions, 1 deletions

diff --git a/Utility/Url.hs b/Utility/Url.hs
index f7c028d8b..ad910add7 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Utility.Url (
 	URLString,
@@ -26,6 +27,7 @@ import Network.HTTP.Conduit
 import Network.HTTP.Types
 import Data.Default
 import qualified Data.CaseInsensitive as CI
+import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as B8
 
 import qualified Build.SysConfig
@@ -130,7 +132,7 @@ exists url uo = case parseURIRelaxed url of
 				(responseHeaders resp)
 	
 	existsconduit req = withManager $ \mgr -> do
-			let req' = (applyRequest uo req) { method = methodHead }
+			let req' = headRequest (applyRequest uo req)
 			resp <- http req' mgr
 			-- forces processing the response before the
 			-- manager is closed
@@ -140,6 +142,18 @@ exists url uo = case parseURIRelaxed url of
 			liftIO $ closeManager mgr
 			return ret
 
+headRequest :: Request -> Request
+headRequest r = r
+	{ method = methodHead
+	-- remove defaut Accept-Encoding header, to get actual,
+	-- not gzip compressed size.
+	, requestHeaders = (hAcceptEncoding, B.empty) :
+		filter (\(h, _) -> h /= hAcceptEncoding)
+		(requestHeaders r)
+	}
+  where
+	hAcceptEncoding = "Accept-Encoding"
+
 {- Used to download large files, such as the contents of keys.
  -
  - Uses wget or curl program for its progress bar. (Wget has a better one,