{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_HADDOCK hide #-}

module Codec.Archive.Tar.LongNames
  ( encodeLongNames
  , decodeLongNames
  , DecodeLongNamesError(..)
  ) where

import Codec.Archive.Tar.PackAscii
import Codec.Archive.Tar.Types
import Control.Exception
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import "os-string" System.OsString.Posix (PosixString, PosixChar)
import qualified "os-string" System.OsString.Posix as PS

-- | Errors raised by 'decodeLongNames'.
--
-- @since 0.6.0.0
data DecodeLongNamesError
  = TwoTypeKEntries
  -- ^ Two adjacent 'OtherEntryType' @\'K\'@ nodes.
  | TwoTypeLEntries
  -- ^ Two adjacent 'OtherEntryType' @\'L\'@ nodes.
  | NoLinkEntryAfterTypeKEntry
  -- ^ 'OtherEntryType' @\'K\'@ node is not followed by a 'SymbolicLink' / 'HardLink'.
  deriving (DecodeLongNamesError -> DecodeLongNamesError -> Bool
(DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> (DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> Eq DecodeLongNamesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
== :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
$c/= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
/= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
Eq, Eq DecodeLongNamesError
Eq DecodeLongNamesError =>
(DecodeLongNamesError -> DecodeLongNamesError -> Ordering)
-> (DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> (DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> (DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> (DecodeLongNamesError -> DecodeLongNamesError -> Bool)
-> (DecodeLongNamesError
    -> DecodeLongNamesError -> DecodeLongNamesError)
-> (DecodeLongNamesError
    -> DecodeLongNamesError -> DecodeLongNamesError)
-> Ord DecodeLongNamesError
DecodeLongNamesError -> DecodeLongNamesError -> Bool
DecodeLongNamesError -> DecodeLongNamesError -> Ordering
DecodeLongNamesError
-> DecodeLongNamesError -> DecodeLongNamesError
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 :: DecodeLongNamesError -> DecodeLongNamesError -> Ordering
compare :: DecodeLongNamesError -> DecodeLongNamesError -> Ordering
$c< :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
< :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
$c<= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
<= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
$c> :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
> :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
$c>= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
>= :: DecodeLongNamesError -> DecodeLongNamesError -> Bool
$cmax :: DecodeLongNamesError
-> DecodeLongNamesError -> DecodeLongNamesError
max :: DecodeLongNamesError
-> DecodeLongNamesError -> DecodeLongNamesError
$cmin :: DecodeLongNamesError
-> DecodeLongNamesError -> DecodeLongNamesError
min :: DecodeLongNamesError
-> DecodeLongNamesError -> DecodeLongNamesError
Ord, Int -> DecodeLongNamesError -> ShowS
[DecodeLongNamesError] -> ShowS
DecodeLongNamesError -> String
(Int -> DecodeLongNamesError -> ShowS)
-> (DecodeLongNamesError -> String)
-> ([DecodeLongNamesError] -> ShowS)
-> Show DecodeLongNamesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeLongNamesError -> ShowS
showsPrec :: Int -> DecodeLongNamesError -> ShowS
$cshow :: DecodeLongNamesError -> String
show :: DecodeLongNamesError -> String
$cshowList :: [DecodeLongNamesError] -> ShowS
showList :: [DecodeLongNamesError] -> ShowS
Show)

instance Exception DecodeLongNamesError

-- | Translate high-level entries with POSIX 'FilePath's for files and symlinks
-- into entries suitable for serialization by emitting additional
-- 'OtherEntryType' @\'K\'@ and 'OtherEntryType' @\'L\'@ nodes.
--
-- Input 'FilePath's must be POSIX file names, not native ones.
--
-- @since 0.6.0.0
encodeLongNames
  :: GenEntry content FilePath FilePath
  -> [GenEntry content TarPath LinkTarget]
encodeLongNames :: forall content.
GenEntry content String String
-> [GenEntry content TarPath LinkTarget]
encodeLongNames GenEntry content String String
e = ([GenEntry content TarPath LinkTarget]
 -> [GenEntry content TarPath LinkTarget])
-> (GenEntry content TarPath LinkTarget
    -> [GenEntry content TarPath LinkTarget]
    -> [GenEntry content TarPath LinkTarget])
-> Maybe (GenEntry content TarPath LinkTarget)
-> [GenEntry content TarPath LinkTarget]
-> [GenEntry content TarPath LinkTarget]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [GenEntry content TarPath LinkTarget]
-> [GenEntry content TarPath LinkTarget]
forall a. a -> a
id (:) Maybe (GenEntry content TarPath LinkTarget)
mEntry ([GenEntry content TarPath LinkTarget]
 -> [GenEntry content TarPath LinkTarget])
-> [GenEntry content TarPath LinkTarget]
-> [GenEntry content TarPath LinkTarget]
forall a b. (a -> b) -> a -> b
$ ([GenEntry content TarPath LinkTarget]
 -> [GenEntry content TarPath LinkTarget])
-> (GenEntry content TarPath LinkTarget
    -> [GenEntry content TarPath LinkTarget]
    -> [GenEntry content TarPath LinkTarget])
-> Maybe (GenEntry content TarPath LinkTarget)
-> [GenEntry content TarPath LinkTarget]
-> [GenEntry content TarPath LinkTarget]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [GenEntry content TarPath LinkTarget]
-> [GenEntry content TarPath LinkTarget]
forall a. a -> a
id (:) Maybe (GenEntry content TarPath LinkTarget)
forall {whatever}. Maybe (GenEntry content TarPath whatever)
mEntry' [GenEntry content TarPath LinkTarget
e'']
  where
    (Maybe (GenEntry content TarPath LinkTarget)
mEntry, GenEntry content String LinkTarget
e') = GenEntry content String String
-> (Maybe (GenEntry content TarPath LinkTarget),
    GenEntry content String LinkTarget)
forall content tarPath.
GenEntry content tarPath String
-> (Maybe (GenEntry content TarPath LinkTarget),
    GenEntry content tarPath LinkTarget)
encodeLinkTarget GenEntry content String String
e
    (Maybe (GenEntry content TarPath whatever)
mEntry', GenEntry content TarPath LinkTarget
e'') = GenEntry content String LinkTarget
-> (Maybe (GenEntry content TarPath whatever),
    GenEntry content TarPath LinkTarget)
forall content linkTarget whatever.
GenEntry content String linkTarget
-> (Maybe (GenEntry content TarPath whatever),
    GenEntry content TarPath linkTarget)
encodeTarPath GenEntry content String LinkTarget
e'

encodeTarPath
  :: GenEntry content FilePath linkTarget
  -> (Maybe (GenEntry content TarPath whatever), GenEntry content TarPath linkTarget)
  -- ^ (LongLink entry, actual entry)
encodeTarPath :: forall content linkTarget whatever.
GenEntry content String linkTarget
-> (Maybe (GenEntry content TarPath whatever),
    GenEntry content TarPath linkTarget)
encodeTarPath GenEntry content String linkTarget
e = case String -> ToTarPathResult
toTarPath' (GenEntry content String linkTarget -> String
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> tarPath
entryTarPath GenEntry content String linkTarget
e) of
  ToTarPathResult
FileNameEmpty -> (Maybe (GenEntry content TarPath whatever)
forall a. Maybe a
Nothing, GenEntry content String linkTarget
e { entryTarPath = TarPath mempty mempty })
  FileNameOK TarPath
tarPath -> (Maybe (GenEntry content TarPath whatever)
forall a. Maybe a
Nothing, GenEntry content String linkTarget
e { entryTarPath = tarPath })
  FileNameTooLong TarPath
tarPath -> (GenEntry content TarPath whatever
-> Maybe (GenEntry content TarPath whatever)
forall a. a -> Maybe a
Just (GenEntry content TarPath whatever
 -> Maybe (GenEntry content TarPath whatever))
-> GenEntry content TarPath whatever
-> Maybe (GenEntry content TarPath whatever)
forall a b. (a -> b) -> a -> b
$ String -> GenEntry content TarPath whatever
forall content linkTarget.
String -> GenEntry content TarPath linkTarget
longLinkEntry (String -> GenEntry content TarPath whatever)
-> String -> GenEntry content TarPath whatever
forall a b. (a -> b) -> a -> b
$ GenEntry content String linkTarget -> String
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget -> tarPath
entryTarPath GenEntry content String linkTarget
e, GenEntry content String linkTarget
e { entryTarPath = tarPath })

encodeLinkTarget
  :: GenEntry content tarPath FilePath
  -> (Maybe (GenEntry content TarPath LinkTarget), GenEntry content tarPath LinkTarget)
  -- ^ (LongLink symlink entry, actual entry)
encodeLinkTarget :: forall content tarPath.
GenEntry content tarPath String
-> (Maybe (GenEntry content TarPath LinkTarget),
    GenEntry content tarPath LinkTarget)
encodeLinkTarget GenEntry content tarPath String
e = case GenEntry content tarPath String -> GenEntryContent content String
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry content tarPath String
e of
  NormalFile content
x FileSize
y -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = NormalFile x y })
  GenEntryContent content String
Directory -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = Directory })
  SymbolicLink String
lnk -> let (Maybe (GenEntry content TarPath LinkTarget)
mEntry, LinkTarget
lnk') = String -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
forall content.
String -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
encodeLinkPath String
lnk in
    (Maybe (GenEntry content TarPath LinkTarget)
forall {content}. Maybe (GenEntry content TarPath LinkTarget)
mEntry, GenEntry content tarPath String
e { entryContent = SymbolicLink lnk' })
  HardLink String
lnk -> let (Maybe (GenEntry content TarPath LinkTarget)
mEntry, LinkTarget
lnk') = String -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
forall content.
String -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
encodeLinkPath String
lnk in
    (Maybe (GenEntry content TarPath LinkTarget)
forall {content}. Maybe (GenEntry content TarPath LinkTarget)
mEntry, GenEntry content tarPath String
e { entryContent = HardLink lnk' })
  CharacterDevice Int
x Int
y -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = CharacterDevice x y })
  BlockDevice Int
x Int
y -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = BlockDevice x y })
  GenEntryContent content String
NamedPipe -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = NamedPipe })
  OtherEntryType Char
x ByteString
y FileSize
z -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, GenEntry content tarPath String
e { entryContent = OtherEntryType x y z })

