packages feed

ztar 0.2.0 → 1.0.0

raw patch · 7 files changed

+85/−61 lines, 7 filesdep −extradep ~filepathdep ~zip

Dependencies removed: extra

Dependency ranges changed: filepath, zip

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+# ztar 1.0.0++Breaking changes:+* Compiled against `zip-1.0.0`+ # ztar 0.2.0  Breaking changes:
src/Codec/Archive/ZTar.hs view
@@ -62,7 +62,7 @@ createFrom' compression (toFilePath -> archive) (toFilePath -> dir) paths =   createFrom compression archive dir paths --- | Extract an archive to the given directory. Automatically detects the compression algorithm.+-- | Extract an archive to the given directory. Automatically detects the compression algorithm -- used in the archive. extract :: FilePath -- ^ archive to extract         -> FilePath -- ^ destination directory@@ -71,6 +71,7 @@   Tar.TarFormat -> Tar.extract archive dir   GZip.GZipFormat -> GZip.extract archive dir   Zip.ZipFormat -> Zip.extract archive dir+  "" -> fail $ "Trying to extract empty file: " ++ archive   _ -> fail $ "Could not recognize archive format: " ++ archive  -- | Same as 'extract' but using Path types.
src/Codec/Archive/ZTar/GZip.hs view
@@ -6,7 +6,6 @@  Functions to create/extract GZIP-compressed archives. -}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}
src/Codec/Archive/ZTar/Tar.hs view
@@ -6,8 +6,6 @@  Functions to create/extract uncompressed tar archives. -}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}
src/Codec/Archive/ZTar/Zip.hs view
@@ -21,11 +21,10 @@ import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS-import Path (parseAbsFile, parseAbsDir, parseRelFile) import System.Directory     ( createDirectoryIfMissing-    , doesFileExist     , doesDirectoryExist+    , doesFileExist     , listDirectory     , makeAbsolute     , withCurrentDirectory@@ -34,8 +33,19 @@  -- | A pattern matching any ByteString in the Zip format. pattern ZipFormat :: ByteString-pattern ZipFormat <- ((BS.pack [0x50, 0x4B, 0x03, 0x04] `BS.isPrefixOf`) -> True)+pattern ZipFormat <- (matchesZip -> True) +matchesZip :: ByteString -> Bool+matchesZip s = any (`BS.isPrefixOf` s) zipMagicNumbers+  where+    zipMagicNumbers = map BS.pack+     [ [0x50, 0x4B, 0x03, 0x04]+     -- empty archive+     , [0x50, 0x4B, 0x05, 0x06]+     -- spanned archive+     , [0x50, 0x4B, 0x07, 0x08]+     ]+ -- | Create a new archive compressed with Zip from the given paths. -- -- It is equivalent to calling the standard 'zip' program like so:@@ -46,7 +56,7 @@        -> [FilePath] -- ^ files and paths to compress, relative to base directory        -> IO () create archive base paths = do-  archive' <- makeAbsolute archive >>= parseAbsFile+  archive' <- makeAbsolute archive   withCurrentDirectory base $ Zip.createArchive archive' $ mapM_ insert paths   where     insert path = do@@ -57,9 +67,8 @@         | isDir -> insertDir path         | otherwise -> fail $ "Path does not exist: " ++ path     insertFile path = do-      path' <- parseRelFile path-      path'' <- Zip.mkEntrySelector path'-      Zip.loadEntry Zip.BZip2 (const $ return path'') path'+      path' <- Zip.mkEntrySelector path+      Zip.loadEntry Zip.BZip2 path' path     insertDir path =       let mkPath = if path == "." then id else (path </>)       in mapM_ (insert . mkPath) =<< liftIO (listDirectory path)@@ -74,6 +83,4 @@         -> IO () extract archive dir = do   createDirectoryIfMissing True dir-  archive' <- makeAbsolute archive >>= parseAbsFile-  dir' <- makeAbsolute dir >>= parseAbsDir-  Zip.withArchive archive' $ Zip.unpackInto dir'+  Zip.withArchive archive $ Zip.unpackInto dir
test/Test.hs view
@@ -2,24 +2,25 @@  import Codec.Archive.ZTar import Control.Monad (forM, forM_)-import Control.Monad.Extra (unlessM) import qualified Data.ByteString as BS import Data.ByteString.Arbitrary (ArbByteString(..))-import Data.List (dropWhileEnd, intercalate, nub)+import Data.List (isPrefixOf, nub) import Data.Maybe (fromJust) import Path     ( Dir     , File-    , Rel     , Path+    , Rel     , absdir     , fromAbsFile+    , fromRelDir     , parent     , parseRelDir     , parseRelFile     , (</>)     ) import Path.IO (doesFileExist, ensureDir, isLocationOccupied, withTempDir)+import qualified System.FilePath.Windows as Windows import Test.QuickCheck import Test.QuickCheck.Monadic import Test.Tasty (defaultMain, testGroup)@@ -27,34 +28,32 @@  main :: IO () main = defaultMain $ testGroup "ztar"-  [ testProperty "Create/extract uncompressed tar archives" $ testZTar NoCompression-  , testProperty "Create/extract GZip tar archives" $ testZTar GZip-  , testProperty "Create/extract Zip archives" $ testZTar Zip+  [ testProperty "Create/extract uncompressed tar archives" $ testZTar 25 NoCompression+  , testProperty "Create/extract GZip tar archives" $ testZTar 20 GZip+  , testProperty "Create/extract Zip archives" $ testZTar 15 Zip   ] -testZTar :: Compression -> Property-testZTar compression = monadicIO $ do-  archive:src:dest:paths <- pick $ uniqueListOf 4 arbitrary--  files <- forM paths $ \path -> do-    Blind (ABS contents) <- pick arbitrary-    return (toRelFile path, contents)+testZTar :: Int -> Compression -> Property+testZTar n compression = withMaxSuccess n $ monadicIO $ do+  [archive, src, dest] <- pick $ uniqueListOf 3 arbitrary+  files <- pick arbitraryFileTree    run $ withTempDir [absdir|/tmp|] "" $ \dir -> do     let archive' = dir </> toRelFile archive         src' = dir </> toRelDir src         dest' = dir </> toRelDir dest +    ensureDir $ parent archive'+    ensureDir src'+    ensureDir dest'+     -- write files to be bundled     forM_ files $ \(path, contents) -> do       let path' = src' </> path-      -- case writing `a` when `a/b` already exists-      unlessM (isLocationOccupied path') $ do-        ensureDir $ parent path'-        BS.writeFile (fromAbsFile path') contents+      ensureDir $ parent path'+      BS.writeFile (fromAbsFile path') contents      -- create and extract archive-    ensureDir $ parent archive'     create' compression archive' src'     extract' archive' dest' @@ -72,44 +71,59 @@  {- Helpers -} --- | Generate a unique list with length at least N.+toRelFile :: ValidName -> Path Rel File+toRelFile = fromJust . parseRelFile . unName++toRelDir :: ValidName -> Path Rel Dir+toRelDir = fromJust . parseRelDir . unName++maybeSlash :: Maybe (Path Rel Dir) -> Path Rel t -> Path Rel t+maybeSlash Nothing path = path+maybeSlash (Just dir) path = dir </> path++-- | Generate a unique list with length of N. uniqueListOf :: Eq a => Int -> Gen a -> Gen [a]-uniqueListOf 0 gen = nub <$> listOf gen+uniqueListOf 0 _ = return [] uniqueListOf n gen = do   rest <- uniqueListOf (n - 1) gen   x <- gen `suchThat` (`notElem` rest)   return $ x : rest --- | A valid relative file path.-newtype ValidPath = ValidPath { unPath :: FilePath }-  deriving (Show,Eq)--instance Arbitrary ValidPath where-  arbitrary = ValidPath . truncatePath . intercalate "/" . map unName <$> listOf1 arbitrary-    where-      truncatePath = dropWhileEnd (`elem` ['/', '.']) . take 50--toRelFile :: ValidPath -> Path Rel File-toRelFile = fromJust . parseRelFile . unPath--toRelDir :: ValidPath -> Path Rel Dir-toRelDir = fromJust . parseRelDir . unPath+-- | An arbitrary file tree and their contents.+arbitraryFileTree :: Gen [(Path Rel File, BS.ByteString)]+arbitraryFileTree = mkFileTree Nothing (0 :: Int)+  where+    mkFileTree (Just dir) _+      | length (fromRelDir dir) > 50 = return []+    mkFileTree _ 5 = return [] -- max depth of 5 directories+    mkFileTree dir depth = do+      paths <- nub <$> listOf arbitrary+      fmap concat $ forM paths $ \path -> do+        -- exponentially less likely to go into subdirectories+        isFile <- frequency [(1, pure False), (2^depth, pure True)]+        if isFile+          then do+            Blind (ABS contents) <- arbitrary+            return [(dir `maybeSlash` toRelFile path, contents)]+          else mkFileTree (Just $ dir `maybeSlash` toRelDir path) (depth + 1)  -- | A valid file or directory name. newtype ValidName = ValidName { unName :: String }-  deriving (Show)+  deriving (Show,Eq) +{-# ANN module "HLint: ignore Use ||" #-} instance Arbitrary ValidName where   arbitrary = do     -- https://stackoverflow.com/a/2306003/8565175     name <- take 14 <$> listOf1 (elements validChars)-    if or-      [ last name == '.'-      , name `elem` ["nul"]-      -- https://superuser.com/questions/259703/get-mac-tar-to-stop-putting-filenames-in-tar-archives-      , name !! 0 == '.' && name !! 1 == '_'-      ]-      then arbitrary-      else return $ ValidName name+    if isValid name+      then return $ ValidName name+      else arbitrary     where       validChars = ['a'..'z'] ++ ['0'..'9'] ++ ['.', '_', '-']+      isValid name = not $ or+        [ last name == '.'+        -- https://superuser.com/questions/259703/get-mac-tar-to-stop-putting-filenames-in-tar-archives+        , "._" `isPrefixOf` name+        , not $ Windows.isValid name+        ]
ztar.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c39489aefc941fc38bd650d9f61d4cfbc64a46eb644a01468a3c27fad9de23b4+-- hash: f6bbd45a4e7adaa7ce7e25a88acfaf3aff646afa6bfd8d1835c36d21c23449e8  name:           ztar-version:        0.2.0+version:        1.0.0 synopsis:       Creating and extracting arbitrary archives description:    Creating and extracting arbitrary archives. category:       Codec@@ -52,7 +52,7 @@     , process     , text     , unix-compat-    , zip >=0.2 && <0.3+    , zip >=1.0 && <1.2     , zlib >=0.6 && <0.7   if flag(dev)     ghc-options: -Werror@@ -88,7 +88,7 @@     , base     , bytestring     , bytestring-arbitrary-    , extra+    , filepath     , path     , path-io     , tasty