{-# LINE 1 "src/Codec/Archive/Types.cpphs" #-}
# 1 "src/Codec/Archive/Types.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 14 "<command-line>"
# 1 "/usr/include/stdc-predef.h" 1 3 4

# 17 "/usr/include/stdc-predef.h" 3 4











































# 14 "<command-line>" 2
# 1 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h" 1



# 13 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 23 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 33 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 43 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 53 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 63 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 73 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 83 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 93 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"


# 104 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 114 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 124 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 134 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 144 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 154 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 164 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 174 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 184 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 194 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 204 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 214 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 224 "/development/haskell/libarchive/dist-newstyle/build/x86_64-linux/ghc-9.2.1/libarchive-3.0.3.2/build/autogen/cabal_macros.h"

# 14 "<command-line>" 2
# 1 "/home/vanessa/.ghcup/ghc/9.2.1/lib/ghc-9.2.1/include/ghcversion.h" 1
















# 14 "<command-line>" 2
# 1 "src/Codec/Archive/Types.cpphs"
module Codec.Archive.Types ( -- * Concrete (Haskell) data types
                             Entry (..)
                           , EntryContent (..)
                           , Ownership (..)
                           , ModTime
                           , Id
                           , Permissions
                           , ArchiveEncryption (..)
                           , ArchiveResult (..)
                           , ArchiveEntryDigest (..)
                           -- * Foreign types
                           , module Codec.Archive.Types.Foreign
                           -- * Callbacks
                           , ArchiveOpenCallback
                           , ArchiveCloseCallback
                           , ArchiveSwitchCallback
                           , ArchiveFreeCallback
                           -- * Marshalling functions
                           , resultToErr
                           ) where

import           Codec.Archive.Types.Foreign
import           Data.Int                    (Int64)
import           Foreign.C.Types             (CInt, CLong, CTime, CUShort)
import           Foreign.Ptr                 (Ptr)
import           System.Posix.Types          (CMode (..))

type ArchiveOpenCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult
type ArchiveCloseCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult
type ArchiveSwitchCallback a b = Ptr Archive -> Ptr a -> Ptr b -> IO ArchiveResult
type ArchiveFreeCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult

resultToErr :: ArchiveResult -> CInt
resultToErr = fromIntegral . fromEnum

data ArchiveEncryption = HasEncryption
                       | NoEncryption
                       | EncryptionUnsupported
                       | EncryptionUnknown
                       deriving (Eq)

-- TODO: support everything here: http://hackage.haskell.org/package/tar/docs/Codec-Archive-Tar-Entry.html#t:EntryContent
data EntryContent fp e = NormalFile e
                       | Directory
                       | Symlink !fp !Symlink
                       | Hardlink !fp
    deriving (Show, Eq, Ord)

-- | @e@ is the type of entry contents, for instance 'BSL.ByteString'
--
-- @fp@ is the type of file paths, for instance 'FilePath'
data Entry fp e = Entry { filepath    :: !fp -- TODO: bytestring? functorial?
                        , content     :: EntryContent fp e
                        , permissions :: !Permissions
                        , ownership   :: !Ownership
                        , time        :: !(Maybe ModTime)
                        }
    deriving (Show, Eq, Ord)

data Ownership = Ownership { userName  :: !(Maybe String)
                           , groupName :: !(Maybe String)
                           , ownerId   :: !Id
                           , groupId   :: !Id
                           }
    deriving (Eq, Show, Ord)




type Permissions = CMode


-- | Pair of a UNIX time stamp and a nanosecond fractional part.
type ModTime = (CTime, CLong)

-- | A user or group ID
type Id = Int64