Remove obsolete content compression functionality

example-client/example-client.cabal

@@ -11,10 +11,6 @@ category:            Distribution
 build-type:          Simple
 cabal-version:       >=1.10
 
-flag base45
-  description: Are we using base 4.5 or later?
-  manual: False
-
 flag use-network-uri
   description: Are we using network-uri?
   manual: False
@@ -32,7 +28,8 @@ executable example-client
                        time                 >= 1.2,
                        hackage-security     >= 0.5,
                        hackage-security-HTTP,
-                       hackage-security-curl
+                       hackage-security-curl,
+                       hackage-security-http-client
   hs-source-dirs:      src
   default-language:    Haskell2010
   default-extensions:  DeriveDataTypeable
@@ -43,12 +40,6 @@ executable example-client
   other-extensions:    CPP
   ghc-options:         -Wall
 
-  -- http-client only supported on base 4.5 and later
-  if flag(base45)
-    build-depends: base >= 4.5, hackage-security-http-client
-  else
-    build-depends: base < 4.5
-
   -- see comments in hackage-security.cabal
   if flag(use-network-uri)
     build-depends: network-uri >= 2.6 && < 2.7,

example-client/src/ExampleClient/Options.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 module ExampleClient.Options (
     GlobalOpts(..)
   , Command(..)
@@ -39,9 +38,6 @@ data GlobalOpts = GlobalOpts {
     -- | Should we check expiry times?
   , globalCheckExpiry :: Bool
 
-    -- | Should we disable content compression? (For the security paranoid)
-  , globalDisallowCompression :: Bool
-
     -- | Command to execute
   , globalCommand :: Command
   }
@@ -119,11 +115,7 @@ parseGlobalOptions = GlobalOpts
        , metavar "CLIENT"
        , value "HTTP"
        , showDefault
-#ifdef MIN_VERSION_hackage_security_http_client
        , help "HTTP client to use (currently supported: HTTP, http-conduit, curl)"
-#else
-       , help "HTTP client to use (currently supported: HTTP, curl)"
-#endif
        ])
   <*> (many . option readKeyId $ mconcat [
          long "root-key"
@@ -134,10 +126,6 @@ parseGlobalOptions = GlobalOpts
          long "ignore-expiry"
        , help "Don't check expiry dates (should only be used in exceptional circumstances)"
        ])