encodeLinkPath
  :: FilePath
  -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
encodeLinkPath :: forall content.
String -> (Maybe (GenEntry content TarPath LinkTarget), LinkTarget)
encodeLinkPath String
lnk = case String -> ToTarPathResult
toTarPath' String
lnk of
  ToTarPathResult
FileNameEmpty -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, PosixString -> LinkTarget
LinkTarget PosixString
forall a. Monoid a => a
mempty)
  FileNameOK (TarPath PosixString
name PosixString
prefix)
    | PosixString -> Bool
PS.null PosixString
prefix -> (Maybe (GenEntry content TarPath LinkTarget)
forall a. Maybe a
Nothing, PosixString -> LinkTarget
LinkTarget PosixString
name)
    | Bool
otherwise -> (GenEntry content TarPath LinkTarget
-> Maybe (GenEntry content TarPath LinkTarget)
forall a. a -> Maybe a
Just (GenEntry content TarPath LinkTarget
 -> Maybe (GenEntry content TarPath LinkTarget))
-> GenEntry content TarPath LinkTarget
-> Maybe (GenEntry content TarPath LinkTarget)
forall a b. (a -> b) -> a -> b
$ String -> GenEntry content TarPath LinkTarget
forall content linkTarget.
String -> GenEntry content TarPath linkTarget
longSymLinkEntry String
lnk, PosixString -> LinkTarget
LinkTarget PosixString
name)
  FileNameTooLong (TarPath PosixString
name PosixString
_) ->
    (GenEntry content TarPath LinkTarget
-> Maybe (GenEntry content TarPath LinkTarget)
forall a. a -> Maybe a
Just (GenEntry content TarPath LinkTarget
 -> Maybe (GenEntry content TarPath LinkTarget))
-> GenEntry content TarPath LinkTarget
-> Maybe (GenEntry content TarPath LinkTarget)
forall a b. (a -> b) -> a -> b
$ String -> GenEntry content TarPath LinkTarget
forall content linkTarget.
String -> GenEntry content TarPath linkTarget
longSymLinkEntry String
lnk, PosixString -> LinkTarget
LinkTarget PosixString
name)

