From 015e1e0c25a231acb59a80803a98c7f503703c9c Mon Sep 17 00:00:00 2001
From: Abel Sen <asen@fpcomplete.com>
Date: Wed, 26 Oct 2022 18:28:50 -0500
Subject: [PATCH 1/2] Strip './' from filenames to stop "Unsupported tarball"
 exceptions

---
 src/Pantry/Archive.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/Pantry/Archive.hs b/src/Pantry/Archive.hs
index db9ee3e1..15df3e7d 100644
--- a/src/Pantry/Archive.hs
+++ b/src/Pantry/Archive.hs
@@ -321,7 +321,7 @@ foldTar loc accum0 f = do
           _ -> throwIO exc
       pure $
         (\met -> MetaEntry
-          { mePath = Tar.getFileInfoPath fi
+          { mePath = removeInitialDotSlash . Tar.getFileInfoPath $ fi
           , meType = met
           })
         <$> mmet
@@ -332,6 +332,9 @@ data SimpleEntry = SimpleEntry
   }
   deriving Show
 
+removeInitialDotSlash :: FilePath -> FilePath
+removeInitialDotSlash filename = fromString . T.unpack . fromMaybe filenameText .  T.stripPrefix "./" $ filenameText
+  where filenameText = T.pack filename
 
 -- | Attempt to parse the contents of the given archive in the given
 -- subdir into a 'Tree'. This will not consult any caches. It will
@@ -358,7 +361,7 @@ parseArchive rpli archive fp = do
             logDebug $ "parseArchive of " <> display at <> ": " <> displayShow e
             getFiles ats
           Right files -> pure (at, Map.fromList $ map (mePath &&& id) $ files [])
-  (at :: ArchiveType, files :: Map FilePath MetaEntry) <- getFiles [minBound..maxBound]
+  (at :: ArchiveType, files :: Map FilePath MetaEntry) <- second (Map.mapKeys removeInitialDotSlash) <$> getFiles [minBound..maxBound]
   let toSimple :: FilePath -> MetaEntry -> Either String (Map FilePath SimpleEntry)
       toSimple key me =
         case meType me of
@@ -434,7 +437,7 @@ parseArchive rpli archive fp = do
                   pure $ Map.insert (mePath me) (blobKey, blobId) m
                 else pure m
           tree :: CachedTree <- fmap (CachedTreeMap . Map.fromList) $ for safeFiles $ \(sfp, se) ->
-            case Map.lookup (seSource se) blobs of
+            case Map.lookup (removeInitialDotSlash . seSource $ se) blobs of
               Nothing -> error $ "Impossible: blob not found for: " ++ seSource se
               Just (blobKey, blobId) -> pure (sfp, (TreeEntry blobKey (seType se), blobId))
           -- parse the cabal file and ensure it has the right name

From 536d7d11b9eeb29b8316d34cc6b40250da950141 Mon Sep 17 00:00:00 2001
From: Abel Sen <asen@fpcomplete.com>
Date: Thu, 27 Oct 2022 16:40:36 -0500
Subject: [PATCH 2/2] Simplify `removeInitialDotSlash` function and make it
 more portable

Credit to @philderbeast for suggesting this in code review
---
 src/Pantry/Archive.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Pantry/Archive.hs b/src/Pantry/Archive.hs
index 15df3e7d..37b1d6ce 100644
--- a/src/Pantry/Archive.hs
+++ b/src/Pantry/Archive.hs
@@ -333,8 +333,7 @@ data SimpleEntry = SimpleEntry
   deriving Show
 
 removeInitialDotSlash :: FilePath -> FilePath
-removeInitialDotSlash filename = fromString . T.unpack . fromMaybe filenameText .  T.stripPrefix "./" $ filenameText
-  where filenameText = T.pack filename
+removeInitialDotSlash filename = maybe filename T.unpack (T.stripPrefix "./" $ T.pack filename)
 
 -- | Attempt to parse the contents of the given archive in the given
 -- subdir into a 'Tree'. This will not consult any caches. It will