-  <*> (switch $ mconcat [
-         long "disallow-content-compression"
-       , help "Disallow HTTP content compression (for the security paranoid)"
-       ])
   <*> (subparser $ mconcat [
           command "bootstrap" $ info (helper <*> parseBootstrap) $
             progDesc "Get the initial root information. If using a key threshold larger than 0, you will need to use the --root-key option to specify one or more trusted root keys."

example-client/src/Main.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 module Main where
 
 -- stdlib
@@ -21,10 +20,7 @@ import qualified Hackage.Security.Client.Repository.Local       as Local
 import qualified Hackage.Security.Client.Repository.Remote      as Remote
 import qualified Hackage.Security.Client.Repository.HttpLib.HTTP as HttpLib.HTTP
 import qualified Hackage.Security.Client.Repository.HttpLib.Curl as HttpLib.Curl
-
-#ifdef MIN_VERSION_hackage_security_http_client
 import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HttpLib.HttpClient
-#endif
 
 -- example-client
 import ExampleClient.Options
@@ -147,9 +143,7 @@ withRepo GlobalOpts{..} = \callback ->
                               callback
 
     repoOpts :: Remote.RepoOpts
-    repoOpts = Remote.defaultRepoOpts {
-         Remote.repoAllowContentCompression = not globalDisallowCompression
-       }
+    repoOpts = Remote.defaultRepoOpts
 
     withClient :: (HttpLib -> IO a) -> IO a
     withClient act =
@@ -163,11 +157,9 @@ withRepo GlobalOpts{..} = \callback ->
           "curl" ->
             HttpLib.Curl.withClient $ \httpLib ->
               act httpLib
-#ifdef MIN_VERSION_hackage_security_http_client
           "http-client" ->
             HttpLib.HttpClient.withClient proxyConfig $ \_manager httpLib ->
               act httpLib
-#endif
           otherClient ->
             error $ "unsupported HTTP client " ++ show otherClient
 

hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs

@@ -21,16 +21,11 @@ import Control.Monad
 import Data.List (intercalate)
 import Data.Typeable (Typeable)
 import Network.URI
-import qualified Data.ByteString.Lazy   as BS.L
-import qualified Control.Monad.State    as State
-import qualified Codec.Compression.GZip as GZip
-import qualified Network.Browser        as HTTP
-import qualified Network.HTTP           as HTTP
-import qualified Network.HTTP.Proxy     as HTTP
-
-#if MIN_VERSION_zlib(0,6,0)
-import qualified Codec.Compression.Zlib.Internal as GZip (DecompressError)
-#endif
+import qualified Data.ByteString.Lazy as BS.L
+import qualified Control.Monad.State  as State
+import qualified Network.Browser      as HTTP
+import qualified Network.HTTP         as HTTP
+import qualified Network.HTTP.Proxy   as HTTP
 
 import Hackage.Security.Client
 import Hackage.Security.Client.Repository.HttpLib
@@ -107,33 +102,15 @@ withResponse :: Throws SomeRemoteError
              -> ([HttpResponseHeader] -> BodyReader -> IO a)
              -> IO a
 withResponse response callback = wrapCustomEx $ do
-    br <- bodyReaderFromBS $ decompress (HTTP.rspBody response)
-    callback responseHeaders $ wrapCustomEx (checkDecompressError br)
+    br <- bodyReaderFromBS $ HTTP.rspBody response
+    callback responseHeaders $ wrapCustomEx br
   where
-    responseHeaders    = getResponseHeaders response
-    needsDecompression = HttpResponseContentCompression `elem` responseHeaders
-    decompress         = if needsDecompression then GZip.decompress else id
+    responseHeaders = getResponseHeaders response
 
 {-------------------------------------------------------------------------------
   Custom exception types
 -------------------------------------------------------------------------------}
 
-#if MIN_VERSION_zlib(0,6,0)
-wrapCustomEx :: ( ( Throws UnexpectedResponse
-                  , Throws IOException
-                  , Throws GZip.DecompressError
-                  ) => IO a)
-             -> (Throws SomeRemoteError => IO a)
-wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse)   -> go ex)
-                 $ handleChecked (\(ex :: IOException)          -> go ex)
-                 $ handleChecked (\(ex :: GZip.DecompressError) -> go ex)
-                 $ act
-  where
-    go ex = throwChecked (SomeRemoteError ex)
-
-checkDecompressError :: Throws GZip.DecompressError => IO a -> IO a
-checkDecompressError = handle $ \(ex :: GZip.DecompressError) -> throwChecked ex
-#else
 wrapCustomEx :: ( ( Throws UnexpectedResponse
                   , Throws IOException
                   ) => IO a)
@@ -144,10 +121,6 @@ wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse) -> go ex)
   where
     go ex = throwChecked (SomeRemoteError ex)
 
-checkDecompressError :: IO a -> IO a
-checkDecompressError = id
-#endif
-
 data UnexpectedResponse = UnexpectedResponse URI (Int, Int, Int)
   deriving (Typeable)
 
@@ -275,8 +248,6 @@ setRequestHeaders =
       trOpt (insert HTTP.HdrCacheControl ["max-age=0"] acc) os
     trOpt acc (HttpRequestNoTransform:os) =
       trOpt (insert HTTP.HdrCacheControl ["no-transform"] acc) os
-    trOpt acc (HttpRequestContentCompression:os) =
-      trOpt (insert HTTP.HdrAcceptEncoding ["gzip"] acc) os
 
     -- Some headers are comma-separated, others need multiple headers for
     -- multiple options.
