{-# LANGUAGE CPP #-}
#if WINDOWS
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
#endif
-- | Module contains all the types necessary for tarball processing.
module Data.Conduit.Tar.Types
    ( Header(..)
    , PaxHeader
    , PaxState (..)
    , initialPaxState
    , TarChunk(..)
    , TarException(..)
    , TarCreateException(..)
    , FileType(..)
    , FileInfo(..)
    , FileOffset
    , ByteCount
    , UserID
    , GroupID
    , DeviceID
    , EpochTime
    , CUid(..)
    , CGid(..)
    , encodeFilePath
    , decodeFilePath
    , getFileInfoPath
    ) where

import           Control.Exception        (Exception)
import           Data.ByteString          (ByteString)
import           Data.ByteString.Short    (ShortByteString)
import           Data.Word
import           System.Posix.Types
import qualified Data.ByteString.Char8         as S8
import           Data.Map                 (Map)
import           Data.Text                     as T
import           Data.Text.Encoding            as T
import           Data.Text.Encoding.Error      as T
#if WINDOWS
import           Data.Bits
import           Foreign.Storable
newtype CUid =
  CUid Word32
  deriving ( Bounded
           , Enum
           , Eq
           , Integral
           , Num
           , Ord
           , Read
           , Real
           , Show
           , Bits
           , Storable
           )
newtype CGid =
  CGid Word32
  deriving ( Bounded
           , Enum
           , Eq
           , Integral
           , Num
           , Ord
           , Read
           , Real
           , Show
           , Bits
           , Storable
           )
type UserID = CUid
type GroupID = CGid
#endif

data FileType
    = FTNormal
    | FTHardLink !ByteString
    | FTSymbolicLink !ByteString
    | FTCharacterSpecial
    | FTBlockSpecial
    | FTDirectory
    | FTFifo
    | FTOther !Word8
    deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileType -> ShowS
showsPrec :: Int -> FileType -> ShowS
$cshow :: FileType -> String
show :: FileType -> String
$cshowList :: [FileType] -> ShowS
showList :: [FileType] -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: FileType -> FileType -> Bool
Eq)


data FileInfo = FileInfo
    { FileInfo -> ByteString
filePath      :: !ByteString -- ^ File path.
    , FileInfo -> UserID
fileUserId    :: !UserID  -- ^ Unix user id.
    , FileInfo -> ByteString
fileUserName  :: !ByteString  -- ^ Unix user name.
    , FileInfo -> GroupID
fileGroupId   :: !GroupID -- ^ Unix group id.
    , FileInfo -> ByteString
fileGroupName :: !ByteString  -- ^ Unix group name.
    , FileInfo -> FileMode
fileMode      :: !FileMode -- ^ Unix file permissions
    , FileInfo -> FileOffset
fileSize      :: !FileOffset -- ^ File size
    , FileInfo -> FileType
fileType      :: !FileType  -- ^ File type. `FTNormal`, `FTHardLink` (@since 0.3.0),
                                  -- `FTSymbolicLink` and `FTDirectory` are the only ones supported
                                  -- for now
    , FileInfo -> EpochTime
fileModTime   :: !EpochTime -- ^ File modification timestamp
    } deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> String
show :: FileInfo -> String
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
/= :: FileInfo -> FileInfo -> Bool
Eq)


data Header = Header
    { Header -> FileOffset
headerOffset         :: !FileOffset
    , Header -> FileOffset
headerPayloadOffset  :: !FileOffset
    , Header -> ShortByteString
headerFileNameSuffix :: !ShortByteString
    , Header -> FileMode
headerFileMode       :: !CMode
    , Header -> UserID
headerOwnerId        :: !UserID
    , Header -> GroupID
headerGroupId        :: !GroupID
    , Header -> FileOffset
headerPayloadSize    :: !FileOffset
    , Header -> EpochTime
headerTime           :: !EpochTime
    , Header -> Word8
headerLinkIndicator  :: !Word8
    , Header -> ShortByteString
headerLinkName       :: !ShortByteString
    , Header -> ShortByteString
headerMagicVersion   :: !ShortByteString
    , Header -> ShortByteString
headerOwnerName      :: !ShortByteString
    , Header -> ShortByteString
headerGroupName      :: !ShortByteString
    , Header -> DeviceID
headerDeviceMajor    :: !DeviceID
    , Header -> DeviceID
headerDeviceMinor    :: !DeviceID
    , Header -> ShortByteString
headerFileNamePrefix :: !ShortByteString
    }
    deriving Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show

