Use libarchive instead of tar-bytestring

3rdparty/libarchive/test/Spec.cpphs

@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main ( main ) where
+
+import           Codec.Archive
+import           Codec.Archive.Roundtrip (itPacksUnpacks, itPacksUnpacksViaFS, roundtrip, roundtripFreaky, roundtripStrict)
+import           Codec.Archive.Test
+import           Data.Either             (isRight)
+import           Data.Foldable           (traverse_)
+import           System.Directory        (doesDirectoryExist, listDirectory)
+import           System.FilePath         ((</>))
+import           System.IO.Temp          (withSystemTempDirectory)
+import           Test.Hspec
+
+testFp :: FilePath -> Spec
+testFp fp = parallel $ it ("sucessfully unpacks/packs (" ++ fp ++ ")") $
+    roundtrip fp >>= (`shouldSatisfy` isRight)
+
+testFpStrict :: FilePath -> Spec
+testFpStrict fp = parallel $ it ("works on strict bytestring (" ++ fp ++ ")") $
+    roundtripStrict fp >>= (`shouldSatisfy` isRight)
+
+testFpFreaky :: FilePath -> Spec
+testFpFreaky fp = parallel $ it ("works on nonstandard bytestring (" ++ fp ++ ")") $
+    roundtripFreaky fp >>= (`shouldSatisfy` isRight)
+
+unpack :: FilePath -> IO (Either ArchiveResult ())
+unpack fp = withSystemTempDirectory "libarchive" $
+    \tmp -> runArchiveM $ unpackArchive fp tmp
+
+readArchiveFile' :: FilePath -> IO (Either ArchiveResult [Entry])
+readArchiveFile' = runArchiveM . readArchiveFile
+
+testUnpackLibarchive :: FilePath -> Spec
+testUnpackLibarchive fp = parallel $ it ("unpacks " ++ fp) $
+    unpack fp >>= (`shouldSatisfy` isRight)
+
+testReadArchiveFile :: FilePath -> Spec
+testReadArchiveFile fp = parallel $ it ("reads " ++ fp) $
+    readArchiveFile' fp >>= (`shouldSatisfy` isRight)
+
+main :: IO ()
+main = do
+
+    dir <- doesDirectoryExist "test/data"
+    tarballs <- if dir then listDirectory "test/data" else pure []
+    let tarPaths = ("test/data" </>) <$> tarballs
+
+    hspec $
+        describe "roundtrip" $ do
+
+            traverse_ testFp tarPaths
+#ifndef LOW_MEMORY
+            traverse_ testFpFreaky tarPaths
+            traverse_ testFpStrict tarPaths
+#endif
+            traverse_ testUnpackLibarchive tarPaths
+            traverse_ testReadArchiveFile tarPaths
+
+            context "with symlinks" $ do
+                let entries =
+                        [ simpleDir "x/"
+                        , simpleFile "x/a.txt" (NormalFile "referenced")
+                        , simpleFile "x/b.txt" (Symlink "a.txt" SymlinkUndefined)
+                        ]
+                itPacksUnpacks entries
+                itPacksUnpacksViaFS entries
+
+            context "with hardlinks" $ do
+                let entries =
+                        [ simpleDir "x/"
+                        , simpleFile "x/a.txt" (NormalFile "shared")
+                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
+                        ]
+                itPacksUnpacks entries
+                context "issue#4" $ itPacksUnpacksViaFS entries
+
+            context "with forward referenced hardlinks" $ do
+                let entries =
+                        [ simpleDir "x/"
+                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
+                        , simpleFile "x/a.txt" (NormalFile "shared")
+                        ]
+                itPacksUnpacks entries
+                xcontext "re-ordering on unpack" $ itPacksUnpacksViaFS entries
+
+            xcontext "having entry without ownership" . itPacksUnpacks $
+                [ stripOwnership (simpleFile "a.txt" (NormalFile "text")) ]
+            xcontext "having entry without timestamp" . itPacksUnpacks $
+                [ stripTime (simpleFile "a.txt" (NormalFile "text")) ]