Copyright | © 2016–present Mark Karpov |
---|---|
License | BSD 3 clause |
Maintainer | Mark Karpov <[email protected]> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | GHC2021 |
Codec.Archive.Zip.Internal
Description
Low-level, non-public types and operations.
Synopsis
- data PendingAction
- = SinkEntry CompressionMethod (ConduitT () ByteString (ResourceT IO) ()) EntrySelector
- | CopyEntry FilePath EntrySelector EntrySelector
- | RenameEntry EntrySelector EntrySelector
- | DeleteEntry EntrySelector
- | Recompress CompressionMethod EntrySelector
- | SetEntryComment Text EntrySelector
- | DeleteEntryComment EntrySelector
- | SetModTime UTCTime EntrySelector
- | AddExtraField Word16 ByteString EntrySelector
- | DeleteExtraField Word16 EntrySelector
- | SetArchiveComment Text
- | DeleteArchiveComment
- | SetExternalFileAttributes Word32 EntrySelector
- data ProducingActions = ProducingActions {
- paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)
- paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
- data EditingActions = EditingActions {
- eaCompression :: Map EntrySelector CompressionMethod
- eaEntryComment :: Map EntrySelector Text
- eaDeleteComment :: Map EntrySelector ()
- eaModTime :: Map EntrySelector UTCTime
- eaExtraField :: Map EntrySelector (Map Word16 ByteString)
- eaDeleteField :: Map EntrySelector (Map Word16 ())
- eaExtFileAttr :: Map EntrySelector Word32
- data EntryOrigin
- data HeaderType
- data DataDescriptor = DataDescriptor {}
- data Zip64ExtraField = Zip64ExtraField {}
- data MsDosTime = MsDosTime {}
- zipVersion :: Version
- scanArchive :: FilePath -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
- sourceEntry :: (PrimMonad m, MonadThrow m, MonadResource m) => FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
- commit :: FilePath -> ArchiveDescription -> Map EntrySelector EntryDescription -> Seq PendingAction -> IO ()
- withNewFile :: FilePath -> (Handle -> IO ()) -> IO ()
- predictComment :: Maybe Text -> Seq PendingAction -> Maybe Text
- toRecreatingActions :: FilePath -> Map EntrySelector EntryDescription -> Seq PendingAction
- optimize :: Seq PendingAction -> (ProducingActions, EditingActions)
- copyEntries :: Handle -> FilePath -> Map EntrySelector EntrySelector -> EditingActions -> IO (Map EntrySelector EntryDescription)
- sinkEntry :: Handle -> EntrySelector -> EntryOrigin -> ConduitT () ByteString (ResourceT IO) () -> EditingActions -> IO (EntrySelector, EntryDescription)
- sinkData :: Handle -> CompressionMethod -> ConduitT ByteString Void (ResourceT IO) DataDescriptor
- writeCD :: Handle -> Maybe Text -> Map EntrySelector EntryDescription -> IO ()
- getLocalHeaderGap :: Get Integer
- getCD :: Get (Map EntrySelector EntryDescription)
- getCDHeader :: Get (Maybe (EntrySelector, EntryDescription))
- getExtraField :: Get (Word16, ByteString)
- getSignature :: Word32 -> Get ()
- parseZip64ExtraField :: Zip64ExtraField -> ByteString -> Zip64ExtraField
- makeZip64ExtraField :: HeaderType -> Zip64ExtraField -> ByteString
- putExtraField :: Map Word16 ByteString -> Put
- putCD :: Map EntrySelector EntryDescription -> Put
- putHeader :: HeaderType -> EntrySelector -> EntryDescription -> Put
- putZip64ECD :: Natural -> Natural -> Natural -> Put
- putZip64ECDLocator :: Natural -> Put
- getECD :: Get ArchiveDescription
- putECD :: Natural -> Natural -> Natural -> Maybe Text -> Put
- locateECD :: FilePath -> Handle -> IO (Maybe Integer)
- renameKey :: Ord k => k -> k -> Map k a -> Map k a
- withSaturation :: forall a b. (Integral a, Integral b, Bounded b) => a -> b
- targetEntry :: PendingAction -> Maybe EntrySelector
- decodeText :: Bool -> ByteString -> Maybe Text
- needsUnicode :: Text -> Bool
- toVersion :: Word16 -> Version
- fromVersion :: Version -> Word16
- toCompressionMethod :: Word16 -> Maybe CompressionMethod
- fromCompressionMethod :: CompressionMethod -> Word16
- needsZip64 :: EntryDescription -> Bool
- getZipVersion :: Bool -> Maybe CompressionMethod -> Version
- decompressingPipe :: (PrimMonad m, MonadThrow m, MonadResource m) => CompressionMethod -> ConduitT ByteString ByteString m ()
- crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32
- toMsDosTime :: UTCTime -> MsDosTime
- fromMsDosTime :: MsDosTime -> UTCTime
- ffff :: Natural
- ffffffff :: Natural
- defaultFileMode :: Word32
Documentation
data PendingAction Source #
The sum type describes all possible actions that can be performed on an archive.
Constructors
SinkEntry CompressionMethod (ConduitT () ByteString (ResourceT IO) ()) EntrySelector | Add an entry given its |
CopyEntry FilePath EntrySelector EntrySelector | Copy an entry form another archive without re-compression |
RenameEntry EntrySelector EntrySelector | Change the name of the entry inside archive |
DeleteEntry EntrySelector | Delete an entry from archive |
Recompress CompressionMethod EntrySelector | Change the compression method on an entry |
SetEntryComment Text EntrySelector | Set the comment for a particular entry |
DeleteEntryComment EntrySelector | Delete theh comment of a particular entry |
SetModTime UTCTime EntrySelector | Set the modification time of a particular entry |
AddExtraField Word16 ByteString EntrySelector | Add an extra field to the specified entry |
DeleteExtraField Word16 EntrySelector | Delete an extra filed of the specified entry |
SetArchiveComment Text | Set the comment for the entire archive |
DeleteArchiveComment | Delete the comment of the entire archive |
SetExternalFileAttributes Word32 EntrySelector | Set an external file attribute for the specified entry |
data ProducingActions Source #
A collection of maps describing how to produce entries in the resulting archive.
Constructors
ProducingActions | |
Fields
|
data EditingActions Source #
A collection of editing actions, that is, actions that modify already existing entries.
Constructors
data EntryOrigin Source #
The origin of entries that can be streamed into archive.
Constructors
GenericOrigin | |
Borrowed EntryDescription |
data HeaderType Source #
The type of the file header: local or central directory.
Constructors
LocalHeader | |
CentralDirHeader |
Instances
Eq HeaderType Source # | |
Defined in Codec.Archive.Zip.Internal |
data Zip64ExtraField Source #
A temporary data structure to hold Zip64 extra data field information.
Constructors
Zip64ExtraField | |
Fields |
MS-DOS date-time: a pair of Word16
(date, time) with the following
structure:
DATE bit 0 - 4 5 - 8 9 - 15 value day (1 - 31) month (1 - 12) years from 1980 TIME bit 0 - 4 5 - 10 11 - 15 value seconds* minute hour *stored in two-second increments
zipVersion :: Version Source #
“Version created by” to specify when writing archive data.
Arguments
:: FilePath | Path to archive to scan |
-> IO (ArchiveDescription, Map EntrySelector EntryDescription) |
Scan the central directory of an archive and return its description
ArchiveDescription
as well as a collection of its entries.
This operation may fail with:
isAlreadyInUseError
if the file is already open and cannot be reopened;isDoesNotExistError
if the file does not exist;isPermissionError
if the user does not have permission to open the file;ParsingFailed
when specified archive is something this library cannot parse (this includes multi-disk archives, for example).
Please note that entries with invalid (non-portable) file names may be
missing in the list of entries. Files that are compressed with
unsupported compression methods are skipped as well. Also, if several
entries would collide on some operating systems (such as Windows, because
of its case-insensitivity), only one of them will be available, because
EntrySelector
is case-insensitive. These are the consequences of the
design decision to make it impossible to create non-portable archives
with this library.
Arguments
:: (PrimMonad m, MonadThrow m, MonadResource m) | |
=> FilePath | Path to archive that contains the entry |
-> EntryDescription | Information needed to extract entry of interest |
-> Bool | Should we stream uncompressed data? |
-> ConduitT () ByteString m () | Source of uncompressed data |
Given location of the archive and information about a specific archive
entry EntryDescription
, return Source
of its data. The actual data
can be compressed or uncompressed depending on the third argument.
Arguments
:: FilePath | Location of archive file to edit or create |
-> ArchiveDescription | Archive description |
-> Map EntrySelector EntryDescription | Current list of entires |
-> Seq PendingAction | Collection of pending actions |
-> IO () |
Undertake all actions specified as the fourth argument of the function. This transforms the given pending actions so they can be performed in one pass, and then they are applied in the most efficient way.
Arguments
:: FilePath | Name of file to create |
-> (Handle -> IO ()) | Action that writes to given |
-> IO () |
Create a new file with the guarantee that in the case of an exception the old file will be intact. The file is only updated/replaced if the second argument finishes without exceptions.
predictComment :: Maybe Text -> Seq PendingAction -> Maybe Text Source #
Determine what comment in new archive will look like given its original value and a collection of pending actions.
Arguments
:: FilePath | Name of the archive file where entires are found |
-> Map EntrySelector EntryDescription | Actual list of entires |
-> Seq PendingAction | Actions that recreate the archive entries |
Transform a map representing existing entries into a collection of actions that re-create those entires.
Arguments
:: Seq PendingAction | Collection of pending actions |
-> (ProducingActions, EditingActions) | Optimized data |
Transform a collection of PendingAction
s into ProducingActions
and
EditingActions
—data that describes how to create resulting archive.
Arguments
:: Handle | Opened |
-> FilePath | Path to the file to copy the entries from |
-> Map EntrySelector EntrySelector |
|
-> EditingActions | Additional info that can influence result |
-> IO (Map EntrySelector EntryDescription) | Info to generate central directory file headers later |
Copy entries from another archive and write them into the file
associated with the given handle. This can throw EntryDoesNotExist
if
there is no such entry in that archive.
Arguments
:: Handle | Opened |
-> EntrySelector | Name of the entry to add |
-> EntryOrigin | Origin of the entry (can contain additional info) |
-> ConduitT () ByteString (ResourceT IO) () | Source of the entry contents |
-> EditingActions | Additional info that can influence result |
-> IO (EntrySelector, EntryDescription) | Info to generate the central directory file headers later |
Sink an entry from the given stream into the file associated with the
given Handle
.
Arguments
:: Handle | Opened |
-> CompressionMethod | Compression method to apply |
-> ConduitT ByteString Void (ResourceT IO) DataDescriptor |
|
Create a Sink
to stream data there. Once streaming is finished,
return DataDescriptor
for the streamed data. The action does not
close the given Handle
.
Arguments
:: Handle | Opened handle of zip archive file |
-> Maybe Text | Commentary to the entire archive |
-> Map EntrySelector EntryDescription | Info about already written local headers and entry data |
-> IO () |
Append central directory entries and the end of central directory
record to the file that given Handle
is associated with. Note that this
automatically writes Zip64 end of central directory record and Zip64 end
of central directory locator when necessary.
getLocalHeaderGap :: Get Integer Source #
Extract the number of bytes between the start of file name in local header and the start of actual data.
getCD :: Get (Map EntrySelector EntryDescription) Source #
Parse central directory file headers and put them into a Map
.
getCDHeader :: Get (Maybe (EntrySelector, EntryDescription)) Source #
Parse a single central directory file header. If it's a directory or
file compressed with unsupported compression method, Nothing
is
returned.
getExtraField :: Get (Word16, ByteString) Source #
Parse an extra-field.
getSignature :: Word32 -> Get () Source #
Get signature. If the extracted data is not equal to the provided signature, fail.
Arguments
:: Zip64ExtraField | What is read from central directory file header |
-> ByteString | Actual binary representation |
-> Zip64ExtraField | Result |
Parse Zip64ExtraField
from its binary representation.
Arguments
:: HeaderType | Is this for local or central directory header? |
-> Zip64ExtraField | Zip64 extra field's data |
-> ByteString | Resulting representation |
Produce binary representation of Zip64ExtraField
.
putExtraField :: Map Word16 ByteString -> Put Source #
Create ByteString
representing an extra field.
putCD :: Map EntrySelector EntryDescription -> Put Source #
Create ByteString
representing the entire central directory.
Arguments
:: HeaderType | Type of header to generate |
-> EntrySelector | Name of entry to write |
-> EntryDescription | Description of entry |
-> Put |
Create ByteString
representing either a local file header or a
central directory file header.
Arguments
:: Natural | Total number of entries |
-> Natural | Size of the central directory |
-> Natural | Offset of central directory record |
-> Put |
Create ByteString
representing Zip64 end of central directory record.
Create ByteString
representing Zip64 end of the central directory
locator.
getECD :: Get ArchiveDescription Source #
Parse end of the central directory record or Zip64 end of the central directory record depending on signature binary data begins with.
Arguments
:: Natural | Total number of entries |
-> Natural | Size of the central directory |
-> Natural | Offset of central directory record |
-> Maybe Text | Zip file comment |
-> Put |
Create a ByteString
representing the end of central directory record.
locateECD :: FilePath -> Handle -> IO (Maybe Integer) Source #
Find the absolute offset of the end of central directory record or, if present, Zip64 end of central directory record.
withSaturation :: forall a b. (Integral a, Integral b, Bounded b) => a -> b Source #
Like fromIntegral
, but with saturation when converting to bounded
types.
targetEntry :: PendingAction -> Maybe EntrySelector Source #
Determine the target entry of an action.
Arguments
:: Bool | Whether bit 11 of general-purpose bit flag is set |
-> ByteString | Binary data to decode |
-> Maybe Text | Decoded |
Decode a ByteString
. The first argument indicates whether we should
treat it as UTF-8 (in case bit 11 of general-purpose bit flag is set),
otherwise the function assumes CP437. Note that since not every stream of
bytes constitutes valid UTF-8 text, this function can fail. In that case
Nothing
is returned.
needsUnicode :: Text -> Bool Source #
Detect if the given text needs newer Unicode-aware features to be properly encoded in the archive.
toVersion :: Word16 -> Version Source #
Convert numeric representation (as per the .ZIP specification) of
version into Version
.
fromVersion :: Version -> Word16 Source #
Covert Version
to its numeric representation as per the .ZIP
specification.
toCompressionMethod :: Word16 -> Maybe CompressionMethod Source #
Get the compression method form its numeric representation.
fromCompressionMethod :: CompressionMethod -> Word16 Source #
Convert CompressionMethod
to its numeric representation as per the
.ZIP specification.
needsZip64 :: EntryDescription -> Bool Source #
Check if an entry with these parameters needs the Zip64 extension.
getZipVersion :: Bool -> Maybe CompressionMethod -> Version Source #
Determine “version needed to extract” that should be written to the headers given the need of the Zip64 feature and the compression method.
decompressingPipe :: (PrimMonad m, MonadThrow m, MonadResource m) => CompressionMethod -> ConduitT ByteString ByteString m () Source #
Return a decompressing Conduit
corresponding to the given compression
method.
crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32 Source #
A sink that calculates the CRC32 check sum for an incoming stream.
defaultFileMode :: Word32 Source #
The default permissions for the files, permissions not set on Windows, and are set to rw on Unix. This mimics the behavior of the zip utility.