@@ -300,7 +271,4 @@ getResponseHeaders response = concat [
     [ HttpResponseAcceptRangesBytes
     | "bytes" `elem` map HTTP.hdrValue (HTTP.retrieveHeaders hAcceptRanges response)
     ]
-  , [ HttpResponseContentCompression
-    | HTTP.findHeader HTTP.HdrContentEncoding response == Just "gzip"
-    ]
   ]

hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs

@@ -137,15 +137,8 @@ setRequestHeaders opts req = req {
       trOpt (insert HttpClient.hCacheControl ["max-age=0"] acc) os
     trOpt acc (HttpRequestNoTransform:os) =
       trOpt (insert HttpClient.hCacheControl ["no-transform"] acc) os
-    trOpt acc (HttpRequestContentCompression:os) =
-      trOpt (insert hAcceptEncoding ["gzip"] acc) os
-
-    -- http-client deals with decompression completely transparently, so we
-    -- don't actually need to manually decompress the response stream (we do
-    -- still need to report to the `hackage-security` library however that the
-    -- response stream had been compressed). However, we do have to make sure
-    -- that we allow for compression _only_ when explicitly requested because
-    -- the default is that it's always enabled.
+
+    -- disable content compression (potential security issue)
     disallowCompressionByDefault :: [(HttpClient.HeaderName, [ByteString])]
     disallowCompressionByDefault = [(hAcceptEncoding, [])]
 
@@ -166,9 +159,6 @@ getResponseHeaders response = concat [
       [ HttpResponseAcceptRangesBytes
       | (hAcceptRanges, "bytes") `elem` headers
       ]
-    , [ HttpResponseContentCompression
-      | (HttpClient.hContentEncoding, "gzip") `elem` headers
-      ]
     ]
   where
     headers = HttpClient.responseHeaders response

hackage-security/ChangeLog.md

