Support .tar archives #3647

Author: snoyberg

ChangeLog.md

@@ -10,6 +10,11 @@ Behaviour changes:
 
 Other enhancements:
 
+* In addition to supporting `.tar.gz` and `.zip` files as remote archives,
+  plain `.tar` files are now accepted too. This will additionally help with
+  cases where HTTP servers mistakenly set the transfer encoding to `gzip`. See
+  [#3647](https://github.com/commercialhaskell/stack/issues/3647).
+
 Bug fixes:
 
 * For versions of Cabal before 1.24, ensure that the dependencies of

src/Stack/PackageLocation.hs

@@ -109,8 +109,8 @@ resolveSinglePackageLocation projRoot (PLArchive (Archive url subdir msha)) = do
 
         let fp = toFilePath file
 
-        let tryTar = do
-                logDebug $ "Trying to untar " <> T.pack fp
+        let tryTargz = do
+                logDebug $ "Trying to ungzip/untar " <> T.pack fp
                 liftIO $ withBinaryFile fp ReadMode $ \h -> do
                     lbs <- L.hGetContents h
                     let entries = Tar.read $ GZip.decompress lbs
@@ -120,14 +120,20 @@ resolveSinglePackageLocation projRoot (PLArchive (Archive url subdir msha)) = do
                 archive <- fmap Zip.toArchive $ liftIO $ L.readFile fp
                 liftIO $  Zip.extractFilesFromArchive [Zip.OptDestination
                                                        (toFilePath dirTmp)] archive
+            tryTar = do
+                logDebug $ "Trying to untar (no ungzip) " <> T.pack fp
+                liftIO $ withBinaryFile fp ReadMode $ \h -> do
+                    lbs <- L.hGetContents h
+                    let entries = Tar.read lbs
+                    Tar.unpack (toFilePath dirTmp) entries
             err = throwM $ UnableToExtractArchive url file
 
             catchAnyLog goodpath handler =
                 catchAny goodpath $ \e -> do
                     logDebug $ "Got exception: " <> T.pack (show e)
                     handler
 
-        tryTar `catchAnyLog` tryZip `catchAnyLog` err
+        tryTargz `catchAnyLog` tryZip `catchAnyLog` tryTar `catchAnyLog` err
         renameDir dirTmp dir
 
     x <- listDir dir