wip: fix with updated tar-lib

fossas · Oct 19, 2023 · d3ec3f8 · d3ec3f8
1 parent 6d6aab8
commit d3ec3f8
Show file tree

Hide file tree

Showing 6 changed files with 18 additions and 9 deletions.
diff --git a/cabal.project b/cabal.project
@@ -62,7 +62,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fossas/tar
-  tag: 6bd13acc541ae60b5c831823243040e18bd1d957
+  tag: 2817f71ffca7fa234ce88b0af0fe725be9777342
 
 -- This can be removed once https://github.com/weldr/codec-rpm/pull/40 merges and is available on hackage.
 source-repository-package

diff --git a/cabal.project.ci.linux b/cabal.project.ci.linux
@@ -60,7 +60,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fossas/tar
-  tag: 6bd13acc541ae60b5c831823243040e18bd1d957
+  tag: 2817f71ffca7fa234ce88b0af0fe725be9777342
 
 -- This can be removed once https://github.com/weldr/codec-rpm/pull/40 merges and is available on hackage.
 source-repository-package

diff --git a/cabal.project.ci.macos b/cabal.project.ci.macos
@@ -58,7 +58,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fossas/tar
-  tag: 6bd13acc541ae60b5c831823243040e18bd1d957
+  tag: 2817f71ffca7fa234ce88b0af0fe725be9777342
 
 -- This can be removed once https://github.com/weldr/codec-rpm/pull/40 merges and is available on hackage.
 source-repository-package

diff --git a/cabal.project.ci.windows b/cabal.project.ci.windows
@@ -66,7 +66,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fossas/tar
-  tag: 6bd13acc541ae60b5c831823243040e18bd1d957
+  tag: 2817f71ffca7fa234ce88b0af0fe725be9777342
 
 -- This can be removed once https://github.com/weldr/codec-rpm/pull/40 merges and is available on hackage.
 source-repository-package

diff --git a/spectrometer.cabal b/spectrometer.cabal
@@ -110,7 +110,7 @@ common deps
     , path                         ^>=0.9.0
     , path-io                      ^>=1.8.0
     , pretty-simple                ^>=4.1.1.0
-    , prettyprinter                >=1.6       && <1.8
+    , prettyprinter                >=1.6      && <1.8
     , prettyprinter-ansi-terminal  ^>=1.1.1
     , random                       ^>=1.2.0
     , raw-strings-qq               ^>=1.1
@@ -120,11 +120,11 @@ common deps
     , semver                       ^>=0.4.0.1
     , stm                          ^>=2.5.0
     , stm-chans                    ^>=3.0.0
-    , tar                          ^>=0.6.0.0
+    , tar                          ^>=0.6.0.1
     , template-haskell
     , text                         ^>=2.0.0
     , th-lift-instances            ^>=0.1.17
-    , time                         >=1.9       && <1.13
+    , time                         >=1.9      && <1.13
     , tomland                      ^>=1.3.3.0
     , transformers
     , typed-process                ^>=0.2.6

diff --git a/src/Container/TarballReadFs.hs b/src/Container/TarballReadFs.hs
@@ -27,8 +27,10 @@ import Control.Exception (
   Exception (fromException, toException),
   IOException,
   SomeAsyncException (SomeAsyncException),
+  SomeException,
   catch,
   throwIO,
+  try,
  )
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as ByteString
@@ -82,14 +84,21 @@ import Path.Extra (SomePath (..))
 import Control.Effect.Record (Redacted (..))
 import Data.Either.Combinators (mapRight)
 import Path.Internal (Path (Path))
-import System.IO (IOMode (ReadMode), withFile)
+import System.IO (Handle, IOMode (ReadMode), withFile)
 
 maxHopsOf20 :: Int
 maxHopsOf20 = 20
 
 ensureSlashSuffix :: Text -> Text
 ensureSlashSuffix t = if Text.isSuffixOf "/" t then t else (t <> "/")
 
+hReadEntry' :: Handle -> TarEntryOffset -> IO Entry
+hReadEntry' hdl offset = do
+  result <- try (hReadEntry hdl offset) :: IO (Either SomeException Entry)
+  case result of
+    Left err -> throw . userError $ "TarReadEntryErr at:" <> show offset <> " (" <> show err <> ")"
+    Right res -> pure res
+
 readContentBS ::
   SomeFileTree TarEntryOffset ->
   Path Abs File ->
@@ -106,7 +115,7 @@ readContentBS fs tarball hop target =
           <> (toString tarball)
     Just tarOffset ->
       withFile (toString tarball) ReadMode $ \handle -> do
-        (getContent fs tarball hop) =<< hReadEntry handle tarOffset
+        (getContent fs tarball hop) =<< hReadEntry' handle tarOffset
 
 getContent ::
   SomeFileTree TarEntryOffset ->