{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, BangPatterns, DeriveTraversable, ScopedTypeVariables, RankNTypes #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Archive.Tar.Types
-- Copyright   :  (c) 2007 Bjorn Bringert,
--                    2008 Andrea Vezzosi,
--                    2008-2009 Duncan Coutts
--                    2011 Max Bolingbroke
-- License     :  BSD3
--
-- Maintainer  :  duncan@community.haskell.org
-- Portability :  portable
--
-- Types to represent the content of @.tar@ archives.
--
-----------------------------------------------------------------------------
module Codec.Archive.Tar.Types (

  GenEntry(..),
  Entry,
  entryPath,
  GenEntryContent(..),
  EntryContent,
  FileSize,
  Permissions,
  Ownership(..),
  EpochTime,
  TypeCode,
  DevMajor,
  DevMinor,
  Format(..),

  simpleEntry,
  longLinkEntry,
  longSymLinkEntry,
  fileEntry,
  symlinkEntry,
  directoryEntry,

  ordinaryFilePermissions,
  symbolicLinkPermission,
  executableFilePermissions,
  directoryPermissions,

  TarPath(..),
  toTarPath,
  toTarPath',
  ToTarPathResult(..),
  fromTarPath,
  fromTarPathToPosixPath,
  fromTarPathToWindowsPath,
  fromFilePathToNative,

  LinkTarget(..),
  toLinkTarget,
  fromLinkTarget,
  fromLinkTargetToPosixPath,
  fromLinkTargetToWindowsPath,
  fromFilePathToWindowsPath,

  GenEntries(..),
  Entries,
  mapEntries,
  mapEntriesNoFail,
  foldEntries,
  foldlEntries,
  unfoldEntries,
  ) where

import Data.Int      (Int64)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid   (Monoid(..))
import Data.Semigroup as Sem
import Data.Typeable
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy  as LBS
import Control.DeepSeq
import Control.Exception (Exception, displayException)

import qualified System.FilePath as FilePath.Native
         ( joinPath, splitDirectories, addTrailingPathSeparator, hasTrailingPathSeparator, pathSeparator, isAbsolute, hasTrailingPathSeparator )
import qualified System.FilePath.Posix as FilePath.Posix
         ( joinPath, splitPath, splitDirectories, hasTrailingPathSeparator
         , addTrailingPathSeparator, pathSeparator )
import qualified System.FilePath.Windows as FilePath.Windows
         ( joinPath, addTrailingPathSeparator, pathSeparator )
import System.Posix.Types
         ( FileMode )

import Codec.Archive.Tar.PackAscii

type FileSize  = Int64
-- | The number of seconds since the UNIX epoch
type EpochTime = Int64
type DevMajor  = Int
type DevMinor  = Int
type TypeCode  = Char
type Permissions = FileMode

-- | Polymorphic tar archive entry. High-level interfaces
-- commonly work with 'GenEntry' 'FilePath' 'FilePath',
-- while low level uses 'GenEntry' 'TarPath' 'LinkTarget'.
--
-- @since 0.6.0.0
data GenEntry tarPath linkTarget = Entry {

    -- | The path of the file or directory within the archive.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath :: !tarPath,

    -- | The real content of the entry. For 'NormalFile' this includes the
    -- file data. An entry usually contains a 'NormalFile' or a 'Directory'.
    forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent :: !(GenEntryContent linkTarget),

    -- | File permissions (Unix style file mode).
    forall tarPath linkTarget.
GenEntry tarPath linkTarget -> Permissions
entryPermissions :: {-# UNPACK #-} !Permissions,

    -- | The user and group to which this file belongs.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Ownership
entryOwnership :: {-# UNPACK #-} !Ownership,

    -- | The time the file was last modified.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
entryTime :: {-# UNPACK #-} !EpochTime,

    -- | The tar format the archive is using.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Format
entryFormat :: !Format
  }
  deriving (GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
/= :: GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
$c/= :: forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
== :: GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
$c== :: forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
Eq, Int -> GenEntry tarPath linkTarget -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
Int -> GenEntry tarPath linkTarget -> ShowS
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
[GenEntry tarPath linkTarget] -> ShowS
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
GenEntry tarPath linkTarget -> String
showList :: [GenEntry tarPath linkTarget] -> ShowS
$cshowList :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
[GenEntry tarPath linkTarget] -> ShowS
show :: GenEntry tarPath linkTarget -> String
$cshow :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
GenEntry tarPath linkTarget -> String
showsPrec :: Int -> GenEntry tarPath linkTarget -> ShowS
$cshowsPrec :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
Int -> GenEntry tarPath linkTarget -> ShowS
Show)

-- | Monomorphic tar archive entry, ready for serialization / deserialization.
--
type Entry = GenEntry TarPath LinkTarget

-- | Native 'FilePath' of the file or directory within the archive.
--
entryPath :: GenEntry TarPath linkTarget -> FilePath
entryPath :: forall linkTarget. GenEntry TarPath linkTarget -> String
entryPath = TarPath -> String
fromTarPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath

-- | Polymorphic content of a tar archive entry. High-level interfaces
-- commonly work with 'GenEntryContent' 'FilePath',
-- while low level uses 'GenEntryContent' 'LinkTarget'.
--
-- Portable archives should contain only 'NormalFile' and 'Directory'.
--
-- @since 0.6.0.0
data GenEntryContent linkTarget
  = NormalFile      LBS.ByteString {-# UNPACK #-} !FileSize
  | Directory
  | SymbolicLink    !linkTarget
  | HardLink        !linkTarget
  | CharacterDevice {-# UNPACK #-} !DevMajor
                    {-# UNPACK #-} !DevMinor
  | BlockDevice     {-# UNPACK #-} !DevMajor
                    {-# UNPACK #-} !DevMinor
  | NamedPipe
  | OtherEntryType  {-# UNPACK #-} !TypeCode LBS.ByteString
                    {-# UNPACK #-} !FileSize
  deriving (GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c/= :: forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
== :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c== :: forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
Eq, GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
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
forall {linkTarget}.
Ord linkTarget =>
Eq (GenEntryContent linkTarget)
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
min :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
$cmin :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
max :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
$cmax :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
>= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c>= :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
> :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c> :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
<= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c<= :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
< :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c< :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
compare :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
$ccompare :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
Ord, Int -> GenEntryContent linkTarget -> ShowS
forall linkTarget.
Show linkTarget =>
Int -> GenEntryContent linkTarget -> ShowS
forall linkTarget.
Show linkTarget =>
[GenEntryContent linkTarget] -> ShowS
forall linkTarget.
Show linkTarget =>
GenEntryContent linkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenEntryContent linkTarget] -> ShowS
$cshowList :: forall linkTarget.
Show linkTarget =>
[GenEntryContent linkTarget] -> ShowS
show :: GenEntryContent linkTarget -> String
$cshow :: forall linkTarget.
Show linkTarget =>
GenEntryContent linkTarget -> String
showsPrec :: Int -> GenEntryContent linkTarget -> ShowS
$cshowsPrec :: forall linkTarget.
Show linkTarget =>
Int -> GenEntryContent linkTarget -> ShowS
Show)

-- | Monomorphic content of a tar archive entry,
-- ready for serialization / deserialization.
type EntryContent = GenEntryContent LinkTarget

data Ownership = Ownership {
    -- | The owner user name. Should be set to @\"\"@ if unknown.
    Ownership -> String
ownerName :: String,

    -- | The owner group name. Should be set to @\"\"@ if unknown.
    Ownership -> String
groupName :: String,

    -- | Numeric owner user id. Should be set to @0@ if unknown.
    Ownership -> Int
ownerId :: {-# UNPACK #-} !Int,

    -- | Numeric owner group id. Should be set to @0@ if unknown.
    Ownership -> Int
groupId :: {-# UNPACK #-} !Int
  }
    deriving (Ownership -> Ownership -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ownership -> Ownership -> Bool
$c/= :: Ownership -> Ownership -> Bool
== :: Ownership -> Ownership -> Bool
$c== :: Ownership -> Ownership -> Bool
Eq, Eq Ownership
Ownership -> Ownership -> Bool
Ownership -> Ownership -> Ordering
Ownership -> Ownership -> Ownership
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 :: Ownership -> Ownership -> Ownership
$cmin :: Ownership -> Ownership -> Ownership
max :: Ownership -> Ownership -> Ownership
$cmax :: Ownership -> Ownership -> Ownership
>= :: Ownership -> Ownership -> Bool
$c>= :: Ownership -> Ownership -> Bool
> :: Ownership -> Ownership -> Bool
$c> :: Ownership -> Ownership -> Bool
<= :: Ownership -> Ownership -> Bool
$c<= :: Ownership -> Ownership -> Bool
< :: Ownership -> Ownership -> Bool
$c< :: Ownership -> Ownership -> Bool
compare :: Ownership -> Ownership -> Ordering
$ccompare :: Ownership -> Ownership -> Ordering
Ord, Int -> Ownership -> ShowS
[Ownership] -> ShowS
Ownership -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ownership] -> ShowS
$cshowList :: [Ownership] -> ShowS
show :: Ownership -> String
$cshow :: Ownership -> String
showsPrec :: Int -> Ownership -> ShowS
$cshowsPrec :: Int -> Ownership -> ShowS
Show)

-- | There have been a number of extensions to the tar file format over the
-- years. They all share the basic entry fields and put more meta-data in
-- different extended headers.
--
data Format =

     -- | This is the classic Unix V7 tar format. It does not support owner and
     -- group names, just numeric Ids. It also does not support device numbers.
     V7Format

     -- | The \"USTAR\" format is an extension of the classic V7 format. It was
     -- later standardised by POSIX. It has some restrictions but is the most
     -- portable format.
   | UstarFormat

     -- | The GNU tar implementation also extends the classic V7 format, though
     -- in a slightly different way from the USTAR format. This is the only format
     -- supporting long file names.
   | GnuFormat
  deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
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 :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show)

instance (NFData tarPath, NFData linkTarget) => NFData (GenEntry tarPath linkTarget) where
  rnf :: GenEntry tarPath linkTarget -> ()
rnf (Entry tarPath
p GenEntryContent linkTarget
c Permissions
_ Ownership
_ EpochTime
_ Format
_) = forall a. NFData a => a -> ()
rnf tarPath
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf GenEntryContent linkTarget
c

instance NFData linkTarget => NFData (GenEntryContent linkTarget) where
  rnf :: GenEntryContent linkTarget -> ()
rnf GenEntryContent linkTarget
x = case GenEntryContent linkTarget
x of
      NormalFile       ByteString
c EpochTime
_  -> forall a. NFData a => a -> ()
rnf ByteString
c
      SymbolicLink linkTarget
lnk      -> forall a. NFData a => a -> ()
rnf linkTarget
lnk
      HardLink linkTarget
lnk          -> forall a. NFData a => a -> ()
rnf linkTarget
lnk
      OtherEntryType Char
_ ByteString
c EpochTime
_  -> forall a. NFData a => a -> ()
rnf ByteString
c
      GenEntryContent linkTarget
_                     -> seq :: forall a b. a -> b -> b
seq GenEntryContent linkTarget
x ()

instance NFData Ownership where
  rnf :: Ownership -> ()
rnf (Ownership String
o String
g Int
_ Int
_) = forall a. NFData a => a -> ()
rnf String
o seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
g

-- | @rw-r--r--@ for normal files
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions   = Permissions
0o0644

-- | @rw-r--r--@ for normal files
--
-- @since 0.6.0.0
symbolicLinkPermission :: Permissions
symbolicLinkPermission :: Permissions
symbolicLinkPermission   = Permissions
0o0777

-- | @rwxr-xr-x@ for executable files
executableFilePermissions :: Permissions
executableFilePermissions :: Permissions
executableFilePermissions = Permissions
0o0755

-- | @rwxr-xr-x@ for directories
directoryPermissions :: Permissions
directoryPermissions :: Permissions
directoryPermissions  = Permissions
0o0755

-- | An 'Entry' with all default values except for the file name and type. It
-- uses the portable USTAR/POSIX format (see 'UstarFormat').
--
-- You can use this as a basis and override specific fields, eg:
--
-- > (emptyEntry name HardLink) { linkTarget = target }
--
simpleEntry :: tarPath -> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry :: forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
tarpath GenEntryContent linkTarget
content = Entry {
    entryTarPath :: tarPath
entryTarPath     = tarPath
tarpath,
    entryContent :: GenEntryContent linkTarget
entryContent     = GenEntryContent linkTarget
content,
    entryPermissions :: Permissions
entryPermissions = case GenEntryContent linkTarget
content of
                         GenEntryContent linkTarget
Directory -> Permissions
directoryPermissions
                         SymbolicLink linkTarget
_ -> Permissions
symbolicLinkPermission
                         GenEntryContent linkTarget
_         -> Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
UstarFormat
  }

-- | A tar 'Entry' for a file.
--
-- Entry  fields such as file permissions and ownership have default values.
--
-- You can use this as a basis and override specific fields. For example if you
-- need an executable file you could use:
--
-- > (fileEntry name content) { fileMode = executableFileMode }
--
fileEntry :: tarPath -> LBS.ByteString -> GenEntry tarPath linkTarget
fileEntry :: forall tarPath linkTarget.
tarPath -> ByteString -> GenEntry tarPath linkTarget
fileEntry tarPath
name ByteString
fileContent =
  forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name (forall linkTarget.
ByteString -> EpochTime -> GenEntryContent linkTarget
NormalFile ByteString
fileContent (ByteString -> EpochTime
LBS.length ByteString
fileContent))

-- | A tar 'Entry' for a symbolic link.
symlinkEntry :: tarPath -> linkTarget -> GenEntry tarPath linkTarget
symlinkEntry :: forall tarPath linkTarget.
tarPath -> linkTarget -> GenEntry tarPath linkTarget
symlinkEntry tarPath
name linkTarget
targetLink =
  forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name (forall linkTarget. linkTarget -> GenEntryContent linkTarget
SymbolicLink linkTarget
targetLink)

-- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)
-- to store a filepath too long to fit into 'entryTarPath'
-- as 'OtherEntryType' @\'L\'@ with the full filepath as 'entryContent'.
-- The next entry must contain the actual
-- data with truncated 'entryTarPath'.
--
-- See [What exactly is the GNU tar ././@LongLink "trick"?](https://stackoverflow.com/questions/2078778/what-exactly-is-the-gnu-tar-longlink-trick)
--
-- @since 0.6.0.0
longLinkEntry :: FilePath -> GenEntry TarPath linkTarget
longLinkEntry :: forall linkTarget. String -> GenEntry TarPath linkTarget
longLinkEntry String
tarpath = Entry {
    entryTarPath :: TarPath
entryTarPath     = ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
"././@LongLink") ByteString
BS.empty,
    entryContent :: GenEntryContent linkTarget
entryContent     = forall linkTarget.
Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
OtherEntryType Char
'L' (ByteString -> ByteString
LBS.fromStrict forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ByteString
packAscii String
tarpath) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tarpath),
    entryPermissions :: Permissions
entryPermissions = Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
GnuFormat
  }

-- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)
-- to store a link target too long to fit into 'entryTarPath'
-- as 'OtherEntryType' @\'K\'@ with the full filepath as 'entryContent'.
-- The next entry must contain the actual
-- data with truncated 'entryTarPath'.
--
-- @since 0.6.0.0
longSymLinkEntry :: FilePath -> GenEntry TarPath linkTarget
longSymLinkEntry :: forall linkTarget. String -> GenEntry TarPath linkTarget
longSymLinkEntry String
linkTarget = Entry {
    entryTarPath :: TarPath
entryTarPath     = ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
"././@LongLink") ByteString
BS.empty,
    entryContent :: GenEntryContent linkTarget
entryContent     = forall linkTarget.
Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
OtherEntryType Char
'K' (ByteString -> ByteString
LBS.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> ByteString
packAscii forall a b. (a -> b) -> a -> b
$ String
linkTarget) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
linkTarget),
    entryPermissions :: Permissions
entryPermissions = Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
GnuFormat
  }

-- | A tar 'Entry' for a directory.
--
-- Entry fields such as file permissions and ownership have default values.
--
directoryEntry :: tarPath -> GenEntry tarPath linkTarget
directoryEntry :: forall tarPath linkTarget. tarPath -> GenEntry tarPath linkTarget
directoryEntry tarPath
name = forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name forall linkTarget. GenEntryContent linkTarget
Directory

--
-- * Tar paths
--

-- | The classic tar format allowed just 100 characters for the file name. The
-- USTAR format extended this with an extra 155 characters, however it uses a
-- complex method of splitting the name between the two sections.
--
-- Instead of just putting any overflow into the extended area, it uses the
-- extended area as a prefix. The aggravating insane bit however is that the
-- prefix (if any) must only contain a directory prefix. That is the split
-- between the two areas must be on a directory separator boundary. So there is
-- no simple calculation to work out if a file name is too long. Instead we
-- have to try to find a valid split that makes the name fit in the two areas.
--
-- The rationale presumably was to make it a bit more compatible with old tar
-- programs that only understand the classic format. A classic tar would be
-- able to extract the file name and possibly some dir prefix, but not the
-- full dir prefix. So the files would end up in the wrong place, but that's
-- probably better than ending up with the wrong names too.
--
-- So it's understandable but rather annoying.
--
-- * Tar paths use Posix format (ie @\'/\'@ directory separators), irrespective
--   of the local path conventions.
--
-- * The directory separator between the prefix and name is /not/ stored.
--
data TarPath = TarPath {-# UNPACK #-} !BS.ByteString -- path name, 100 characters max.
                       {-# UNPACK #-} !BS.ByteString -- path prefix, 155 characters max.
  deriving (TarPath -> TarPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TarPath -> TarPath -> Bool
$c/= :: TarPath -> TarPath -> Bool
== :: TarPath -> TarPath -> Bool
$c== :: TarPath -> TarPath -> Bool
Eq, Eq TarPath
TarPath -> TarPath -> Bool
TarPath -> TarPath -> Ordering
TarPath -> TarPath -> TarPath
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 :: TarPath -> TarPath -> TarPath
$cmin :: TarPath -> TarPath -> TarPath
max :: TarPath -> TarPath -> TarPath
$cmax :: TarPath -> TarPath -> TarPath
>= :: TarPath -> TarPath -> Bool
$c>= :: TarPath -> TarPath -> Bool
> :: TarPath -> TarPath -> Bool
$c> :: TarPath -> TarPath -> Bool
<= :: TarPath -> TarPath -> Bool
$c<= :: TarPath -> TarPath -> Bool
< :: TarPath -> TarPath -> Bool
$c< :: TarPath -> TarPath -> Bool
compare :: TarPath -> TarPath -> Ordering
$ccompare :: TarPath -> TarPath -> Ordering
Ord)

instance NFData TarPath where
  rnf :: TarPath -> ()
rnf (TarPath ByteString
_ ByteString
_) = () -- fully strict by construction

instance Show TarPath where
  show :: TarPath -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
fromTarPath

-- | Convert a 'TarPath' to a native 'FilePath'.
--
-- The native 'FilePath' will use the native directory separator but it is not
-- otherwise checked for validity or sanity. In particular:
--
-- * The tar path may be invalid as a native path, eg the file name @\"nul\"@
--   is not valid on Windows.
--
-- * The tar path may be an absolute path or may contain @\"..\"@ components.
--   For security reasons this should not usually be allowed, but it is your
--   responsibility to check for these conditions
--   (e.g., using 'Codec.Archive.Tar.Check.checkEntrySecurity').
--
fromTarPath :: TarPath -> FilePath
fromTarPath :: TarPath -> String
fromTarPath = ByteString -> String
BS.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TarPath -> ByteString
fromTarPathInternal Char
FilePath.Native.pathSeparator

-- | Convert a 'TarPath' to a Unix\/Posix 'FilePath'.
--
-- The difference compared to 'fromTarPath' is that it always returns a Unix
-- style path irrespective of the current operating system.
--
-- This is useful to check how a 'TarPath' would be interpreted on a specific
-- operating system, eg to perform portability checks.
--
fromTarPathToPosixPath :: TarPath -> FilePath
fromTarPathToPosixPath :: TarPath -> String
fromTarPathToPosixPath = ByteString -> String
BS.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TarPath -> ByteString
fromTarPathInternal Char
FilePath.Posix.pathSeparator

-- | Convert a 'TarPath' to a Windows 'FilePath'.
--
-- The only difference compared to 'fromTarPath' is that it always returns a
-- Windows style path irrespective of the current operating system.
--
-- This is useful to check how a 'TarPath' would be interpreted on a specific
-- operating system, eg to perform portability checks.
--
fromTarPathToWindowsPath :: TarPath -> FilePath
fromTarPathToWindowsPath :: TarPath -> String
fromTarPathToWindowsPath = ByteString -> String
BS.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TarPath -> ByteString
fromTarPathInternal Char
FilePath.Windows.pathSeparator

fromTarPathInternal :: Char -> TarPath -> BS.ByteString
fromTarPathInternal :: Char -> TarPath -> ByteString
fromTarPathInternal Char
sep = TarPath -> ByteString
go
  where
    posixSep :: Char
posixSep = Char
FilePath.Posix.pathSeparator
    adjustSeps :: ByteString -> ByteString
adjustSeps = if Char
sep forall a. Eq a => a -> a -> Bool
== Char
posixSep then forall a. a -> a
id else
      (Char -> Char) -> ByteString -> ByteString
BS.Char8.map forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
posixSep then Char
sep else Char
c
    go :: TarPath -> ByteString
go (TarPath ByteString
name ByteString
prefix)
     | ByteString -> Bool
BS.null ByteString
prefix = ByteString -> ByteString
adjustSeps ByteString
name
     | ByteString -> Bool
BS.null ByteString
name = ByteString -> ByteString
adjustSeps ByteString
prefix
     | Bool
otherwise = ByteString -> ByteString
adjustSeps ByteString
prefix forall a. Semigroup a => a -> a -> a
<> Char -> ByteString -> ByteString
BS.Char8.cons Char
sep (ByteString -> ByteString
adjustSeps ByteString
name)
{-# INLINE fromTarPathInternal #-}

-- | Convert a native 'FilePath' to a 'TarPath'.
--
-- The conversion may fail if the 'FilePath' is empty or too long.
-- Use 'toTarPath'' for a structured output.
toTarPath :: Bool -- ^ Is the path for a directory? This is needed because for
                  -- directories a 'TarPath' must always use a trailing @\/@.
          -> FilePath
          -> Either String TarPath
toTarPath :: Bool -> String -> Either String TarPath
toTarPath Bool
isDir String
path = case String -> ToTarPathResult
toTarPath' String
path' of
  ToTarPathResult
FileNameEmpty      -> forall a b. a -> Either a b
Left String
"File name empty"
  FileNameOK TarPath
tarPath -> forall a b. b -> Either a b
Right TarPath
tarPath
  FileNameTooLong{}  -> forall a b. a -> Either a b
Left String
"File name too long"
  where
    path' :: String
path' = if Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
FilePath.Native.hasTrailingPathSeparator String
path)
            then String
path forall a. Semigroup a => a -> a -> a
<> [Char
FilePath.Native.pathSeparator]
            else String
path

-- | Convert a native 'FilePath' to a 'TarPath'.
-- Directory paths must always have a trailing @\/@, this is not checked.
--
-- @since 0.6.0.0
toTarPath'
  :: FilePath
  -> ToTarPathResult
toTarPath' :: String -> ToTarPathResult
toTarPath'
  = String -> ToTarPathResult
splitLongPath
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Char
nativeSep forall a. Eq a => a -> a -> Bool
== Char
posixSep then forall a. a -> a
id else ShowS
adjustSeps)
  where
    nativeSep :: Char
nativeSep = Char
FilePath.Native.pathSeparator
    posixSep :: Char
posixSep = Char
FilePath.Posix.pathSeparator
    adjustSeps :: ShowS
adjustSeps = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
nativeSep then Char
posixSep else Char
c

-- | Return type of 'toTarPath''.
--
-- @since 0.6.0.0
data ToTarPathResult
  = FileNameEmpty
  -- ^ 'FilePath' was empty, but 'TarPath' must be non-empty.
  | FileNameOK TarPath
  -- ^ All good, this is just a normal 'TarPath'.
  | FileNameTooLong TarPath
  -- ^ 'FilePath' was longer than 255 characters, 'TarPath' contains
  -- a truncated part only. An actual entry must be preceded by
  -- 'longLinkEntry'.

-- | Take a sanitised path, split on directory separators and try to pack it
-- into the 155 + 100 tar file name format.
--
-- The strategy is this: take the name-directory components in reverse order
-- and try to fit as many components into the 100 long name area as possible.
-- If all the remaining components fit in the 155 name area then we win.
splitLongPath :: FilePath -> ToTarPathResult
splitLongPath :: String -> ToTarPathResult
splitLongPath String
path = case forall a. [a] -> [a]
reverse (String -> [String]
FilePath.Posix.splitPath String
path) of
  [] -> ToTarPathResult
FileNameEmpty
  String
c : [String]
cs -> case Int -> NonEmpty String -> Maybe (String, [String])
packName Int
nameMax (String
c forall a. a -> [a] -> NonEmpty a
:| [String]
cs) of
    Maybe (String, [String])
Nothing                 -> TarPath -> ToTarPathResult
FileNameTooLong forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> TarPath
TarPath (HasCallStack => String -> ByteString
packAscii forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
100 String
path) ByteString
BS.empty
    Just (String
name, [])         -> TarPath -> ToTarPathResult
FileNameOK forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (HasCallStack => String -> ByteString
packAscii String
name) ByteString
BS.empty
    Just (String
name, String
first:[String]
rest) -> case Int -> NonEmpty String -> Maybe (String, [String])
packName Int
prefixMax NonEmpty String
remainder of
      Maybe (String, [String])
Nothing               -> TarPath -> ToTarPathResult
FileNameTooLong forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> TarPath
TarPath (HasCallStack => String -> ByteString
packAscii forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
100 String
path) ByteString
BS.empty
      Just (String
_     , String
_:[String]
_)    -> TarPath -> ToTarPathResult
FileNameTooLong forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> TarPath
TarPath (HasCallStack => String -> ByteString
packAscii forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
100 String
path) ByteString
BS.empty
      Just (String
prefix, [])     -> TarPath -> ToTarPathResult
FileNameOK forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (HasCallStack => String -> ByteString
packAscii String
name) (HasCallStack => String -> ByteString
packAscii String
prefix)
      where
        -- drop the '/' between the name and prefix:
        remainder :: NonEmpty String
remainder = forall a. [a] -> [a]
init String
first forall a. a -> [a] -> NonEmpty a
:| [String]
rest

  where
    nameMax, prefixMax :: Int
    nameMax :: Int
nameMax   = Int
100
    prefixMax :: Int
prefixMax = Int
155

    packName :: Int -> NonEmpty FilePath -> Maybe (FilePath, [FilePath])
    packName :: Int -> NonEmpty String -> Maybe (String, [String])
packName Int
maxLen (String
c :| [String]
cs)
      | Int
n forall a. Ord a => a -> a -> Bool
> Int
maxLen         = forall a. Maybe a
Nothing
      | Bool
otherwise          = forall a. a -> Maybe a
Just (Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String
c] [String]
cs)
      where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c

    packName' :: Int -> Int -> [FilePath] -> [FilePath] -> (FilePath, [FilePath])
    packName' :: Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String]
ok (String
c:[String]
cs)
      | Int
n' forall a. Ord a => a -> a -> Bool
<= Int
maxLen             = Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n' (String
cforall a. a -> [a] -> [a]
:[String]
ok) [String]
cs
                                     where n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
    packName' Int
_      Int
_ [String]
ok    [String]
cs  = ([String] -> String
FilePath.Posix.joinPath [String]
ok, [String]
cs)

-- | The tar format allows just 100 ASCII characters for the 'SymbolicLink' and
-- 'HardLink' entry types.
--
newtype LinkTarget = LinkTarget BS.ByteString
  deriving (LinkTarget -> LinkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq, Eq LinkTarget
LinkTarget -> LinkTarget -> Bool
LinkTarget -> LinkTarget -> Ordering
LinkTarget -> LinkTarget -> LinkTarget
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 :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
>= :: LinkTarget -> LinkTarget -> Bool
$c>= :: LinkTarget -> LinkTarget -> Bool
> :: LinkTarget -> LinkTarget -> Bool
$c> :: LinkTarget -> LinkTarget -> Bool
<= :: LinkTarget -> LinkTarget -> Bool
$c<= :: LinkTarget -> LinkTarget -> Bool
< :: LinkTarget -> LinkTarget -> Bool
$c< :: LinkTarget -> LinkTarget -> Bool
compare :: LinkTarget -> LinkTarget -> Ordering
$ccompare :: LinkTarget -> LinkTarget -> Ordering
Ord, Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show)

instance NFData LinkTarget where
    rnf :: LinkTarget -> ()
rnf (LinkTarget ByteString
bs) = forall a. NFData a => a -> ()
rnf ByteString
bs

-- | Convert a native 'FilePath' to a tar 'LinkTarget'.
-- string is longer than 100 characters or if it contains non-portable
-- characters.
toLinkTarget :: FilePath -> Maybe LinkTarget
toLinkTarget :: String -> Maybe LinkTarget
toLinkTarget String
path
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path forall a. Ord a => a -> a -> Bool
<= Int
100 = do
    String
target <- String -> Maybe String
toLinkTarget' String
path
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString -> LinkTarget
LinkTarget (HasCallStack => String -> ByteString
packAscii String
target)
  | Bool
otherwise = forall a. Maybe a
Nothing

data LinkTargetException = IsAbsolute FilePath
                         | TooLong FilePath
  deriving (Int -> LinkTargetException -> ShowS
[LinkTargetException] -> ShowS
LinkTargetException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTargetException] -> ShowS
$cshowList :: [LinkTargetException] -> ShowS
show :: LinkTargetException -> String
$cshow :: LinkTargetException -> String
showsPrec :: Int -> LinkTargetException -> ShowS
$cshowsPrec :: Int -> LinkTargetException -> ShowS
Show,Typeable)

instance Exception LinkTargetException where
  displayException :: LinkTargetException -> String
displayException (IsAbsolute String
fp) = String
"Link target \"" forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
"\" is unexpectedly absolute"
  displayException (TooLong String
_) = String
"The link target is too long"

-- | Convert a native 'FilePath' to a unix filepath suitable for
-- using as 'LinkTarget'. Does not error if longer than 100 characters.
toLinkTarget' :: FilePath -> Maybe FilePath
toLinkTarget' :: String -> Maybe String
toLinkTarget' String
path
  | String -> Bool
FilePath.Native.isAbsolute String
path = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$ [String] -> String
FilePath.Posix.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Native.splitDirectories String
path
  where
    adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Native.hasTrailingPathSeparator String
path
                    = ShowS
FilePath.Posix.addTrailingPathSeparator
                    | Bool
otherwise = forall a. a -> a
id

-- | Convert a tar 'LinkTarget' to a native 'FilePath'.
fromLinkTarget :: LinkTarget -> FilePath
fromLinkTarget :: LinkTarget -> String
fromLinkTarget (LinkTarget ByteString
pathbs) = ShowS
fromFilePathToNative forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.Char8.unpack ByteString
pathbs

-- | Convert a tar 'LinkTarget' to a Unix\/POSIX 'FilePath' (@\'/\'@ path separators).
fromLinkTargetToPosixPath :: LinkTarget -> FilePath
fromLinkTargetToPosixPath :: LinkTarget -> String
fromLinkTargetToPosixPath (LinkTarget ByteString
pathbs) = ByteString -> String
BS.Char8.unpack ByteString
pathbs

-- | Convert a tar 'LinkTarget' to a Windows 'FilePath' (@\'\\\\\'@ path separators).
fromLinkTargetToWindowsPath :: LinkTarget -> FilePath
fromLinkTargetToWindowsPath :: LinkTarget -> String
fromLinkTargetToWindowsPath (LinkTarget ByteString
pathbs) =
  ShowS
fromFilePathToWindowsPath forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.Char8.unpack ByteString
pathbs

-- | Convert a unix FilePath to a native 'FilePath'.
fromFilePathToNative :: FilePath -> FilePath
fromFilePathToNative :: ShowS
fromFilePathToNative =
  Char -> Char -> ShowS
fromFilePathInternal Char
FilePath.Posix.pathSeparator Char
FilePath.Native.pathSeparator

-- | Convert a unix FilePath to a Windows 'FilePath'.
fromFilePathToWindowsPath :: FilePath -> FilePath
fromFilePathToWindowsPath :: ShowS
fromFilePathToWindowsPath =
  Char -> Char -> ShowS
fromFilePathInternal Char
FilePath.Posix.pathSeparator Char
FilePath.Windows.pathSeparator

fromFilePathInternal :: Char -> Char -> FilePath -> FilePath
fromFilePathInternal :: Char -> Char -> ShowS
fromFilePathInternal Char
fromSep Char
toSep = ShowS
adjustSeps
  where
    adjustSeps :: ShowS
adjustSeps = if Char
fromSep forall a. Eq a => a -> a -> Bool
== Char
toSep then forall a. a -> a
id else
      forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
fromSep then Char
toSep else Char
c
{-# INLINE fromFilePathInternal #-}

--
-- * Entries type
--

-- | Polymorphic sequence of archive entries.
-- High-level interfaces
-- commonly work with 'GenEntries' 'FilePath' 'FilePath',
-- while low level uses 'GenEntries' 'TarPath' 'LinkTarget'.
--
-- The point of this type as opposed to just using a list is that it makes the
-- failure case explicit. We need this because the sequence of entries we get
-- from reading a tarball can include errors.
--
-- Converting from a list can be done with just @foldr Next Done@. Converting
-- back into a list can be done with 'foldEntries' however in that case you
-- must be prepared to handle the 'Fail' case inherent in the 'Entries' type.
--
-- The 'Monoid' instance lets you concatenate archives or append entries to an
-- archive.
--
-- @since 0.6.0.0
data GenEntries tarPath linkTarget e
  = Next (GenEntry tarPath linkTarget) (GenEntries tarPath linkTarget e)
  | Done
  | Fail e
  deriving
    ( GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
/= :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
$c/= :: forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
== :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
$c== :: forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
Eq
    , Int -> GenEntries tarPath linkTarget e -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
Int -> GenEntries tarPath linkTarget e -> ShowS
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
[GenEntries tarPath linkTarget e] -> ShowS
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
GenEntries tarPath linkTarget e -> String
showList :: [GenEntries tarPath linkTarget e] -> ShowS
$cshowList :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
[GenEntries tarPath linkTarget e] -> ShowS
show :: GenEntries tarPath linkTarget e -> String
$cshow :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
GenEntries tarPath linkTarget e -> String
showsPrec :: Int -> GenEntries tarPath linkTarget e -> ShowS
$cshowsPrec :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
Int -> GenEntries tarPath linkTarget e -> ShowS
Show
    , forall a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
forall a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
forall tarPath linkTarget a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
forall tarPath linkTarget a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
$c<$ :: forall tarPath linkTarget a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
fmap :: forall a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
$cfmap :: forall tarPath linkTarget a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
Functor
    , forall a. GenEntries tarPath linkTarget a -> Bool
forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall tarPath linkTarget a.
Eq a =>
a -> GenEntries tarPath linkTarget a -> Bool
forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget m.
Monoid m =>
GenEntries tarPath linkTarget m -> m
forall tarPath linkTarget a.
GenEntries tarPath linkTarget a -> Bool
forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> Int
forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> [a]
forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => GenEntries tarPath linkTarget a -> a
$cproduct :: forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
sum :: forall a. Num a => GenEntries tarPath linkTarget a -> a
$csum :: forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
minimum :: forall a. Ord a => GenEntries tarPath linkTarget a -> a
$cminimum :: forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
maximum :: forall a. Ord a => GenEntries tarPath linkTarget a -> a
$cmaximum :: forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
elem :: forall a. Eq a => a -> GenEntries tarPath linkTarget a -> Bool
$celem :: forall tarPath linkTarget a.
Eq a =>
a -> GenEntries tarPath linkTarget a -> Bool
length :: forall a. GenEntries tarPath linkTarget a -> Int
$clength :: forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> Int
null :: forall a. GenEntries tarPath linkTarget a -> Bool
$cnull :: forall tarPath linkTarget a.
GenEntries tarPath linkTarget a -> Bool
toList :: forall a. GenEntries tarPath linkTarget a -> [a]
$ctoList :: forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> [a]
foldl1 :: forall a. (a -> a -> a) -> GenEntries tarPath linkTarget a -> a
$cfoldl1 :: forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
foldr1 :: forall a. (a -> a -> a) -> GenEntries tarPath linkTarget a -> a
$cfoldr1 :: forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
foldl' :: forall b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldl' :: forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldl :: forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldr' :: forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldr :: forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
$cfoldMap' :: forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
$cfoldMap :: forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
fold :: forall m. Monoid m => GenEntries tarPath linkTarget m -> m
$cfold :: forall tarPath linkTarget m.
Monoid m =>
GenEntries tarPath linkTarget m -> m
Foldable    -- ^ @since 0.6.0.0
    , forall tarPath linkTarget. Functor (GenEntries tarPath linkTarget)
forall tarPath linkTarget. Foldable (GenEntries tarPath linkTarget)
forall tarPath linkTarget (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
forall tarPath linkTarget (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
forall tarPath linkTarget (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
forall tarPath linkTarget (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
$csequence :: forall tarPath linkTarget (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
$cmapM :: forall tarPath linkTarget (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
$csequenceA :: forall tarPath linkTarget (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
$ctraverse :: forall tarPath linkTarget (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
Traversable -- ^ @since 0.6.0.0
    )

infixr 5 `Next`

-- | Monomorphic sequence of archive entries,
-- ready for serialization / deserialization.
type Entries e = GenEntries TarPath LinkTarget e

-- | This is like the standard 'Data.List.unfoldr' function on lists, but for 'Entries'.
-- It includes failure as an extra possibility that the stepper function may
-- return.
--
-- It can be used to generate 'Entries' from some other type. For example it is
-- used internally to lazily unfold entries from a 'LBS.ByteString'.
--
unfoldEntries
  :: (a -> Either e (Maybe (GenEntry tarPath linkTarget, a)))
  -> a
  -> GenEntries tarPath linkTarget e
unfoldEntries :: forall a e tarPath linkTarget.
(a -> Either e (Maybe (GenEntry tarPath linkTarget, a)))
-> a -> GenEntries tarPath linkTarget e
unfoldEntries a -> Either e (Maybe (GenEntry tarPath linkTarget, a))
f = a -> GenEntries tarPath linkTarget e
unfold
  where
    unfold :: a -> GenEntries tarPath linkTarget e
unfold a
x = case a -> Either e (Maybe (GenEntry tarPath linkTarget, a))
f a
x of
      Left e
err             -> forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail e
err
      Right Maybe (GenEntry tarPath linkTarget, a)
Nothing        -> forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done
      Right (Just (GenEntry tarPath linkTarget
e, a
x')) -> forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next GenEntry tarPath linkTarget
e (a -> GenEntries tarPath linkTarget e
unfold a
x')

-- | This is like the standard 'foldr' function on lists, but for 'Entries'.
-- Compared to 'foldr' it takes an extra function to account for the
-- possibility of failure.
--
-- This is used to consume a sequence of entries. For example it could be used
-- to scan a tarball for problems or to collect an index of the contents.
--
foldEntries
  :: (GenEntry tarPath linkTarget -> a -> a)
  -> a
  -> (e -> a)
  -> GenEntries tarPath linkTarget e -> a
foldEntries :: forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries GenEntry tarPath linkTarget -> a -> a
next a
done e -> a
fail' = GenEntries tarPath linkTarget e -> a
fold
  where
    fold :: GenEntries tarPath linkTarget e -> a
fold (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget e
es) = GenEntry tarPath linkTarget -> a -> a
next GenEntry tarPath linkTarget
e (GenEntries tarPath linkTarget e -> a
fold GenEntries tarPath linkTarget e
es)
    fold GenEntries tarPath linkTarget e
Done        = a
done
    fold (Fail e
err)  = e -> a
fail' e
err

-- | A 'foldl'-like function on Entries. It either returns the final
-- accumulator result, or the failure along with the intermediate accumulator
-- value.
--
foldlEntries
  :: (a -> GenEntry tarPath linkTarget -> a)
  -> a
  -> GenEntries tarPath linkTarget e
  -> Either (e, a) a
foldlEntries :: forall a tarPath linkTarget e.
(a -> GenEntry tarPath linkTarget -> a)
-> a -> GenEntries tarPath linkTarget e -> Either (e, a) a
foldlEntries a -> GenEntry tarPath linkTarget -> a
f = forall {a}. a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go
  where
    go :: a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go !a
acc (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget a
es) = a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go (a -> GenEntry tarPath linkTarget -> a
f a
acc GenEntry tarPath linkTarget
e) GenEntries tarPath linkTarget a
es
    go !a
acc  GenEntries tarPath linkTarget a
Done       = forall a b. b -> Either a b
Right a
acc
    go !a
acc (Fail a
err)  = forall a b. a -> Either a b
Left (a
err, a
acc)

-- | This is like the standard 'map' function on lists, but for 'Entries'. It
-- includes failure as a extra possible outcome of the mapping function.
--
-- If your mapping function cannot fail it may be more convenient to use
-- 'mapEntriesNoFail'
mapEntries
  :: (GenEntry tarPath linkTarget -> Either e' (GenEntry tarPath linkTarget))
  -- ^ Function to apply to each entry
  -> GenEntries tarPath linkTarget e
  -- ^ Input sequence
  -> GenEntries tarPath linkTarget (Either e e')
mapEntries :: forall tarPath linkTarget e' e.
(GenEntry tarPath linkTarget
 -> Either e' (GenEntry tarPath linkTarget))
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget (Either e e')
mapEntries GenEntry tarPath linkTarget
-> Either e' (GenEntry tarPath linkTarget)
f =
  forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries (\GenEntry tarPath linkTarget
entry GenEntries tarPath linkTarget (Either e e')
rest -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) (forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
`Next` GenEntries tarPath linkTarget (Either e e')
rest) (GenEntry tarPath linkTarget
-> Either e' (GenEntry tarPath linkTarget)
f GenEntry tarPath linkTarget
entry)) forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done (forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | Like 'mapEntries' but the mapping function itself cannot fail.
--
mapEntriesNoFail
  :: (GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget)
  -> GenEntries tarPath linkTarget e
  -> GenEntries tarPath linkTarget e
mapEntriesNoFail :: forall tarPath linkTarget e.
(GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget)
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
mapEntriesNoFail GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget
f =
  forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries (forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget
f) forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail

-- | @since 0.5.1.0
instance Sem.Semigroup (GenEntries tarPath linkTarget e) where
  GenEntries tarPath linkTarget e
a <> :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
<> GenEntries tarPath linkTarget e
b = forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next GenEntries tarPath linkTarget e
b forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail GenEntries tarPath linkTarget e
a

instance Monoid (GenEntries tarPath linkTarget e) where
  mempty :: GenEntries tarPath linkTarget e
mempty  = forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done
  mappend :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

instance (NFData tarPath, NFData linkTarget, NFData e) => NFData (GenEntries tarPath linkTarget e) where
  rnf :: GenEntries tarPath linkTarget e -> ()
rnf (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget e
es) = forall a. NFData a => a -> ()
rnf GenEntry tarPath linkTarget
e seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf GenEntries tarPath linkTarget e
es
  rnf  GenEntries tarPath linkTarget e
Done       = ()
  rnf (Fail e
e)    = forall a. NFData a => a -> ()
rnf e
e