-- | Type synonym representing a pax extended header.
type PaxHeader = Map ByteString ByteString

-- | Type representing states (global, next file) given pax extended headers.
data PaxState = PaxState PaxHeader PaxHeader

-- | The initial state before applying any pax extended headers.
initialPaxState :: PaxState
initialPaxState :: PaxState
initialPaxState = PaxHeader -> PaxHeader -> PaxState
PaxState PaxHeader
forall a. Monoid a => a
mempty PaxHeader
forall a. Monoid a => a
mempty

data TarChunk
    = ChunkHeader Header
    | ChunkPayload !FileOffset !ByteString
    | ChunkException TarException
    deriving Int -> TarChunk -> ShowS
[TarChunk] -> ShowS
TarChunk -> String
(Int -> TarChunk -> ShowS)
-> (TarChunk -> String) -> ([TarChunk] -> ShowS) -> Show TarChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TarChunk -> ShowS
showsPrec :: Int -> TarChunk -> ShowS
$cshow :: TarChunk -> String
show :: TarChunk -> String
$cshowList :: [TarChunk] -> ShowS
showList :: [TarChunk] -> ShowS
Show

-- | This the the exception type that is used in this module.
--
-- More constructors are susceptible to be added without bumping the major
-- version of this module.
data TarException
    = NoMoreHeaders
    | UnexpectedPayload !FileOffset
    | IncompleteHeader  !FileOffset
    | IncompletePayload !FileOffset !ByteCount
    | ShortTrailer      !FileOffset
    | BadTrailer        !FileOffset
    | InvalidHeader     !FileOffset
    | BadChecksum       !FileOffset
    | FileTypeError     !FileOffset !Char !String
    | UnsupportedType   !FileType
    deriving Int -> TarException -> ShowS
[TarException] -> ShowS
TarException -> String
(Int -> TarException -> ShowS)
-> (TarException -> String)
-> ([TarException] -> ShowS)
-> Show TarException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TarException -> ShowS
showsPrec :: Int -> TarException -> ShowS
$cshow :: TarException -> String
show :: TarException -> String
$cshowList :: [TarException] -> ShowS
showList :: [TarException] -> ShowS
Show
instance Exception TarException


data TarCreateException
    = FileNameTooLong   !FileInfo
    | TarCreationError  !String
    deriving Int -> TarCreateException -> ShowS
[TarCreateException] -> ShowS
TarCreateException -> String
(Int -> TarCreateException -> ShowS)
-> (TarCreateException -> String)
-> ([TarCreateException] -> ShowS)
-> Show TarCreateException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TarCreateException -> ShowS
showsPrec :: Int -> TarCreateException -> ShowS
$cshow :: TarCreateException -> String
show :: TarCreateException -> String
$cshowList :: [TarCreateException] -> ShowS
showList :: [TarCreateException] -> ShowS
Show
instance Exception TarCreateException

-- | Convert `FilePath` into a UTF-8 encoded `ByteString`
encodeFilePath :: FilePath -> S8.ByteString
encodeFilePath :: String -> ByteString
encodeFilePath = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Convert UTF-8 encoded `ByteString` back into the `FilePath`.
decodeFilePath :: S8.ByteString -> FilePath
decodeFilePath :: ByteString -> String
decodeFilePath = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode

-- | Get the `FilePath`.
getFileInfoPath :: FileInfo -> FilePath
getFileInfoPath :: FileInfo -> String
getFileInfoPath = ByteString -> String
decodeFilePath (ByteString -> String)
-> (FileInfo -> ByteString) -> FileInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> ByteString
filePath