-- | Translate low-level entries (usually freshly deserialized) into
-- high-level entries with POSIX 'FilePath's for files and symlinks
-- by parsing and eliminating
-- 'OtherEntryType' @\'K\'@ and 'OtherEntryType' @\'L\'@ nodes.
--
-- Resolved 'FilePath's are still POSIX file names, not native ones.
--
-- @since 0.6.0.0
decodeLongNames
  :: Entries e
  -> GenEntries BL.ByteString FilePath FilePath (Either e DecodeLongNamesError)
decodeLongNames :: forall e.
Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
decodeLongNames = Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  where
    go :: Maybe FilePath -> Maybe FilePath -> Entries e -> GenEntries BL.ByteString FilePath FilePath (Either e DecodeLongNamesError)
    go :: forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
_ Maybe String
_ (Fail e
err) = Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (e -> Either e DecodeLongNamesError
forall a b. a -> Either a b
Left e
err)
    go Maybe String
_ Maybe String
_ GenEntries ByteString TarPath LinkTarget e
Done = GenEntries ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntries content tarPath linkTarget e
Done

    go Maybe String
Nothing Maybe String
Nothing (Next GenEntry ByteString TarPath LinkTarget
e GenEntries ByteString TarPath LinkTarget e
rest) = case GenEntry ByteString TarPath LinkTarget
-> GenEntryContent ByteString LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry ByteString TarPath LinkTarget
e of
      OtherEntryType Char
