{-# LANGUAGE CPP, BangPatterns, PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}
module Codec.Archive.Tar.Index.Internal (
TarIndex(..),
lookup,
TarIndexEntry(..),
toList,
PathComponentId(..),
TarEntryOffset,
hReadEntry,
hReadEntryHeader,
build,
IndexBuilder,
empty,
addNextEntry,
skipNextEntry,
finalise,
unfinalise,
serialise,
deserialise,
hReadEntryHeaderOrEof,
hSeekEntryOffset,
hSeekEntryContentOffset,
hSeekEndEntryOffset,
nextEntryOffset,
indexEndEntryOffset,
indexNextEntryOffset,
toComponentIds,
serialiseLBS,
serialiseSize,
) 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 Codec.Archive.Tar.PackAscii
import qualified System.FilePath.Posix as FilePath
import Data.Monoid (Monoid(..))
import Data.Monoid ((<>))
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
import Data.ByteString.Builder as BS
import Data.ByteString.Builder.Extra as BS (toLazyByteStringWith,
untrimmedStrategy)
data TarIndex = TarIndex
{-# UNPACK #-} !(StringTable PathComponentId)
{-# UNPACK #-} !IntTrie
{-# UNPACK #-} !TarEntryOffset
deriving (TarIndex -> TarIndex -> Bool
(TarIndex -> TarIndex -> Bool)
-> (TarIndex -> TarIndex -> Bool) -> Eq TarIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TarIndex -> TarIndex -> Bool
== :: TarIndex -> TarIndex -> Bool
$c/= :: TarIndex -> TarIndex -> Bool
/= :: 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
$cshowsPrec :: Int -> TarIndex -> ShowS
showsPrec :: Int -> TarIndex -> ShowS
$cshow :: TarIndex -> String
show :: TarIndex -> String
$cshowList :: [TarIndex] -> ShowS
showList :: [TarIndex] -> ShowS
Show, Typeable)
instance NFData TarIndex where
rnf :: TarIndex -> ()
rnf (TarIndex StringTable PathComponentId
_ IntTrie
_ Word32
_) = ()
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
$cshowsPrec :: Int -> TarIndexEntry -> ShowS
showsPrec :: Int -> TarIndexEntry -> ShowS
$cshow :: TarIndexEntry -> String
show :: TarIndexEntry -> String
$cshowList :: [TarIndexEntry] -> ShowS
showList :: [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
$c== :: PathComponentId -> PathComponentId -> Bool
== :: PathComponentId -> PathComponentId -> Bool
$c/= :: PathComponentId -> PathComponentId -> Bool
/= :: 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
$ccompare :: PathComponentId -> PathComponentId -> Ordering
compare :: PathComponentId -> PathComponentId -> Ordering
$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
>= :: PathComponentId -> PathComponentId -> Bool
$cmax :: PathComponentId -> PathComponentId -> PathComponentId
max :: PathComponentId -> PathComponentId -> PathComponentId
$cmin :: PathComponentId -> PathComponentId -> PathComponentId
min :: PathComponentId -> PathComponentId -> 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
$csucc :: PathComponentId -> PathComponentId
succ :: PathComponentId -> PathComponentId
$cpred :: PathComponentId -> PathComponentId
pred :: PathComponentId -> PathComponentId
$ctoEnum :: Int -> PathComponentId
toEnum :: Int -> PathComponentId
$cfromEnum :: PathComponentId -> Int
fromEnum :: PathComponentId -> Int
$cenumFrom :: PathComponentId -> [PathComponentId]
enumFrom :: PathComponentId -> [PathComponentId]
$cenumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromThenTo :: PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
enumFromThenTo :: PathComponentId
-> PathComponentId -> 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
$cshowsPrec :: Int -> PathComponentId -> ShowS
showsPrec :: Int -> PathComponentId -> ShowS
$cshow :: PathComponentId -> String
show :: PathComponentId -> String
$cshowList :: [PathComponentId] -> ShowS
showList :: [PathComponentId] -> ShowS
Show, Typeable)
type TarEntryOffset = Word32
lookup :: TarIndex -> FilePath -> Maybe TarIndexEntry
lookup :: TarIndex -> String -> Maybe TarIndexEntry
lookup (TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
_) String
path = do
[PathComponentId]
fpath <- StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds StringTable PathComponentId
pathTable String
path
TrieLookup
tentry <- IntTrie -> [Key] -> Maybe TrieLookup
IntTrie.lookup IntTrie
pathTrie ([Key] -> Maybe TrieLookup) -> [Key] -> Maybe TrieLookup
forall a b. (a -> b) -> a -> b
$ (PathComponentId -> Key) -> [PathComponentId] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map PathComponentId -> Key
pathComponentIdToKey [PathComponentId]
fpath
TarIndexEntry -> Maybe TarIndexEntry
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrieLookup -> TarIndexEntry
mkIndexEntry TrieLookup
tentry)
where
mkIndexEntry :: TrieLookup -> TarIndexEntry
mkIndexEntry (IntTrie.Entry Value
offset) = Word32 -> TarIndexEntry
TarFileEntry (Word32 -> TarIndexEntry) -> Word32 -> TarIndexEntry
forall a b. (a -> b) -> a -> b
$ Value -> Word32
IntTrie.unValue Value
offset
mkIndexEntry (IntTrie.Completions Completions
entries) =
[(String, TarIndexEntry)] -> TarIndexEntry
TarDir [ (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable (PathComponentId -> String) -> PathComponentId -> String
forall a b. (a -> b) -> a -> b
$ Key -> PathComponentId
keyToPathComponentId Key
key, TrieLookup -> TarIndexEntry
mkIndexEntry TrieLookup
entry)
| (Key
key, TrieLookup
entry) <- Completions
entries ]
toComponentIds :: StringTable PathComponentId -> FilePath -> Maybe [PathComponentId]
toComponentIds :: StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds 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 Char
'.')
([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
. PosixString -> ByteString
posixToByteString
(PosixString -> ByteString)
-> (String -> PosixString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PosixString
toPosixString
where
lookupComponents :: [PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents [PathComponentId]
cs' [] = [PathComponentId] -> Maybe [PathComponentId]
forall a. a -> Maybe a
Just ([PathComponentId] -> [PathComponentId]
forall a. [a] -> [a]
reverse [PathComponentId]
cs')
lookupComponents [PathComponentId]
cs' (ByteString
c:[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
Maybe PathComponentId
Nothing -> Maybe [PathComponentId]
forall a. Maybe a
Nothing
Just 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 StringTable PathComponentId
table = PosixString -> String
fromPosixString (PosixString -> String)
-> (PathComponentId -> PosixString) -> PathComponentId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PosixString
byteToPosixString (ByteString -> PosixString)
-> (PathComponentId -> ByteString)
-> PathComponentId
-> PosixString
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, Word32)]
toList (TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
_) =
[ (String
path, Value -> Word32
IntTrie.unValue Value
off)
| ([Key]
cids, Value
off) <- IntTrie -> [([Key], Value)]
IntTrie.toList IntTrie
pathTrie
, let path :: String
path = [String] -> String
FilePath.joinPath ((Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable (PathComponentId -> String)
-> (Key -> PathComponentId) -> Key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> PathComponentId
keyToPathComponentId) [Key]
cids) ]
build :: Entries e -> Either e TarIndex
build :: forall e. Entries e -> Either e TarIndex
build = IndexBuilder
-> GenEntries TarPath LinkTarget e -> Either e TarIndex
forall {a}.
IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go IndexBuilder
empty
where
go :: IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go !IndexBuilder
builder (Next GenEntry TarPath LinkTarget
e GenEntries TarPath LinkTarget a
es) = IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go (GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
addNextEntry GenEntry TarPath LinkTarget
e IndexBuilder
builder) GenEntries TarPath LinkTarget a
es
go !IndexBuilder
builder GenEntries TarPath LinkTarget a
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 a
err) = a -> Either a TarIndex
forall a b. a -> Either a b
Left a
err
data IndexBuilder
= IndexBuilder !(StringTableBuilder PathComponentId)
!IntTrieBuilder
{-# UNPACK #-} !TarEntryOffset
deriving (IndexBuilder -> IndexBuilder -> Bool
(IndexBuilder -> IndexBuilder -> Bool)
-> (IndexBuilder -> IndexBuilder -> Bool) -> Eq IndexBuilder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexBuilder -> IndexBuilder -> Bool
== :: IndexBuilder -> IndexBuilder -> Bool
$c/= :: IndexBuilder -> IndexBuilder -> Bool
/= :: 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
$cshowsPrec :: Int -> IndexBuilder -> ShowS
showsPrec :: Int -> IndexBuilder -> ShowS
$cshow :: IndexBuilder -> String
show :: IndexBuilder -> String
$cshowList :: [IndexBuilder] -> ShowS
showList :: [IndexBuilder] -> ShowS
Show)
instance NFData IndexBuilder where
rnf :: IndexBuilder -> ()
rnf IndexBuilder{} = ()
empty :: IndexBuilder
empty :: IndexBuilder
empty = StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
forall id. StringTableBuilder id
StringTable.empty IntTrieBuilder
IntTrie.empty Word32
0
addNextEntry :: Entry -> IndexBuilder -> IndexBuilder
addNextEntry :: GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
addNextEntry GenEntry TarPath LinkTarget
entry (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl' IntTrieBuilder
itrie'
(GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
nextOffset)
where
!entrypath :: [ByteString]
entrypath = TarPath -> [ByteString]
splitTarPath (GenEntry TarPath LinkTarget -> TarPath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry TarPath LinkTarget
entry)
(StringTableBuilder PathComponentId
stbl', [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
itrie' = [Key] -> Value -> IntTrieBuilder -> IntTrieBuilder
IntTrie.insert ((PathComponentId -> Key) -> [PathComponentId] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map PathComponentId -> Key
pathComponentIdToKey [PathComponentId]
cids) (Word32 -> Value
IntTrie.Value Word32
nextOffset) IntTrieBuilder
itrie
skipNextEntry :: Entry -> IndexBuilder -> IndexBuilder
skipNextEntry :: GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
skipNextEntry GenEntry TarPath LinkTarget
entry (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie (GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
nextOffset)
finalise :: IndexBuilder -> TarIndex
finalise :: IndexBuilder -> TarIndex
finalise (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
finalOffset) =
StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
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
pathTrie = IntTrieBuilder -> IntTrie
IntTrie.finalise IntTrieBuilder
itrie
indexNextEntryOffset :: IndexBuilder -> TarEntryOffset
indexNextEntryOffset :: IndexBuilder -> Word32
indexNextEntryOffset (IndexBuilder StringTableBuilder PathComponentId
_ IntTrieBuilder
_ Word32
off) = Word32
off
indexEndEntryOffset :: TarIndex -> TarEntryOffset
indexEndEntryOffset :: TarIndex -> Word32
indexEndEntryOffset (TarIndex StringTable PathComponentId
_ IntTrie
_ Word32
off) = Word32
off
nextEntryOffset :: Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset :: GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
offset =
Word32
offset
Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ case GenEntry TarPath LinkTarget -> GenEntryContent LinkTarget
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent GenEntry TarPath LinkTarget
entry of
NormalFile ByteString
_ FileSize
size -> FileSize -> Word32
blocks FileSize
size
OtherEntryType Char
_ ByteString
_ FileSize
size -> FileSize -> Word32
blocks FileSize
size
GenEntryContent LinkTarget
_ -> Word32
0
where
blocks :: Int64 -> TarEntryOffset
blocks :: FileSize -> Word32
blocks FileSize
size = FileSize -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileSize
1 FileSize -> FileSize -> FileSize
forall a. Num a => a -> a -> a
+ (FileSize
size FileSize -> FileSize -> FileSize
forall a. Num a => a -> a -> a
- FileSize
1) FileSize -> FileSize -> FileSize
forall a. Integral a => a -> a -> a
`div` FileSize
512)
type FilePathBS = BS.ByteString
splitTarPath :: TarPath -> [FilePathBS]
splitTarPath :: TarPath -> [ByteString]
splitTarPath (TarPath PosixString
name PosixString
prefix) =
ByteString -> [ByteString]
splitDirectories (PosixString -> ByteString
posixToByteString PosixString
prefix) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ByteString -> [ByteString]
splitDirectories (PosixString -> ByteString
posixToByteString PosixString
name)
splitDirectories :: FilePathBS -> [FilePathBS]
splitDirectories :: ByteString -> [ByteString]
splitDirectories ByteString
bs =
case Char -> ByteString -> [ByteString]
BS.Char8.split Char
'/' ByteString
bs of
ByteString
c:[ByteString]
cs | ByteString -> Bool
BS.null ByteString
c -> Char -> ByteString
BS.Char8.singleton Char
'/' 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
[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 StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
finalOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder (StringTable PathComponentId -> StringTableBuilder PathComponentId
forall id. Enum id => StringTable id -> StringTableBuilder id
StringTable.unfinalise StringTable PathComponentId
pathTable)
(IntTrie -> IntTrieBuilder
IntTrie.unfinalise IntTrie
pathTrie)
Word32
finalOffset
hReadEntry :: Handle -> TarEntryOffset -> IO Entry
hReadEntry :: Handle -> Word32 -> IO (GenEntry TarPath LinkTarget)
hReadEntry Handle
hnd Word32
off = do
GenEntry TarPath LinkTarget
entry <- Handle -> Word32 -> IO (GenEntry TarPath LinkTarget)
hReadEntryHeader Handle
hnd Word32
off
case GenEntry TarPath LinkTarget -> GenEntryContent LinkTarget
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent GenEntry TarPath LinkTarget
entry of
NormalFile ByteString
_ 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)
GenEntry TarPath LinkTarget -> IO (GenEntry TarPath LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry {
entryContent = NormalFile body size
}
OtherEntryType Char
c ByteString
_ 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)
GenEntry TarPath LinkTarget -> IO (GenEntry TarPath LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry {
entryContent = OtherEntryType c body size
}
GenEntryContent LinkTarget
_ -> GenEntry TarPath LinkTarget -> IO (GenEntry TarPath LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry
hReadEntryHeader :: Handle -> TarEntryOffset -> IO Entry
Handle
hnd Word32
blockOff = do
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd Int
512
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next GenEntry TarPath LinkTarget
entry Entries FormatError
_ -> GenEntry TarPath LinkTarget -> IO (GenEntry TarPath LinkTarget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry
Tar.Fail FormatError
e -> FormatError -> IO (GenEntry TarPath LinkTarget)
forall e a. Exception e => e -> IO a
throwIO FormatError
e
Entries FormatError
Tar.Done -> String -> IO (GenEntry TarPath LinkTarget)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hReadEntryHeader: impossible"
hSeekEntryOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset :: Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff =
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hnd SeekMode
AbsoluteSeek (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
blockOff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
512)
hSeekEntryContentOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryContentOffset :: Handle -> Word32 -> IO ()
hSeekEntryContentOffset Handle
hnd Word32
blockOff =
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd (Word32
blockOff Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
hReadEntryHeaderOrEof :: Handle -> TarEntryOffset
-> IO (Maybe (Entry, TarEntryOffset))
Handle
hnd Word32
blockOff = do
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd Int
1024
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next GenEntry TarPath LinkTarget
entry Entries FormatError
_ -> let !blockOff' :: Word32
blockOff' = GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
blockOff
in Maybe (GenEntry TarPath LinkTarget, Word32)
-> IO (Maybe (GenEntry TarPath LinkTarget, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenEntry TarPath LinkTarget, Word32)
-> Maybe (GenEntry TarPath LinkTarget, Word32)
forall a. a -> Maybe a
Just (GenEntry TarPath LinkTarget
entry, Word32
blockOff'))
Entries FormatError
Tar.Done -> Maybe (GenEntry TarPath LinkTarget, Word32)
-> IO (Maybe (GenEntry TarPath LinkTarget, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenEntry TarPath LinkTarget, Word32)
forall a. Maybe a
Nothing
Tar.Fail FormatError
e -> FormatError -> IO (Maybe (GenEntry TarPath LinkTarget, Word32))
forall e a. Exception e => e -> IO a
throwIO FormatError
e
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO TarEntryOffset
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO Word32
hSeekEndEntryOffset Handle
hnd (Just TarIndex
index) = do
let offset :: Word32
offset = TarIndex -> Word32
indexEndEntryOffset TarIndex
index
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
offset
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
offset
hSeekEndEntryOffset Handle
hnd Maybe TarIndex
Nothing = do
Integer
size <- Handle -> IO Integer
hFileSize Handle
hnd
if Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
then Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
else Word32 -> IO Word32
seekToEnd Word32
0
where
seekToEnd :: Word32 -> IO Word32
seekToEnd Word32
offset = do
Maybe (GenEntry TarPath LinkTarget, Word32)
mbe <- Handle
-> Word32 -> IO (Maybe (GenEntry TarPath LinkTarget, Word32))
hReadEntryHeaderOrEof Handle
hnd Word32
offset
case Maybe (GenEntry TarPath LinkTarget, Word32)
mbe of
Maybe (GenEntry TarPath LinkTarget, Word32)
Nothing -> do Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
offset
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
offset
Just (GenEntry TarPath LinkTarget
_, Word32
offset') -> Word32 -> IO Word32
seekToEnd Word32
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 TarIndex
index =
AllocationStrategy -> ByteString -> Builder -> ByteString
BS.toLazyByteStringWith
(Int -> Int -> AllocationStrategy
BS.untrimmedStrategy (TarIndex -> Int
serialiseSize TarIndex
index) Int
512) ByteString
LBS.empty
(TarIndex -> Builder
serialiseBuilder TarIndex
index)
serialiseSize :: TarIndex -> Int
serialiseSize :: TarIndex -> Int
serialiseSize (TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
_) =
StringTable PathComponentId -> Int
forall id. StringTable id -> Int
StringTable.serialiseSize StringTable PathComponentId
stringTable
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IntTrie -> Int
IntTrie.serialiseSize IntTrie
intTrie
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
serialiseBuilder :: TarIndex -> BS.Builder
serialiseBuilder :: TarIndex -> Builder
serialiseBuilder (TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset) =
Word32 -> Builder
BS.word32BE Word32
2
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BS.word32BE Word32
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 -> Builder
IntTrie.serialise IntTrie
intTrie
deserialise :: BS.ByteString -> Maybe (TarIndex, BS.ByteString)
deserialise :: ByteString -> Maybe (TarIndex, ByteString)
deserialise ByteString
bs
| ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
= Maybe (TarIndex, ByteString)
forall a. Maybe a
Nothing
| let ver :: Word32
ver = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0
, Word32
ver Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
1
= do let !finalOffset :: Word32
finalOffset = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4
(StringTable PathComponentId
stringTable, ByteString
bs') <- ByteString -> Maybe (StringTable PathComponentId, ByteString)
forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV1 (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
(IntTrie
intTrie, ByteString
bs'') <- ByteString -> Maybe (IntTrie, ByteString)
IntTrie.deserialise ByteString
bs'
(TarIndex, ByteString) -> Maybe (TarIndex, ByteString)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset, ByteString
bs'')
| let ver :: Word32
ver = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0
, Word32
ver Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
2
= do let !finalOffset :: Word32
finalOffset = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4
(StringTable PathComponentId
stringTable, ByteString
bs') <- ByteString -> Maybe (StringTable PathComponentId, ByteString)
forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV2 (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
(IntTrie
intTrie, ByteString
bs'') <- ByteString -> Maybe (IntTrie, ByteString)
IntTrie.deserialise ByteString
bs'
(TarIndex, ByteString) -> Maybe (TarIndex, ByteString)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset, ByteString
bs'')
| Bool
otherwise = Maybe (TarIndex, ByteString)
forall a. Maybe a
Nothing
readWord32BE :: BS.ByteString -> Int -> Word32
readWord32BE :: ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
i =
Bool -> Word32 -> Word32
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
- Int
1) (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
Word8 -> Word32
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
+ Int
0)) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24
Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
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
+ Int
1)) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
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
+ Int
2)) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
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
+ Int
3))
toStrict :: LBS.ByteString -> BS.ByteString
toStrict :: ByteString -> ByteString
toStrict = ByteString -> ByteString
LBS.toStrict
pathComponentIdToKey :: PathComponentId -> IntTrie.Key
pathComponentIdToKey :: PathComponentId -> Key
pathComponentIdToKey (PathComponentId Int
n) = Word32 -> Key
IntTrie.Key (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
keyToPathComponentId :: IntTrie.Key -> PathComponentId
keyToPathComponentId :: Key -> PathComponentId
keyToPathComponentId (IntTrie.Key Word32
n) = Int -> PathComponentId
PathComponentId (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)