zip-2.1.0: Operations on zip archives
Copyright© 2016–present Mark Karpov
LicenseBSD 3 clause
MaintainerMark Karpov <[email protected]>
Stabilityexperimental
Portabilityportable
Safe HaskellSafe-Inferred
LanguageGHC2021

Codec.Archive.Zip.Internal

Description

Low-level, non-public types and operations.

Synopsis

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 Source

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.

data EntryOrigin Source #

The origin of entries that can be streamed into archive.

data HeaderType Source #

The type of the file header: local or central directory.

Instances

Instances details
Eq HeaderType Source # 
Instance details

Defined in Codec.Archive.Zip.Internal

data DataDescriptor Source #

The data descriptor representation.

data Zip64ExtraField Source #

A temporary data structure to hold Zip64 extra data field information.

data MsDosTime Source #

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

Constructors

MsDosTime 

zipVersion :: Version Source #

“Version created by” to specify when writing archive data.

scanArchive Source #

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.

sourceEntry Source #

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.

commit Source #

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.

withNewFile Source #

Arguments

:: FilePath

Name of file to create

-> (Handle -> IO ())

Action that writes to given Handle

-> 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.

toRecreatingActions Source #

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.

optimize Source #

Arguments

:: Seq PendingAction

Collection of pending actions

-> (ProducingActions, EditingActions)

Optimized data

Transform a collection of PendingActions into ProducingActions and EditingActions—data that describes how to create resulting archive.

copyEntries Source #

Arguments

:: Handle

Opened Handle of zip archive file

-> FilePath

Path to the file to copy the entries from

-> Map EntrySelector EntrySelector

Map from original name to name to use in new archive

-> 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.

sinkEntry Source #

Arguments

:: Handle

Opened Handle of zip archive file

-> 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.

sinkData Source #

Arguments

:: Handle

Opened Handle of zip archive file

-> CompressionMethod

Compression method to apply

-> ConduitT ByteString Void (ResourceT IO) DataDescriptor

Sink where to stream data

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.

writeCD Source #

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.

parseZip64ExtraField Source #

Arguments

:: Zip64ExtraField

What is read from central directory file header

-> ByteString

Actual binary representation

-> Zip64ExtraField

Result

Parse Zip64ExtraField from its binary representation.

makeZip64ExtraField Source #

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.

putHeader Source #

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.

putZip64ECD Source #

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.

putZip64ECDLocator Source #

Arguments

:: Natural

Offset of Zip64 end of central directory

-> Put 

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.

putECD Source #

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.

renameKey :: Ord k => k -> k -> Map k a -> Map k a Source #

Rename an entry (key) in a Map.

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.

decodeText Source #

Arguments

:: Bool

Whether bit 11 of general-purpose bit flag is set

-> ByteString

Binary data to decode

-> Maybe Text

Decoded Text in case of success

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.

toMsDosTime :: UTCTime -> MsDosTime Source #

Convert UTCTime to the MS-DOS time format.

fromMsDosTime :: MsDosTime -> UTCTime Source #

Convert MS-DOS date-time to UTCTime.

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.