'K' ByteString
fn FileSize
_ ->
        Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
otherEntryPayloadToFilePath ByteString
fn)) Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest
      OtherEntryType Char
'L' ByteString
fn FileSize
_ ->
        Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
otherEntryPayloadToFilePath ByteString
fn)) GenEntries ByteString TarPath LinkTarget e
rest
      GenEntryContent ByteString LinkTarget
_ ->
        GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next (GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)

    go Maybe String
Nothing (Just String
path) (Next GenEntry ByteString TarPath LinkTarget
e GenEntries ByteString TarPath LinkTarget e
rest) = case GenEntry ByteString TarPath LinkTarget
-> GenEntryContent ByteString LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry ByteString TarPath LinkTarget
e of
      OtherEntryType Char
'K' ByteString
fn FileSize
_ ->
        Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
otherEntryPayloadToFilePath ByteString
fn)) (String -> Maybe String
forall a. a -> Maybe a
Just String
path) GenEntries ByteString TarPath LinkTarget e
rest
      OtherEntryType Char
'L' ByteString
_ FileSize
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
TwoTypeLEntries
      GenEntryContent ByteString LinkTarget
_ -> GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next ((GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) { entryTarPath = path }) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)

    go (Just String
link) Maybe String
Nothing (Next GenEntry ByteString TarPath LinkTarget
e GenEntries ByteString TarPath LinkTarget e
rest) = case GenEntry ByteString TarPath LinkTarget
-> GenEntryContent ByteString LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry ByteString TarPath LinkTarget
e of
      OtherEntryType Char
'K' ByteString
_ FileSize
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
TwoTypeKEntries
      OtherEntryType Char
'L' ByteString
fn FileSize
_ ->
        Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go (String -> Maybe String
forall a. a -> Maybe a
Just String
link) (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
otherEntryPayloadToFilePath ByteString
fn)) GenEntries ByteString TarPath LinkTarget e
rest
      SymbolicLink{} ->
        GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next ((GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) { entryContent = SymbolicLink link }) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)
      HardLink{} ->
        GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next ((GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) { entryContent = HardLink link }) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)
      GenEntryContent ByteString LinkTarget
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
NoLinkEntryAfterTypeKEntry

    go (Just String
link) (Just String
path) (Next GenEntry ByteString TarPath LinkTarget
e GenEntries ByteString TarPath LinkTarget e
rest) = case GenEntry ByteString TarPath LinkTarget
-> GenEntryContent ByteString LinkTarget
forall content tarPath linkTarget.
GenEntry content tarPath linkTarget
-> GenEntryContent content linkTarget
entryContent GenEntry ByteString TarPath LinkTarget
e of
      OtherEntryType Char
'K' ByteString
_ FileSize
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
TwoTypeKEntries
      OtherEntryType Char