@@ -6,7 +6,7 @@
 * Build tar-index incrementally (#22)
 * Generalize 'Repository' over the representation of downloaded remote files.
 * Update index incrementally by downloading delta of `.tar.gz` and writing only
-  tail of local `.tar` file (#101)
+  tail of local `.tar` file (#101). Content compression no longer used.
 * Take a lock on the cache directory before updating it, and no longer use
   atomic file ops (pointless since we now update some files incrementally)
 * Code refactoring/simplification.

hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs

@@ -70,16 +70,6 @@ data HttpRequestHeader =
 
     -- | Set @Cache-Control: no-transform@
   | HttpRequestNoTransform
-
-    -- | Request transport compression (@Accept-Encoding: gzip@)
-    --
-    -- It is the responsibility of the 'HttpLib' to do compression
-    -- (and report whether the original server reply was compressed or not).
-    --
-    -- NOTE: Clients should NOT allow for compression unless explicitly
-    -- requested (since decompression happens before signature verification, it
-    -- is a potential security concern).
-  | HttpRequestContentCompression
   deriving (Eq, Ord, Show)
 
 -- | HTTP status code
@@ -97,10 +87,6 @@ data HttpStatus =
 data HttpResponseHeader =
     -- | Server accepts byte-range requests (@Accept-Ranges: bytes@)
     HttpResponseAcceptRangesBytes
-
-    -- | Original server response was compressed
-    -- (the 'HttpLib' however must do decompression)
-  | HttpResponseContentCompression
   deriving (Eq, Ord, Show)
 
 -- | Proxy configuration

hackage-security/src/Hackage/Security/Client/Repository/Remote.hs

@@ -111,26 +111,18 @@ fileSizeWithinBounds sz (FileSizeBound sz') = sz <= sz'
 --
 -- Clients should use 'defaultRepositoryOpts' and override required settings.
 data RepoOpts = RepoOpts {
-      -- | Should we allow HTTP content compression?
-      --
-      -- Since content compression happens before signature verification, users
-      -- who are concerned about potential exploits of the decompression
-      -- algorithm may prefer to disallow content compression.
-      repoAllowContentCompression :: Bool
-
       -- | Allow additional mirrors?
       --
       -- If this is set to True (default), in addition to the (out-of-band)
       -- specified mirrors we will also use mirrors reported by those
       -- out-of-band mirrors (that is, @mirrors.json@).
-    , repoAllowAdditionalMirrors :: Bool
+      repoAllowAdditionalMirrors :: Bool
     }
 
 -- | Default repository options
 defaultRepoOpts :: RepoOpts
 defaultRepoOpts = RepoOpts {
-      repoAllowContentCompression = True
-    , repoAllowAdditionalMirrors  = True
+      repoAllowAdditionalMirrors = True
     }
 
 -- | Initialize the repository (and cleanup resources afterwards)
@@ -243,30 +235,14 @@ getRemote remoteConfig selectedMirror attemptNr remoteFile = do
 -- mess things up with respect to hashes etc). Additionally, after a validation
 -- error we want to make sure caches get files upstream in case the validation
 -- error was because the cache updated files out of order.
-httpRequestHeaders :: RemoteConfig
-                   -> AttemptNr
-                   -> DownloadMethod fs typ
-                   -> [HttpRequestHeader]
-httpRequestHeaders RemoteConfig{..} attemptNr method =
+httpRequestHeaders :: RemoteConfig -> AttemptNr -> [HttpRequestHeader]
+httpRequestHeaders RemoteConfig{..} attemptNr =
     if attemptNr == 0 then defaultHeaders
                       else HttpRequestMaxAge0 : defaultHeaders
   where
     -- Headers we provide for _every_ attempt, first or not
     defaultHeaders :: [HttpRequestHeader]
-    defaultHeaders = concat [
-        [ HttpRequestNoTransform ]
-      , [ HttpRequestContentCompression
-        | repoAllowContentCompression cfgOpts && not (isRangeRequest method)
-        ]
-      ]
-
-    -- If we are doing a range request, we must not request content compression:
-    -- servers such as Apache interpret this range against the _compressed_
-    -- stream, making it near useless for our purposes here.
-    isRangeRequest :: DownloadMethod fs typ -> Bool
-    isRangeRequest NeverUpdated{} = False
-    isRangeRequest CannotUpdate{} = False
-    isRangeRequest Update{}       = True
+    defaultHeaders = [HttpRequestNoTransform]
 
 -- | Mirror selection
 withMirror :: forall a.
@@ -400,7 +376,7 @@ getFile cfg@RemoteConfig{..} attemptNr remoteFile method =
         update updateFormat updateInfo updateLocal updateTail
 
     headers :: [HttpRequestHeader]
-    headers = httpRequestHeaders cfg attemptNr method
+    headers = httpRequestHeaders cfg attemptNr
 
     -- Get any file from the server, without using incremental updates
     download :: Throws SomeRemoteError => HasFormat fs f

hackage-security/tests/TestSuite/HttpMem.hs

@@ -40,18 +40,7 @@ get :: forall a. Throws SomeRemoteError
 get InMemRepo{..} requestHeaders uri callback = do
     Some inMemFile <- inMemRepoGetPath $ castRoot (uriPath uri)
     br <- bodyReaderFromBS $ inMemFileRender inMemFile
-
-    -- We pretend that we used content compression (the HttpLib spec
-    -- explicitly states that it is the responsibility of the HttpLib
-    -- implementation to decode compressed content), and indicate that we can
-    -- use range requests
-    let responseHeaders = concat [
-            [ HttpResponseAcceptRangesBytes ]
-          , [ HttpResponseContentCompression
-            | HttpRequestContentCompression <- requestHeaders
-            ]
-          ]
-    callback responseHeaders br
+    callback [HttpResponseAcceptRangesBytes] br
 
 -- | Download a byte range
 --