libarchive 2.2.1.0 → 2.2.2.0

raw patch · 7 files changed

+118/−102 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• libarchive.cabal +15/−7
• src/Codec/Archive/Pack/Lazy.hs +1/−1
• src/Codec/Archive/Types.hs +5/−4
• src/Codec/Archive/Types/Foreign.chs +2/−2
• test/Spec.cpphs +89/−0
• test/Spec.hs +0/−88

@@ -1,5 +1,11 @@ # libarchive +## 2.2.2.0++  * Add `Ord` instance to `Entry`, `Symlink`, `EntryContent`, `Ownership`+  * Make `content` field of `Entry` lazy+  * Add `Eq` instance to `ArchiveEncryption`+ ## 2.2.1.0    * Add `Exception` instance for `ArchiveResult`

@@ -1,12 +1,12 @@ cabal-version:   1.18 name:            libarchive-version:         2.2.1.0+version:         2.2.2.0 license:         BSD3 license-file:    LICENSE copyright:       Copyright: (c) 2018-2020 Vanessa McHale maintainer:      vamchale@gmail.com author:          Vanessa McHale-tested-with:     ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.2+tested-with:     ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.3 bug-reports:     https://github.com/vmchale/libarchive/issues synopsis:        Haskell interface to libarchive description:@@ -33,6 +33,10 @@     default:     False     manual:      True +flag low-memory+    description: Run low-memory version of test suite+    default:     False+ library     exposed-modules:         Codec.Archive@@ -79,15 +83,16 @@         ghc-options: -Wmissing-export-lists  test-suite libarchive-test-    type:             exitcode-stdio-1.0-    main-is:          Spec.hs-    hs-source-dirs:   test+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: cpphs:cpphs -any+    hs-source-dirs:     test     other-modules:         Codec.Archive.Roundtrip         Codec.Archive.Test -    default-language: Haskell2010-    other-extensions: OverloadedStrings+    default-language:   Haskell2010+    other-extensions:   OverloadedStrings     ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns         -Wincomplete-record-updates -Wredundant-constraints@@ -104,6 +109,9 @@         dir-traverse -any,         composition-prelude >=2.0.5.0,         pathological-bytestrings -any++    if flag(low-memory)+        cpp-options: -DLOW_MEMORY      if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists

@@ -74,7 +74,7 @@     BSL.fromChunks . toList <$> liftIO (readIORef bsRef) <* liftIO (freeHaskellFunPtr cc)      where writeBSL bsRef _ _ bufPtr sz = do-            let bytesRead = min (fromIntegral sz) (32 * 1024) -- TODO: tweak this parameter+            let bytesRead = min (fromIntegral sz) (32 * 1024)             bsl <- packCStringLen (bufPtr, fromIntegral bytesRead)             modifyIORef' bsRef (`DL.snoc` bsl)             pure bytesRead

@@ -35,28 +35,29 @@                        | NoEncryption                        | EncryptionUnsupported                        | EncryptionUnknown+                       deriving (Eq)  -- TODO: support everything here: http://hackage.haskell.org/package/tar/docs/Codec-Archive-Tar-Entry.html#t:EntryContent data EntryContent = NormalFile !BS.ByteString                   | Directory                   | Symlink !FilePath !Symlink                   | Hardlink !FilePath-    deriving (Show, Eq)+    deriving (Show, Eq, Ord)  data Entry = Entry { filepath    :: !FilePath-                   , content     :: !EntryContent+                   , content     :: EntryContent                    , permissions :: !Permissions                    , ownership   :: !Ownership                    , time        :: !(Maybe ModTime)                    }-    deriving (Show, Eq)+    deriving (Show, Eq, Ord)  data Ownership = Ownership { userName  :: !(Maybe String)                            , groupName :: !(Maybe String)                            , ownerId   :: !Id                            , groupId   :: !Id                            }-    deriving (Eq, Show)+    deriving (Eq, Show, Ord)  type Permissions = CMode type ModTime = (CTime, CLong)

@@ -62,13 +62,13 @@                         , AE_IFBLK as FtBlock                         , AE_IFDIR as FtDirectory                         , AE_IFIFO as FtFifo-                        } deriving (Eq)+                        } deriving (Eq, Ord)   #}  {# enum define Symlink { AE_SYMLINK_TYPE_UNDEFINED as SymlinkUndefined                        , AE_SYMLINK_TYPE_FILE as SymlinkFile                        , AE_SYMLINK_TYPE_DIRECTORY as SymlinkDirectory-                       } deriving (Show, Eq)+                       } deriving (Show, Eq, Ord)   #}  {# enum define ArchiveFilter { ARCHIVE_FILTER_NONE as ArchiveFilterNone

@@ -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")) ]

@@ -1,88 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main ( main ) where--import           Codec.Archive-import           Codec.Archive.Roundtrip (itPacksUnpacks, itPacksUnpacksViaFS, roundtrip, roundtripFreaky, roundtripStrict)-import           Codec.Archive.Test-import qualified Data.ByteString         as BS-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-            traverse_ testFpFreaky tarPaths-            traverse_ testFpStrict tarPaths-            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")) ]