'L' ByteString
_ FileSize
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
TwoTypeLEntries
      SymbolicLink{} ->
        GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next ((GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) { entryTarPath = path, entryContent = SymbolicLink link }) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)
      HardLink{} ->
        GenEntry ByteString String String
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Next ((GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e) { entryTarPath = path, entryContent = HardLink link }) (Maybe String
-> Maybe String
-> GenEntries ByteString TarPath LinkTarget e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall e.
Maybe String
-> Maybe String
-> Entries e
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
go Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing GenEntries ByteString TarPath LinkTarget e
rest)
      GenEntryContent ByteString LinkTarget
_ ->
        Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Fail (Either e DecodeLongNamesError
 -> GenEntries
      ByteString String String (Either e DecodeLongNamesError))
-> Either e DecodeLongNamesError
-> GenEntries
     ByteString String String (Either e DecodeLongNamesError)
forall a b. (a -> b) -> a -> b
$ DecodeLongNamesError -> Either e DecodeLongNamesError
forall a b. b -> Either a b
Right DecodeLongNamesError
NoLinkEntryAfterTypeKEntry

otherEntryPayloadToFilePath :: BL.ByteString -> FilePath
otherEntryPayloadToFilePath :: ByteString -> String
otherEntryPayloadToFilePath =
  PosixString -> String
fromPosixString (PosixString -> String)
-> (ByteString -> PosixString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PosixString
byteToPosixString (ByteString -> PosixString)
-> (ByteString -> ByteString) -> ByteString -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

castEntry :: Entry -> GenEntry BL.ByteString FilePath FilePath
castEntry :: GenEntry ByteString TarPath LinkTarget
-> GenEntry ByteString String String
castEntry GenEntry ByteString TarPath LinkTarget
e = GenEntry ByteString TarPath LinkTarget
e
  { entryTarPath = fromTarPathToPosixPath (entryTarPath e)
  , entryContent = castEntryContent (entryContent e)
  }

castEntryContent :: EntryContent -> GenEntryContent BL.ByteString FilePath
castEntryContent :: GenEntryContent ByteString LinkTarget
-> GenEntryContent ByteString String
castEntryContent = \case
  NormalFile ByteString
x FileSize
y -> ByteString -> FileSize -> GenEntryContent ByteString String
forall content linkTarget.
content -> FileSize -> GenEntryContent content linkTarget
NormalFile ByteString
x FileSize
y
  GenEntryContent ByteString LinkTarget
Directory -> GenEntryContent ByteString String
forall content linkTarget. GenEntryContent content linkTarget
Directory
  SymbolicLink LinkTarget
linkTarget -> String -> GenEntryContent ByteString String
forall content linkTarget.
linkTarget -> GenEntryContent content linkTarget
SymbolicLink (String -> GenEntryContent ByteString String)
-> String -> GenEntryContent ByteString String
forall a b. (a -> b) -> a -> b
$ LinkTarget -> String
fromLinkTargetToPosixPath LinkTarget
linkTarget
  HardLink LinkTarget
linkTarget -> String -> GenEntryContent ByteString String
forall content linkTarget.
linkTarget -> GenEntryContent content linkTarget
HardLink (String -> GenEntryContent ByteString String)
-> String -> GenEntryContent ByteString String
forall a b. (a -> b) -> a -> b
$ LinkTarget -> String
fromLinkTargetToPosixPath LinkTarget
linkTarget
  CharacterDevice Int
x Int
y -> Int -> Int -> GenEntryContent ByteString String
forall content linkTarget.
Int -> Int -> GenEntryContent content linkTarget
CharacterDevice Int
x Int
y
  BlockDevice Int
x Int
y -> Int -> Int -> GenEntryContent ByteString String
forall content linkTarget.
Int -> Int -> GenEntryContent content linkTarget
BlockDevice Int
x Int
y
  GenEntryContent ByteString LinkTarget
NamedPipe -> GenEntryContent ByteString String
forall content linkTarget. GenEntryContent content linkTarget
NamedPipe
  OtherEntryType Char
x ByteString
y FileSize
z -> Char -> ByteString -> FileSize -> GenEntryContent ByteString String
forall content linkTarget.
Char
-> ByteString -> FileSize -> GenEntryContent content linkTarget
OtherEntryType Char
x ByteString
y FileSize
z