{-# LANGUAGE CPP, BangPatterns, PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module Codec.Archive.Tar.Index (
TarIndex,
lookup,
TarIndexEntry(..),
toList,
TarEntryOffset,
hReadEntry,
hReadEntryHeader,
build,
IndexBuilder,
empty,
addNextEntry,
skipNextEntry,
finalise,
unfinalise,
serialise,
deserialise,
hReadEntryHeaderOrEof,
hSeekEntryOffset,
hSeekEntryContentOffset,
hSeekEndEntryOffset,
nextEntryOffset,
indexEndEntryOffset,
indexNextEntryOffset,
emptyIndex,
finaliseIndex,
#ifdef TESTS
prop_lookup,
prop_toList,
prop_valid,
prop_serialise_deserialise,
prop_serialiseSize,
prop_index_matches_tar,
prop_finalise_unfinalise,
#endif
) where
import Data.Typeable (Typeable)
import Codec.Archive.Tar.Types as Tar
import Codec.Archive.Tar.Read as Tar
import qualified Codec.Archive.Tar.Index.StringTable as StringTable
import Codec.Archive.Tar.Index.StringTable (StringTable, StringTableBuilder)
import qualified Codec.Archive.Tar.Index.IntTrie as IntTrie
import Codec.Archive.Tar.Index.IntTrie (IntTrie, IntTrieBuilder)
import qualified System.FilePath.Posix as FilePath
import Data.Monoid (Monoid(..))
#if (MIN_VERSION_base(4,5,0))
import Data.Monoid ((<>))
#endif
import Data.Word
import Data.Int
import Data.Bits
import qualified Data.Array.Unboxed as A
import Prelude hiding (lookup)
import System.IO
import Control.Exception (assert, throwIO)
import Control.DeepSeq
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Unsafe as BS
#if MIN_VERSION_bytestring(0,10,2) || defined(MIN_VERSION_bytestring_builder)
import Data.ByteString.Builder as BS
import Data.ByteString.Builder.Extra as BS (toLazyByteStringWith,
untrimmedStrategy)
#else
import Data.ByteString.Lazy.Builder as BS
import Data.ByteString.Lazy.Builder.Extras as BS (toLazyByteStringWith,
untrimmedStrategy)
#endif
#ifdef TESTS
import qualified Prelude
import Test.QuickCheck
import Test.QuickCheck.Property (ioProperty)
import Control.Applicative ((<$>), (<*>))
import Control.Monad (unless)
import Data.List (nub, sort, sortBy, stripPrefix, isPrefixOf)
import Data.Maybe
import Data.Function (on)
import Control.Exception (SomeException, try)
import Codec.Archive.Tar.Write as Tar
import qualified Data.ByteString.Handle as HBS
#endif
data TarIndex = TarIndex
{-# UNPACK #-} !(StringTable PathComponentId)
{-# UNPACK #-} !(IntTrie PathComponentId TarEntryOffset)
{-# UNPACK #-} !TarEntryOffset
deriving (TarIndex -> TarIndex -> Bool
(TarIndex -> TarIndex -> Bool)
-> (TarIndex -> TarIndex -> Bool) -> Eq TarIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TarIndex -> TarIndex -> Bool
$c/= :: TarIndex -> TarIndex -> Bool
== :: TarIndex -> TarIndex -> Bool
$c== :: TarIndex -> TarIndex -> Bool
Eq, Int -> TarIndex -> ShowS
[TarIndex] -> ShowS
TarIndex -> String
(Int -> TarIndex -> ShowS)
-> (TarIndex -> String) -> ([TarIndex] -> ShowS) -> Show TarIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TarIndex] -> ShowS
$cshowList :: [TarIndex] -> ShowS
show :: TarIndex -> String
$cshow :: TarIndex -> String
showsPrec :: Int -> TarIndex -> ShowS
$cshowsPrec :: Int -> TarIndex -> ShowS
Show, Typeable)
instance NFData TarIndex where
rnf :: TarIndex -> ()
rnf (TarIndex _ _ _) = ()
data TarIndexEntry = TarFileEntry {-# UNPACK #-} !TarEntryOffset
| TarDir [(FilePath, TarIndexEntry)]
deriving (Int -> TarIndexEntry -> ShowS
[TarIndexEntry] -> ShowS
TarIndexEntry -> String
(Int -> TarIndexEntry -> ShowS)
-> (TarIndexEntry -> String)
-> ([TarIndexEntry] -> ShowS)
-> Show TarIndexEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TarIndexEntry] -> ShowS
$cshowList :: [TarIndexEntry] -> ShowS
show :: TarIndexEntry -> String
$cshow :: TarIndexEntry -> String
showsPrec :: Int -> TarIndexEntry -> ShowS
$cshowsPrec :: Int -> TarIndexEntry -> ShowS
Show, Typeable)
newtype PathComponentId = PathComponentId Int
deriving (PathComponentId -> PathComponentId -> Bool
(PathComponentId -> PathComponentId -> Bool)
-> (PathComponentId -> PathComponentId -> Bool)
-> Eq PathComponentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathComponentId -> PathComponentId -> Bool
$c/= :: PathComponentId -> PathComponentId -> Bool
== :: PathComponentId -> PathComponentId -> Bool
$c== :: PathComponentId -> PathComponentId -> Bool
Eq, Eq PathComponentId
Eq PathComponentId =>
(PathComponentId -> PathComponentId -> Ordering)
-> (PathComponentId -> PathComponentId -> Bool)
-> (PathComponentId -> PathComponentId -> Bool)
-> (PathComponentId -> PathComponentId -> Bool)
-> (PathComponentId -> PathComponentId -> Bool)
-> (PathComponentId -> PathComponentId -> PathComponentId)
-> (PathComponentId -> PathComponentId -> PathComponentId)
-> Ord PathComponentId
PathComponentId -> PathComponentId -> Bool
PathComponentId -> PathComponentId -> Ordering
PathComponentId -> PathComponentId -> PathComponentId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathComponentId -> PathComponentId -> PathComponentId
$cmin :: PathComponentId -> PathComponentId -> PathComponentId
max :: PathComponentId -> PathComponentId -> PathComponentId
$cmax :: PathComponentId -> PathComponentId -> PathComponentId
>= :: PathComponentId -> PathComponentId -> Bool
$c>= :: PathComponentId -> PathComponentId -> Bool
> :: PathComponentId -> PathComponentId -> Bool
$c> :: PathComponentId -> PathComponentId -> Bool
<= :: PathComponentId -> PathComponentId -> Bool
$c<= :: PathComponentId -> PathComponentId -> Bool
< :: PathComponentId -> PathComponentId -> Bool
$c< :: PathComponentId -> PathComponentId -> Bool
compare :: PathComponentId -> PathComponentId -> Ordering
$ccompare :: PathComponentId -> PathComponentId -> Ordering
$cp1Ord :: Eq PathComponentId
Ord, Int -> PathComponentId
PathComponentId -> Int
PathComponentId -> [PathComponentId]
PathComponentId -> PathComponentId
PathComponentId -> PathComponentId -> [PathComponentId]
PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
(PathComponentId -> PathComponentId)
-> (PathComponentId -> PathComponentId)
-> (Int -> PathComponentId)
-> (PathComponentId -> Int)
-> (PathComponentId -> [PathComponentId])
-> (PathComponentId -> PathComponentId -> [PathComponentId])
-> (PathComponentId -> PathComponentId -> [PathComponentId])
-> (PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId])
-> Enum PathComponentId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromThenTo :: PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
enumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFrom :: PathComponentId -> [PathComponentId]
$cenumFrom :: PathComponentId -> [PathComponentId]
fromEnum :: PathComponentId -> Int
$cfromEnum :: PathComponentId -> Int
toEnum :: Int -> PathComponentId
$ctoEnum :: Int -> PathComponentId
pred :: PathComponentId -> PathComponentId
$cpred :: PathComponentId -> PathComponentId
succ :: PathComponentId -> PathComponentId
$csucc :: PathComponentId -> PathComponentId
Enum, Int -> PathComponentId -> ShowS
[PathComponentId] -> ShowS
PathComponentId -> String
(Int -> PathComponentId -> ShowS)
-> (PathComponentId -> String)
-> ([PathComponentId] -> ShowS)
-> Show PathComponentId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathComponentId] -> ShowS
$cshowList :: [PathComponentId] -> ShowS
show :: PathComponentId -> String
$cshow :: PathComponentId -> String
showsPrec :: Int -> PathComponentId -> ShowS
$cshowsPrec :: Int -> PathComponentId -> ShowS
Show, Typeable)
type TarEntryOffset = Word32
lookup :: TarIndex -> FilePath -> Maybe TarIndexEntry
lookup :: TarIndex -> String -> Maybe TarIndexEntry
lookup (TarIndex pathTable :: StringTable PathComponentId
pathTable pathTrie :: IntTrie PathComponentId TarEntryOffset
pathTrie _) path :: String
path = do
[PathComponentId]
fpath <- StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds StringTable PathComponentId
pathTable String
path
TrieLookup PathComponentId TarEntryOffset
tentry <- IntTrie PathComponentId TarEntryOffset
-> [PathComponentId]
-> Maybe (TrieLookup PathComponentId TarEntryOffset)
forall k v.
(Enum k, Enum v) =>
IntTrie k v -> [k] -> Maybe (TrieLookup k v)
IntTrie.lookup IntTrie PathComponentId TarEntryOffset
pathTrie [PathComponentId]
fpath
TarIndexEntry -> Maybe TarIndexEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (TrieLookup PathComponentId TarEntryOffset -> TarIndexEntry
mkIndexEntry TrieLookup PathComponentId TarEntryOffset
tentry)
where
mkIndexEntry :: TrieLookup PathComponentId TarEntryOffset -> TarIndexEntry
mkIndexEntry (IntTrie.Entry offset :: TarEntryOffset
offset) = TarEntryOffset -> TarIndexEntry
TarFileEntry TarEntryOffset
offset
mkIndexEntry (IntTrie.Completions entries :: Completions PathComponentId TarEntryOffset
entries) =
[(String, TarIndexEntry)] -> TarIndexEntry
TarDir [ (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable PathComponentId
key, TrieLookup PathComponentId TarEntryOffset -> TarIndexEntry
mkIndexEntry TrieLookup PathComponentId TarEntryOffset
entry)
| (key :: PathComponentId
key, entry :: TrieLookup PathComponentId TarEntryOffset
entry) <- Completions PathComponentId TarEntryOffset
entries ]
toComponentIds :: StringTable PathComponentId -> FilePath -> Maybe [PathComponentId]
toComponentIds :: StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds table :: StringTable PathComponentId
table =
[PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents []
([ByteString] -> Maybe [PathComponentId])
-> (String -> [ByteString]) -> String -> Maybe [PathComponentId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> ByteString
BS.Char8.singleton '.')
([ByteString] -> [ByteString])
-> (String -> [ByteString]) -> String -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitDirectories
(ByteString -> [ByteString])
-> (String -> ByteString) -> String -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.Char8.pack
where
lookupComponents :: [PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents cs' :: [PathComponentId]
cs' [] = [PathComponentId] -> Maybe [PathComponentId]
forall a. a -> Maybe a
Just ([PathComponentId] -> [PathComponentId]
forall a. [a] -> [a]
reverse [PathComponentId]
cs')
lookupComponents cs' :: [PathComponentId]
cs' (c :: ByteString
c:cs :: [ByteString]
cs) = case StringTable PathComponentId -> ByteString -> Maybe PathComponentId
forall id. Enum id => StringTable id -> ByteString -> Maybe id
StringTable.lookup StringTable PathComponentId
table ByteString
c of
Nothing -> Maybe [PathComponentId]
forall a. Maybe a
Nothing
Just cid :: PathComponentId
cid -> [PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents (PathComponentId
cidPathComponentId -> [PathComponentId] -> [PathComponentId]
forall a. a -> [a] -> [a]
:[PathComponentId]
cs') [ByteString]
cs
fromComponentId :: StringTable PathComponentId -> PathComponentId -> FilePath
fromComponentId :: StringTable PathComponentId -> PathComponentId -> String
fromComponentId table :: StringTable PathComponentId
table = ByteString -> String
BS.Char8.unpack (ByteString -> String)
-> (PathComponentId -> ByteString) -> PathComponentId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringTable PathComponentId -> PathComponentId -> ByteString
forall id. Enum id => StringTable id -> id -> ByteString
StringTable.index StringTable PathComponentId
table
toList :: TarIndex -> [(FilePath, TarEntryOffset)]
toList :: TarIndex -> [(String, TarEntryOffset)]
toList (TarIndex pathTable :: StringTable PathComponentId
pathTable pathTrie :: IntTrie PathComponentId TarEntryOffset
pathTrie _) =
[ (String
path, TarEntryOffset
off)
| (cids :: [PathComponentId]
cids, off :: TarEntryOffset
off) <- IntTrie PathComponentId TarEntryOffset
-> [([PathComponentId], TarEntryOffset)]
forall k v. (Enum k, Enum v) => IntTrie k v -> [([k], v)]
IntTrie.toList IntTrie PathComponentId TarEntryOffset
pathTrie
, let path :: String
path = [String] -> String
FilePath.joinPath ((PathComponentId -> String) -> [PathComponentId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable) [PathComponentId]
cids) ]
build :: Entries e -> Either e TarIndex
build :: Entries e -> Either e TarIndex
build = IndexBuilder -> Entries e -> Either e TarIndex
forall a. IndexBuilder -> Entries a -> Either a TarIndex
go IndexBuilder
empty
where
go :: IndexBuilder -> Entries a -> Either a TarIndex
go !IndexBuilder
builder (Next e :: Entry
e es :: Entries a
es) = IndexBuilder -> Entries a -> Either a TarIndex
go (Entry -> IndexBuilder -> IndexBuilder
addNextEntry Entry
e IndexBuilder
builder) Entries a
es
go !IndexBuilder
builder Done = TarIndex -> Either a TarIndex
forall a b. b -> Either a b
Right (TarIndex -> Either a TarIndex) -> TarIndex -> Either a TarIndex
forall a b. (a -> b) -> a -> b
$! IndexBuilder -> TarIndex
finalise IndexBuilder
builder
go !IndexBuilder
_ (Fail err :: a
err) = a -> Either a TarIndex
forall a b. a -> Either a b
Left a
err
data IndexBuilder
= IndexBuilder !(StringTableBuilder PathComponentId)
!(IntTrieBuilder PathComponentId TarEntryOffset)
{-# UNPACK #-} !TarEntryOffset
deriving (IndexBuilder -> IndexBuilder -> Bool
(IndexBuilder -> IndexBuilder -> Bool)
-> (IndexBuilder -> IndexBuilder -> Bool) -> Eq IndexBuilder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexBuilder -> IndexBuilder -> Bool
$c/= :: IndexBuilder -> IndexBuilder -> Bool
== :: IndexBuilder -> IndexBuilder -> Bool
$c== :: IndexBuilder -> IndexBuilder -> Bool
Eq, Int -> IndexBuilder -> ShowS
[IndexBuilder] -> ShowS
IndexBuilder -> String
(Int -> IndexBuilder -> ShowS)
-> (IndexBuilder -> String)
-> ([IndexBuilder] -> ShowS)
-> Show IndexBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexBuilder] -> ShowS
$cshowList :: [IndexBuilder] -> ShowS
show :: IndexBuilder -> String
$cshow :: IndexBuilder -> String
showsPrec :: Int -> IndexBuilder -> ShowS
$cshowsPrec :: Int -> IndexBuilder -> ShowS
Show)
instance NFData IndexBuilder where
rnf :: IndexBuilder -> ()
rnf (IndexBuilder _ _ _) = ()
empty :: IndexBuilder
empty :: IndexBuilder
empty = StringTableBuilder PathComponentId
-> IntTrieBuilder PathComponentId TarEntryOffset
-> TarEntryOffset
-> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
forall id. StringTableBuilder id
StringTable.empty IntTrieBuilder PathComponentId TarEntryOffset
forall k v. IntTrieBuilder k v
IntTrie.empty 0
emptyIndex :: IndexBuilder
emptyIndex :: IndexBuilder
emptyIndex = IndexBuilder
empty
{-# DEPRECATED emptyIndex "Use TarIndex.empty" #-}
addNextEntry :: Entry -> IndexBuilder -> IndexBuilder
addNextEntry :: Entry -> IndexBuilder -> IndexBuilder
addNextEntry entry :: Entry
entry (IndexBuilder stbl :: StringTableBuilder PathComponentId
stbl itrie :: IntTrieBuilder PathComponentId TarEntryOffset
itrie nextOffset :: TarEntryOffset
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder PathComponentId TarEntryOffset
-> TarEntryOffset
-> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl' IntTrieBuilder PathComponentId TarEntryOffset
itrie'
(Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset Entry
entry TarEntryOffset
nextOffset)
where
!entrypath :: [ByteString]
entrypath = TarPath -> [ByteString]
splitTarPath (Entry -> TarPath
entryTarPath Entry
entry)
(stbl' :: StringTableBuilder PathComponentId
stbl', cids :: [PathComponentId]
cids) = [ByteString]
-> StringTableBuilder PathComponentId
-> (StringTableBuilder PathComponentId, [PathComponentId])
forall id.
Enum id =>
[ByteString]
-> StringTableBuilder id -> (StringTableBuilder id, [id])
StringTable.inserts [ByteString]
entrypath StringTableBuilder PathComponentId
stbl
itrie' :: IntTrieBuilder PathComponentId TarEntryOffset
itrie' = [PathComponentId]
-> TarEntryOffset
-> IntTrieBuilder PathComponentId TarEntryOffset
-> IntTrieBuilder PathComponentId TarEntryOffset
forall k v.
(Enum k, Enum v) =>
[k] -> v -> IntTrieBuilder k v -> IntTrieBuilder k v
IntTrie.insert [PathComponentId]
cids TarEntryOffset
nextOffset IntTrieBuilder PathComponentId TarEntryOffset
itrie
skipNextEntry :: Entry -> IndexBuilder -> IndexBuilder
skipNextEntry :: Entry -> IndexBuilder -> IndexBuilder
skipNextEntry entry :: Entry
entry (IndexBuilder stbl :: StringTableBuilder PathComponentId
stbl itrie :: IntTrieBuilder PathComponentId TarEntryOffset
itrie nextOffset :: TarEntryOffset
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder PathComponentId TarEntryOffset
-> TarEntryOffset
-> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder PathComponentId TarEntryOffset
itrie (Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset Entry
entry TarEntryOffset
nextOffset)
finalise :: IndexBuilder -> TarIndex
finalise :: IndexBuilder -> TarIndex
finalise (IndexBuilder stbl :: StringTableBuilder PathComponentId
stbl itrie :: IntTrieBuilder PathComponentId TarEntryOffset
itrie finalOffset :: TarEntryOffset
finalOffset) =
StringTable PathComponentId
-> IntTrie PathComponentId TarEntryOffset
-> TarEntryOffset
-> TarIndex
TarIndex StringTable PathComponentId
pathTable IntTrie PathComponentId TarEntryOffset
pathTrie TarEntryOffset
finalOffset
where
pathTable :: StringTable PathComponentId
pathTable = StringTableBuilder PathComponentId -> StringTable PathComponentId
forall id. Enum id => StringTableBuilder id -> StringTable id
StringTable.finalise StringTableBuilder PathComponentId
stbl
pathTrie :: IntTrie PathComponentId TarEntryOffset
pathTrie = IntTrieBuilder PathComponentId TarEntryOffset
-> IntTrie PathComponentId TarEntryOffset
forall k v. IntTrieBuilder k v -> IntTrie k v
IntTrie.finalise IntTrieBuilder PathComponentId TarEntryOffset
itrie
finaliseIndex :: IndexBuilder -> TarIndex
finaliseIndex :: IndexBuilder -> TarIndex
finaliseIndex = IndexBuilder -> TarIndex
finalise
{-# DEPRECATED finaliseIndex "Use TarIndex.finalise" #-}
indexNextEntryOffset :: IndexBuilder -> TarEntryOffset
indexNextEntryOffset :: IndexBuilder -> TarEntryOffset
indexNextEntryOffset (IndexBuilder _ _ off :: TarEntryOffset
off) = TarEntryOffset
off
indexEndEntryOffset :: TarIndex -> TarEntryOffset
indexEndEntryOffset :: TarIndex -> TarEntryOffset
indexEndEntryOffset (TarIndex _ _ off :: TarEntryOffset
off) = TarEntryOffset
off
nextEntryOffset :: Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset :: Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset entry :: Entry
entry offset :: TarEntryOffset
offset =
TarEntryOffset
offset
TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ 1
TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ case Entry -> EntryContent
entryContent Entry
entry of
NormalFile _ size :: FileSize
size -> FileSize -> TarEntryOffset
blocks FileSize
size
OtherEntryType _ _ size :: FileSize
size -> FileSize -> TarEntryOffset
blocks FileSize
size
_ -> 0
where
blocks :: Int64 -> TarEntryOffset
blocks :: FileSize -> TarEntryOffset
blocks size :: FileSize
size = FileSize -> TarEntryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (1 FileSize -> FileSize -> FileSize
forall a. Num a => a -> a -> a
+ (FileSize
size FileSize -> FileSize -> FileSize
forall a. Num a => a -> a -> a
- 1) FileSize -> FileSize -> FileSize
forall a. Integral a => a -> a -> a
`div` 512)
type FilePathBS = BS.ByteString
splitTarPath :: TarPath -> [FilePathBS]
splitTarPath :: TarPath -> [ByteString]
splitTarPath (TarPath name :: ByteString
name prefix :: ByteString
prefix) =
ByteString -> [ByteString]
splitDirectories ByteString
prefix [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ByteString -> [ByteString]
splitDirectories ByteString
name
splitDirectories :: FilePathBS -> [FilePathBS]
splitDirectories :: ByteString -> [ByteString]
splitDirectories bs :: ByteString
bs =
case Char -> ByteString -> [ByteString]
BS.Char8.split '/' ByteString
bs of
c :: ByteString
c:cs :: [ByteString]
cs | ByteString -> Bool
BS.null ByteString
c -> Char -> ByteString
BS.Char8.singleton '/' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
cs
cs :: [ByteString]
cs -> (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
cs
unfinalise :: TarIndex -> IndexBuilder
unfinalise :: TarIndex -> IndexBuilder
unfinalise (TarIndex pathTable :: StringTable PathComponentId
pathTable pathTrie :: IntTrie PathComponentId TarEntryOffset
pathTrie finalOffset :: TarEntryOffset
finalOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder PathComponentId TarEntryOffset
-> TarEntryOffset
-> IndexBuilder
IndexBuilder (StringTable PathComponentId -> StringTableBuilder PathComponentId
forall id. Enum id => StringTable id -> StringTableBuilder id
StringTable.unfinalise StringTable PathComponentId
pathTable)
(IntTrie PathComponentId TarEntryOffset
-> IntTrieBuilder PathComponentId TarEntryOffset
forall k v. (Enum k, Enum v) => IntTrie k v -> IntTrieBuilder k v
IntTrie.unfinalise IntTrie PathComponentId TarEntryOffset
pathTrie)
TarEntryOffset
finalOffset
hReadEntry :: Handle -> TarEntryOffset -> IO Entry
hReadEntry :: Handle -> TarEntryOffset -> IO Entry
hReadEntry hnd :: Handle
hnd off :: TarEntryOffset
off = do
Entry
entry <- Handle -> TarEntryOffset -> IO Entry
hReadEntryHeader Handle
hnd TarEntryOffset
off
case Entry -> EntryContent
entryContent Entry
entry of
NormalFile _ size :: FileSize
size -> do ByteString
body <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd (FileSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileSize
size)
Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entry {
entryContent :: EntryContent
entryContent = ByteString -> FileSize -> EntryContent
NormalFile ByteString
body FileSize
size
}
OtherEntryType c :: Char
c _ size :: FileSize
size -> do ByteString
body <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd (FileSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileSize
size)
Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entry {
entryContent :: EntryContent
entryContent = Char -> ByteString -> FileSize -> EntryContent
OtherEntryType Char
c ByteString
body FileSize
size
}
_ -> Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entry
hReadEntryHeader :: Handle -> TarEntryOffset -> IO Entry
hnd :: Handle
hnd blockOff :: TarEntryOffset
blockOff = do
Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset Handle
hnd TarEntryOffset
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd 512
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next entry :: Entry
entry _ -> Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entry
Tar.Fail e :: FormatError
e -> FormatError -> IO Entry
forall e a. Exception e => e -> IO a
throwIO FormatError
e
Tar.Done -> String -> IO Entry
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "hReadEntryHeader: impossible"
hSeekEntryOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset hnd :: Handle
hnd blockOff :: TarEntryOffset
blockOff =
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hnd SeekMode
AbsoluteSeek (TarEntryOffset -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral TarEntryOffset
blockOff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 512)
hSeekEntryContentOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryContentOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryContentOffset hnd :: Handle
hnd blockOff :: TarEntryOffset
blockOff =
Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset Handle
hnd (TarEntryOffset
blockOff TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ 1)
hReadEntryHeaderOrEof :: Handle -> TarEntryOffset
-> IO (Maybe (Entry, TarEntryOffset))
hnd :: Handle
hnd blockOff :: TarEntryOffset
blockOff = do
Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset Handle
hnd TarEntryOffset
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd 1024
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next entry :: Entry
entry _ -> let !blockOff' :: TarEntryOffset
blockOff' = Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset Entry
entry TarEntryOffset
blockOff
in Maybe (Entry, TarEntryOffset) -> IO (Maybe (Entry, TarEntryOffset))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Entry, TarEntryOffset) -> Maybe (Entry, TarEntryOffset)
forall a. a -> Maybe a
Just (Entry
entry, TarEntryOffset
blockOff'))
Tar.Done -> Maybe (Entry, TarEntryOffset) -> IO (Maybe (Entry, TarEntryOffset))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Entry, TarEntryOffset)
forall a. Maybe a
Nothing
Tar.Fail e :: FormatError
e -> FormatError -> IO (Maybe (Entry, TarEntryOffset))
forall e a. Exception e => e -> IO a
throwIO FormatError
e
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO TarEntryOffset
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO TarEntryOffset
hSeekEndEntryOffset hnd :: Handle
hnd (Just index :: TarIndex
index) = do
let offset :: TarEntryOffset
offset = TarIndex -> TarEntryOffset
indexEndEntryOffset TarIndex
index
Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset Handle
hnd TarEntryOffset
offset
TarEntryOffset -> IO TarEntryOffset
forall (m :: * -> *) a. Monad m => a -> m a
return TarEntryOffset
offset
hSeekEndEntryOffset hnd :: Handle
hnd Nothing = do
Integer
size <- Handle -> IO Integer
hFileSize Handle
hnd
if Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then TarEntryOffset -> IO TarEntryOffset
forall (m :: * -> *) a. Monad m => a -> m a
return 0
else TarEntryOffset -> IO TarEntryOffset
seekToEnd 0
where
seekToEnd :: TarEntryOffset -> IO TarEntryOffset
seekToEnd offset :: TarEntryOffset
offset = do
Maybe (Entry, TarEntryOffset)
mbe <- Handle -> TarEntryOffset -> IO (Maybe (Entry, TarEntryOffset))
hReadEntryHeaderOrEof Handle
hnd TarEntryOffset
offset
case Maybe (Entry, TarEntryOffset)
mbe of
Nothing -> do Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset Handle
hnd TarEntryOffset
offset
TarEntryOffset -> IO TarEntryOffset
forall (m :: * -> *) a. Monad m => a -> m a
return TarEntryOffset
offset
Just (_, offset' :: TarEntryOffset
offset') -> TarEntryOffset -> IO TarEntryOffset
seekToEnd TarEntryOffset
offset'
serialise :: TarIndex -> BS.ByteString
serialise :: TarIndex -> ByteString
serialise = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (TarIndex -> ByteString) -> TarIndex -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarIndex -> ByteString
serialiseLBS
serialiseLBS :: TarIndex -> LBS.ByteString
serialiseLBS :: TarIndex -> ByteString
serialiseLBS index :: TarIndex
index =
AllocationStrategy -> ByteString -> Builder -> ByteString
BS.toLazyByteStringWith
(Int -> Int -> AllocationStrategy
BS.untrimmedStrategy (TarIndex -> Int
serialiseSize TarIndex
index) 512) ByteString
LBS.empty
(TarIndex -> Builder
serialiseBuilder TarIndex
index)
serialiseSize :: TarIndex -> Int
serialiseSize :: TarIndex -> Int
serialiseSize (TarIndex stringTable :: StringTable PathComponentId
stringTable intTrie :: IntTrie PathComponentId TarEntryOffset
intTrie _) =
StringTable PathComponentId -> Int
forall id. StringTable id -> Int
StringTable.serialiseSize StringTable PathComponentId
stringTable
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IntTrie PathComponentId TarEntryOffset -> Int
forall k v. IntTrie k v -> Int
IntTrie.serialiseSize IntTrie PathComponentId TarEntryOffset
intTrie
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8
serialiseBuilder :: TarIndex -> BS.Builder
serialiseBuilder :: TarIndex -> Builder
serialiseBuilder (TarIndex stringTable :: StringTable PathComponentId
stringTable intTrie :: IntTrie PathComponentId TarEntryOffset
intTrie finalOffset :: TarEntryOffset
finalOffset) =
TarEntryOffset -> Builder
BS.word32BE 2
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TarEntryOffset -> Builder
BS.word32BE TarEntryOffset
finalOffset
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StringTable PathComponentId -> Builder
forall id. StringTable id -> Builder
StringTable.serialise StringTable PathComponentId
stringTable
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntTrie PathComponentId TarEntryOffset -> Builder
forall k v. IntTrie k v -> Builder
IntTrie.serialise IntTrie PathComponentId TarEntryOffset
intTrie
deserialise :: BS.ByteString -> Maybe (TarIndex, BS.ByteString)
deserialise :: ByteString -> Maybe (TarIndex, ByteString)
deserialise bs :: ByteString
bs
| ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 8
= Maybe (TarIndex, ByteString)
forall a. Maybe a
Nothing
| let ver :: TarEntryOffset
ver = ByteString -> Int -> TarEntryOffset
readWord32BE ByteString
bs 0
, TarEntryOffset
ver TarEntryOffset -> TarEntryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== 1
= do let !finalOffset :: TarEntryOffset
finalOffset = ByteString -> Int -> TarEntryOffset
readWord32BE ByteString
bs 4
(stringTable :: StringTable PathComponentId
stringTable, bs' :: ByteString
bs') <- ByteString -> Maybe (StringTable PathComponentId, ByteString)
forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV1 (Int -> ByteString -> ByteString
BS.drop 8 ByteString
bs)
(intTrie :: IntTrie PathComponentId TarEntryOffset
intTrie, bs'' :: ByteString
bs'') <- ByteString
-> Maybe (IntTrie PathComponentId TarEntryOffset, ByteString)
forall k v. ByteString -> Maybe (IntTrie k v, ByteString)
IntTrie.deserialise ByteString
bs'
(TarIndex, ByteString) -> Maybe (TarIndex, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId
-> IntTrie PathComponentId TarEntryOffset
-> TarEntryOffset
-> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie PathComponentId TarEntryOffset
intTrie TarEntryOffset
finalOffset, ByteString
bs'')
| let ver :: TarEntryOffset
ver = ByteString -> Int -> TarEntryOffset
readWord32BE ByteString
bs 0
, TarEntryOffset
ver TarEntryOffset -> TarEntryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== 2
= do let !finalOffset :: TarEntryOffset
finalOffset = ByteString -> Int -> TarEntryOffset
readWord32BE ByteString
bs 4
(stringTable :: StringTable PathComponentId
stringTable, bs' :: ByteString
bs') <- ByteString -> Maybe (StringTable PathComponentId, ByteString)
forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV2 (Int -> ByteString -> ByteString
BS.drop 8 ByteString
bs)
(intTrie :: IntTrie PathComponentId TarEntryOffset
intTrie, bs'' :: ByteString
bs'') <- ByteString
-> Maybe (IntTrie PathComponentId TarEntryOffset, ByteString)
forall k v. ByteString -> Maybe (IntTrie k v, ByteString)
IntTrie.deserialise ByteString
bs'
(TarIndex, ByteString) -> Maybe (TarIndex, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId
-> IntTrie PathComponentId TarEntryOffset
-> TarEntryOffset
-> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie PathComponentId TarEntryOffset
intTrie TarEntryOffset
finalOffset, ByteString
bs'')
| Bool
otherwise = Maybe (TarIndex, ByteString)
forall a. Maybe a
Nothing
readWord32BE :: BS.ByteString -> Int -> Word32
readWord32BE :: ByteString -> Int -> TarEntryOffset
readWord32BE bs :: ByteString
bs i :: Int
i =
Bool -> TarEntryOffset -> TarEntryOffset
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (TarEntryOffset -> TarEntryOffset)
-> TarEntryOffset -> TarEntryOffset
forall a b. (a -> b) -> a -> b
$
Word8 -> TarEntryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 0)) TarEntryOffset -> Int -> TarEntryOffset
forall a. Bits a => a -> Int -> a
`shiftL` 24
TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ Word8 -> TarEntryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) TarEntryOffset -> Int -> TarEntryOffset
forall a. Bits a => a -> Int -> a
`shiftL` 16
TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ Word8 -> TarEntryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)) TarEntryOffset -> Int -> TarEntryOffset
forall a. Bits a => a -> Int -> a
`shiftL` 8
TarEntryOffset -> TarEntryOffset -> TarEntryOffset
forall a. Num a => a -> a -> a
+ Word8 -> TarEntryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3))
#ifdef TESTS
prop_lookup :: ValidPaths -> NonEmptyFilePath -> Bool
prop_lookup (ValidPaths paths) (NonEmptyFilePath p) =
case (lookup index p, Prelude.lookup p paths) of
(Nothing, Nothing) -> True
(Just (TarFileEntry offset), Just (_,offset')) -> offset == offset'
(Just (TarDir entries), Nothing) -> sort (nub (map fst entries))
== sort (nub completions)
_ -> False
where
index = construct paths
completions = [ head (FilePath.splitDirectories completion)
| (path,_) <- paths
, completion <- maybeToList $ stripPrefix (p ++ "/") path ]
prop_toList :: ValidPaths -> Bool
prop_toList (ValidPaths paths) =
sort (toList index)
== sort [ (path, off) | (path, (_sz, off)) <- paths ]
where
index = construct paths
prop_valid :: ValidPaths -> Bool
prop_valid (ValidPaths paths)
| not $ StringTable.prop_valid pathbits = error "TarIndex: bad string table"
| not $ IntTrie.prop_lookup intpaths = error "TarIndex: bad int trie"
| not $ IntTrie.prop_completions intpaths = error "TarIndex: bad int trie"
| not $ prop' = error "TarIndex: bad prop"
| otherwise = True
where
index@(TarIndex pathTable _ _) = construct paths
pathbits = concatMap (map BS.Char8.pack . FilePath.splitDirectories . fst)
paths
intpaths = [ (cids, offset)
| (path, (_size, offset)) <- paths
, let Just cids = toComponentIds pathTable path ]
prop' = flip all paths $ \(file, (_size, offset)) ->
case lookup index file of
Just (TarFileEntry offset') -> offset' == offset
_ -> False
prop_serialise_deserialise :: ValidPaths -> Bool
prop_serialise_deserialise (ValidPaths paths) =
Just (index, BS.empty) == (deserialise . serialise) index
where
index = construct paths
prop_serialiseSize :: ValidPaths -> Bool
prop_serialiseSize (ValidPaths paths) =
case (LBS.toChunks . serialiseLBS) index of
[c1] -> BS.length c1 == serialiseSize index
_ -> False
where
index = construct paths
newtype NonEmptyFilePath = NonEmptyFilePath FilePath deriving Show
instance Arbitrary NonEmptyFilePath where
arbitrary = NonEmptyFilePath . FilePath.joinPath
<$> listOf1 (elements ["a", "b", "c", "d"])
newtype ValidPaths = ValidPaths [(FilePath, (Int64, TarEntryOffset))] deriving Show
instance Arbitrary ValidPaths where
arbitrary = do
paths <- makeNoPrefix <$> listOf arbitraryPath
sizes <- vectorOf (length paths) (getNonNegative <$> arbitrary)
let offsets = scanl (\o sz -> o + 1 + blocks sz) 0 sizes
return (ValidPaths (zip paths (zip sizes offsets)))
where
arbitraryPath = FilePath.joinPath
<$> listOf1 (elements ["a", "b", "c", "d"])
makeNoPrefix [] = []
makeNoPrefix (k:ks)
| all (not . isPrefixOfOther k) ks
= k : makeNoPrefix ks
| otherwise = makeNoPrefix ks
isPrefixOfOther a b = a `isPrefixOf` b || b `isPrefixOf` a
blocks :: Int64 -> TarEntryOffset
blocks size = fromIntegral (1 + ((size - 1) `div` 512))
construct :: [(FilePath, (Int64, TarEntryOffset))] -> TarIndex
construct =
either (\_ -> undefined) id
. build
. foldr (\(path, (size, _off)) es -> Next (testEntry path size) es) Done
example0 :: Entries ()
example0 =
testEntry "foo-1.0/foo-1.0.cabal" 1500
`Next` testEntry "foo-1.0/LICENSE" 2000
`Next` testEntry "foo-1.0/Data/Foo.hs" 1000
`Next` Done
example1 :: Entries ()
example1 =
Next (testEntry "./" 1500) Done <> example0
testEntry :: FilePath -> Int64 -> Entry
testEntry name size = simpleEntry path (NormalFile mempty size)
where
Right path = toTarPath False name
data SimpleTarArchive = SimpleTarArchive {
simpleTarEntries :: Tar.Entries ()
, simpleTarRaw :: [(FilePath, LBS.ByteString)]
, simpleTarBS :: LBS.ByteString
}
instance Show SimpleTarArchive where
show = show . simpleTarRaw
prop_index_matches_tar :: SimpleTarArchive -> Property
prop_index_matches_tar sta =
ioProperty (try go >>= either (\e -> throwIO (e :: SomeException))
(\_ -> return True))
where
go :: IO ()
go = do
h <- HBS.readHandle True (simpleTarBS sta)
goEntries h 0 (simpleTarEntries sta)
goEntries :: Handle -> TarEntryOffset -> Tar.Entries () -> IO ()
goEntries _ _ Tar.Done =
return ()
goEntries _ _ (Tar.Fail _) =
throwIO (userError "Fail entry in SimpleTarArchive")
goEntries h offset (Tar.Next e es) = do
goEntry h offset e
goEntries h (nextEntryOffset e offset) es
goEntry :: Handle -> TarEntryOffset -> Tar.Entry -> IO ()
goEntry h offset e = do
e' <- hReadEntry h offset
case (Tar.entryContent e, Tar.entryContent e') of
(Tar.NormalFile bs sz, Tar.NormalFile bs' sz') ->
unless (sz == sz' && bs == bs') $
throwIO $ userError "Entry mismatch"
_otherwise ->
throwIO $ userError "unexpected entry types"
instance Arbitrary SimpleTarArchive where
arbitrary = do
numEntries <- sized $ \n -> choose (0, n)
rawEntries <- mkRaw numEntries
let entries = mkList rawEntries
return SimpleTarArchive {
simpleTarEntries = mkEntries entries
, simpleTarRaw = rawEntries
, simpleTarBS = Tar.write entries
}
where
mkRaw :: Int -> Gen [(FilePath, LBS.ByteString)]
mkRaw 0 = return []
mkRaw n = do
sz <- sized $ \n -> elements (take n fileSizes)
bs <- LBS.pack `fmap` vectorOf sz arbitrary
es <- mkRaw (n - 1)
return $ ("file" ++ show n, bs) : es
mkList :: [(FilePath, LBS.ByteString)] -> [Tar.Entry]
mkList [] = []
mkList ((fp, bs):es) = entry : mkList es
where
Right path = toTarPath False fp
entry = simpleEntry path content
content = NormalFile bs (LBS.length bs)
mkEntries :: [Tar.Entry] -> Tar.Entries ()
mkEntries [] = Tar.Done
mkEntries (e:es) = Tar.Next e (mkEntries es)
fileSizes :: [Int]
fileSizes = [
0 , 1 , 2
, 510 , 511 , 512 , 513 , 514
, 1022 , 1023 , 1024 , 1025 , 1026
]
newtype SimpleIndexBuilder = SimpleIndexBuilder IndexBuilder
deriving Show
instance Arbitrary SimpleIndexBuilder where
arbitrary = SimpleIndexBuilder . build' . simpleTarEntries <$> arbitrary
where
build' :: Show e => Entries e -> IndexBuilder
build' = go empty
where
go !builder (Next e es) = go (addNextEntry e builder) es
go !builder Done = builder
go !_ (Fail err) = error (show err)
prop_finalise_unfinalise :: SimpleIndexBuilder -> Bool
prop_finalise_unfinalise (SimpleIndexBuilder index) =
unfinalise (finalise index) == index
#endif
toStrict :: LBS.ByteString -> BS.ByteString
#if MIN_VERSION_bytestring(0,10,0)
toStrict :: ByteString -> ByteString
toStrict = ByteString -> ByteString
LBS.toStrict
#else
toStrict = BS.concat . LBS.toChunks
#endif
#if !(MIN_VERSION_base(4,5,0))
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif