    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections #-}

    -- |
    -- Module      :  Codec.Archive.Zip.Internal
    -- Copyright   :  © 2016–present Mark Karpov
    -- License     :  BSD 3 clause
    --
    -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Low-level, non-public types and operations.
    module Codec.Archive.Zip.Internal where

    import Codec.Archive.Zip.CP437 (decodeCP437)
    import Codec.Archive.Zip.Internal.Type
    import Conduit (PrimMonad)
    import Control.Applicative (many, (<|>))
    import Control.Exception (bracketOnError, catchJust)
    import Control.Monad
    import Control.Monad.Catch (MonadThrow (..))
    import Control.Monad.Trans.Maybe
    import Control.Monad.Trans.Resource (MonadResource, ResourceT)
    import Data.Bits
    import Data.Bool (bool)
    import Data.ByteString (ByteString)
    import Data.ByteString qualified as B
    import Data.Char (ord)
    import Data.Conduit (ConduitT, ZipSink (..), (.|))
    import Data.Conduit qualified as C
    import Data.Conduit.Binary qualified as CB
    import Data.Conduit.List qualified as CL
    import Data.Conduit.Zlib qualified as Z
    import Data.Digest.CRC32 (crc32Update)
    import Data.Fixed (Fixed (..))
    import Data.Map.Strict (Map)
    import Data.Map.Strict qualified as M
    import Data.Maybe (catMaybes, fromJust, isNothing)
    import Data.Sequence (Seq, (><), (|>))
    import Data.Sequence qualified as S
    import Data.Serialize
    import Data.Set qualified as E
    import Data.Text (Text)
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Data.Time
    import Data.Version
    import Data.Void
    import Data.Word (Word16, Word32)
    import Numeric.Natural (Natural)
    import System.Directory
    import System.FilePath
    import System.IO
    import System.IO.Error (isDoesNotExistError)

    #ifndef mingw32_HOST_OS
    import qualified Codec.Archive.Zip.Unix as Unix
    #endif

    #ifdef ENABLE_BZIP2
    import qualified Data.Conduit.BZlib as BZ
    #endif

    #ifdef ENABLE_ZSTD
    import qualified Data.Conduit.Zstd as Zstandard
    #endif

    #if !MIN_VERSION_base(4,20,0)
    import Data.Foldable (foldl')
    #endif

    ----------------------------------------------------------------------------
    -- Data types

    -- | The sum type describes all possible actions that can be performed on an
    -- archive.
    data PendingAction
      = -- | Add an entry given its 'Source'
        SinkEntry
          CompressionMethod
          (ConduitT () ByteString (ResourceT IO) ())
          EntrySelector
      | -- | Add an entry given its content as a string ByteString.
        StrictEntry CompressionMethod ByteString EntrySelector
      | -- | Copy an entry from another archive without re-compression
        CopyEntry FilePath EntrySelector EntrySelector
      | -- | Change the name of the entry inside archive
        RenameEntry EntrySelector EntrySelector
      | -- | Delete an entry from archive
        DeleteEntry EntrySelector
      | -- | Change the compression method on an entry
        Recompress CompressionMethod EntrySelector
      | -- | Set the comment for a particular entry
        SetEntryComment Text EntrySelector
      | -- | Delete theh comment of a particular entry
        DeleteEntryComment EntrySelector
      | -- | Set the modification time of a particular entry
        SetModTime UTCTime EntrySelector
      | -- | Add an extra field to the specified entry
        AddExtraField Word16 ByteString EntrySelector
      | -- | Delete an extra filed of the specified entry
        DeleteExtraField Word16 EntrySelector
      | -- | Set the comment for the entire archive
        SetArchiveComment Text
      | -- | Delete the comment of the entire archive
        DeleteArchiveComment
      | -- | Set an external file attribute for the specified entry
        SetExternalFileAttributes Word32 EntrySelector

    -- | A collection of maps describing how to produce entries in the resulting
    -- archive.
    data ProducingActions = ProducingActions
      { ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
    paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector),
        ProducingActions
    -> Map
         EntrySelector
         (EntryOrigin, ConduitT () ByteString (ResourceT IO) ())
    paSinkEntry :: Map EntrySelector (EntryOrigin, ConduitT () ByteString (ResourceT IO) ())
      }

    -- | A collection of editing actions, that is, actions that modify already
    -- existing entries.
    data EditingActions = EditingActions
      { EditingActions -> Map EntrySelector CompressionMethod
    eaCompression :: Map EntrySelector CompressionMethod,
        EditingActions -> Map EntrySelector Text
    eaEntryComment :: Map EntrySelector Text,
        EditingActions -> Map EntrySelector ()
    eaDeleteComment :: Map EntrySelector (),
        EditingActions -> Map EntrySelector UTCTime
    eaModTime :: Map EntrySelector UTCTime,
        EditingActions -> Map EntrySelector (Map Word16 ByteString)
    eaExtraField :: Map EntrySelector (Map Word16 ByteString),
        EditingActions -> Map EntrySelector (Map Word16 ())
    eaDeleteField :: Map EntrySelector (Map Word16 ()),
        EditingActions -> Map EntrySelector Word32
    eaExtFileAttr :: Map EntrySelector Word32
      }

    -- | The origin of entries that can be streamed into archive.
    data EntryOrigin
      = GenericOrigin
      | StrictOrigin Natural -- uncompressed length
      | Borrowed EntryDescription
      deriving (EntryOrigin -> EntryOrigin -> Bool
    (EntryOrigin -> EntryOrigin -> Bool)
    -> (EntryOrigin -> EntryOrigin -> Bool) -> Eq EntryOrigin
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EntryOrigin -> EntryOrigin -> Bool
    == :: EntryOrigin -> EntryOrigin -> Bool
    $c/= :: EntryOrigin -> EntryOrigin -> Bool
    /= :: EntryOrigin -> EntryOrigin -> Bool
    Eq)

    -- | The type of the file header: local or central directory.
    data HeaderType
      = LocalHeader EntryOrigin
      | CentralDirHeader
      deriving (HeaderType -> HeaderType -> Bool
    (HeaderType -> HeaderType -> Bool)
    -> (HeaderType -> HeaderType -> Bool) -> Eq HeaderType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HeaderType -> HeaderType -> Bool
    == :: HeaderType -> HeaderType -> Bool
    $c/= :: HeaderType -> HeaderType -> Bool
    /= :: HeaderType -> HeaderType -> Bool
    Eq)

    -- | The data descriptor representation.
    data DataDescriptor = DataDescriptor
      { DataDescriptor -> Word32
    ddCRC32 :: Word32,
        DataDescriptor -> Natural
    ddCompressedSize :: Natural,
        DataDescriptor -> Natural
    ddUncompressedSize :: Natural
      }

    -- | A temporary data structure to hold Zip64 extra data field information.
    data Zip64ExtraField = Zip64ExtraField
      { Zip64ExtraField -> Natural
    z64efUncompressedSize :: Natural,
        Zip64ExtraField -> Natural
    z64efCompressedSize :: Natural,
        Zip64ExtraField -> Natural
    z64efOffset :: Natural
      }

    -- | 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
    data MsDosTime = MsDosTime
      { MsDosTime -> Word16
    msDosDate :: Word16,
        MsDosTime -> Word16
    msDosTime :: Word16
      }

    ----------------------------------------------------------------------------
    -- Constants

    -- | “Version created by” to specify when writing archive data.
    zipVersion :: Version
    zipVersion :: Version
    zipVersion = [Int] -> [FilePath] -> Version
    Version [Int
    6, Int
    3] []

    ----------------------------------------------------------------------------
    -- Higher-level operations

    -- | 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.
    scanArchive ::
      -- | Path to archive to scan
      FilePath ->
      IO (ArchiveDescription, Map EntrySelector EntryDescription)
    scanArchive :: FilePath
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    scanArchive FilePath
    path = FilePath
    -> IOMode
    -> (Handle
        -> IO (ArchiveDescription, Map EntrySelector EntryDescription))
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile FilePath
    path IOMode
    ReadMode ((Handle
      -> IO (ArchiveDescription, Map EntrySelector EntryDescription))
     -> IO (ArchiveDescription, Map EntrySelector EntryDescription))
    -> (Handle
        -> IO (ArchiveDescription, Map EntrySelector EntryDescription))
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
      mecdOffset <- FilePath -> Handle -> IO (Maybe Integer)
    locateECD FilePath
    path Handle
    h
      case mecdOffset of
        Just Integer
    ecdOffset -> do
          Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek Integer
    ecdOffset
          ecdSize <- Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    subtract Integer
    ecdOffset (Integer -> Integer) -> IO Integer -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO Integer
    hFileSize Handle
    h
          ecdRaw <- B.hGet h (fromIntegral ecdSize)
          case runGet getECD ecdRaw of
            Left FilePath
    msg -> ZipException
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> FilePath -> ZipException
    ParsingFailed FilePath
    path FilePath
    msg)
            Right ArchiveDescription
    ecd -> do
              Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Natural -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ArchiveDescription -> Natural
    adCDOffset ArchiveDescription
    ecd)
              cdRaw <- Handle -> Int -> IO ByteString
    B.hGet Handle
    h (Int -> IO ByteString) -> Int -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Natural -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ArchiveDescription -> Natural
    adCDSize ArchiveDescription
    ecd)
              case runGet getCD cdRaw of
                Left FilePath
    msg -> ZipException
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> FilePath -> ZipException
    ParsingFailed FilePath
    path FilePath
    msg)
                Right Map EntrySelector EntryDescription
    cd -> (ArchiveDescription, Map EntrySelector EntryDescription)
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ArchiveDescription
    ecd, Map EntrySelector EntryDescription
    cd)
        Maybe Integer
    Nothing ->
          ZipException
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> FilePath -> ZipException
    ParsingFailed FilePath
    path FilePath
    "Cannot locate end of central directory")

    -- | 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.
    sourceEntry ::
      (PrimMonad m, MonadThrow m, MonadResource m) =>
      -- | Path to archive that contains the entry
      FilePath ->
      -- | Information needed to extract entry of interest
      EntryDescription ->
      -- | Should we stream uncompressed data?
      Bool ->
      -- | Source of uncompressed data
      ConduitT () ByteString m ()
    sourceEntry :: forall (m :: * -> *).
    (PrimMonad m, MonadThrow m, MonadResource m) =>
    FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
    sourceEntry FilePath
    path EntryDescription {Natural
    Maybe Text
    Word32
    Version
    Map Word16 ByteString
    UTCTime
    CompressionMethod
    edVersionMadeBy :: Version
    edVersionNeeded :: Version
    edCompression :: CompressionMethod
    edModTime :: UTCTime
    edCRC32 :: Word32
    edCompressedSize :: Natural
    edUncompressedSize :: Natural
    edOffset :: Natural
    edComment :: Maybe Text
    edExtraField :: Map Word16 ByteString
    edExternalFileAttrs :: Word32
    edExternalFileAttrs :: EntryDescription -> Word32
    edExtraField :: EntryDescription -> Map Word16 ByteString
    edComment :: EntryDescription -> Maybe Text
    edOffset :: EntryDescription -> Natural
    edUncompressedSize :: EntryDescription -> Natural
    edCompressedSize :: EntryDescription -> Natural
    edCRC32 :: EntryDescription -> Word32
    edModTime :: EntryDescription -> UTCTime
    edCompression :: EntryDescription -> CompressionMethod
    edVersionNeeded :: EntryDescription -> Version
    edVersionMadeBy :: EntryDescription -> Version
    ..} Bool
    d =
      ConduitT () ByteString m ()
    forall {i}. ConduitT i ByteString m ()
    source ConduitT () ByteString m ()
    -> ConduitT ByteString ByteString m ()
    -> ConduitT () ByteString m ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| Int -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *).
    Monad m =>
    Int -> ConduitT ByteString ByteString m ()
    CB.isolate (Natural -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    edCompressedSize) ConduitT ByteString ByteString m ()
    -> ConduitT ByteString ByteString m ()
    -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString ByteString m ()
    decompress
      where
        source :: ConduitT i ByteString m ()
    source = IO Handle -> ConduitT i ByteString m ()
    forall (m :: * -> *) i.
    MonadResource m =>
    IO Handle -> ConduitT i ByteString m ()
    CB.sourceIOHandle (IO Handle -> ConduitT i ByteString m ())
    -> IO Handle -> ConduitT i ByteString m ()
    forall a b. (a -> b) -> a -> b
    $ do
          h <- FilePath -> IOMode -> IO Handle
    openFile FilePath
    path IOMode
    ReadMode
          hSeek h AbsoluteSeek (fromIntegral edOffset)
          localHeader <- B.hGet h 30
          case runGet getLocalHeaderGap localHeader of
            Left FilePath
    msg -> ZipException -> IO Handle
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> FilePath -> ZipException
    ParsingFailed FilePath
    path FilePath
    msg)
            Right Integer
    gap -> do
              Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    RelativeSeek Integer
    gap
              Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    h
        decompress :: ConduitT ByteString ByteString m ()
    decompress =
          if Bool
    d
            then CompressionMethod -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *).
    (PrimMonad m, MonadThrow m, MonadResource m) =>
    CompressionMethod -> ConduitT ByteString ByteString m ()
    decompressingPipe CompressionMethod
    edCompression
            else (ByteString -> ConduitT ByteString ByteString m ())
    -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    C.awaitForever ByteString -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    C.yield

    -- | 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.
    commit ::
      -- | Location of archive file to edit or create
      FilePath ->
      -- | Archive description
      ArchiveDescription ->
      -- | Current list of entries
      Map EntrySelector EntryDescription ->
      -- | Collection of pending actions
      Seq PendingAction ->
      IO ()
    commit :: FilePath
    -> ArchiveDescription
    -> Map EntrySelector EntryDescription
    -> Seq PendingAction
    -> IO ()
    commit FilePath
    path ArchiveDescription {Natural
    Maybe Text
    adCDOffset :: ArchiveDescription -> Natural
    adCDSize :: ArchiveDescription -> Natural
    adComment :: Maybe Text
    adCDOffset :: Natural
    adCDSize :: Natural
    adComment :: ArchiveDescription -> Maybe Text
    ..} Map EntrySelector EntryDescription
    entries Seq PendingAction
    xs =
      FilePath -> (Handle -> IO ()) -> IO ()
    withNewFile FilePath
    path ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        let (ProducingActions Map FilePath (Map EntrySelector EntrySelector)
    copying Map
      EntrySelector
      (EntryOrigin, ConduitT () ByteString (ResourceT IO) ())
    sinking, EditingActions
    editing) =
              Seq PendingAction -> (ProducingActions, EditingActions)
    optimize (FilePath -> Map EntrySelector EntryDescription -> Seq PendingAction
    toRecreatingActions FilePath
    path Map EntrySelector EntryDescription
    entries Seq PendingAction -> Seq PendingAction -> Seq PendingAction
    forall a. Seq a -> Seq a -> Seq a
    >< Seq PendingAction
    xs)
            comment :: Maybe Text
    comment = Maybe Text -> Seq PendingAction -> Maybe Text
    predictComment Maybe Text
    adComment Seq PendingAction
    xs
        copiedCD <-
          Map FilePath (Map EntrySelector EntryDescription)
    -> Map EntrySelector EntryDescription
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    f (Map k a) -> Map k a
    M.unions
            (Map FilePath (Map EntrySelector EntryDescription)
     -> Map EntrySelector EntryDescription)
    -> IO (Map FilePath (Map EntrySelector EntryDescription))
    -> IO (Map EntrySelector EntryDescription)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath
     -> Map EntrySelector EntrySelector
     -> IO (Map EntrySelector EntryDescription))
    -> Map FilePath (Map EntrySelector EntrySelector)
    -> IO (Map FilePath (Map EntrySelector EntryDescription))
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    M.traverseWithKey
              ( \FilePath
    srcPath Map EntrySelector EntrySelector
    m ->
                  Handle
    -> FilePath
    -> Map EntrySelector EntrySelector
    -> EditingActions
    -> IO (Map EntrySelector EntryDescription)
    copyEntries Handle
    h FilePath
    srcPath Map EntrySelector EntrySelector
    m EditingActions
    editing
              )
              Map FilePath (Map EntrySelector EntrySelector)
    copying
        sunkCD <-
          M.traverseWithKey
            ( \EntrySelector
    selector (EntryOrigin
    origin, ConduitT () ByteString (ResourceT IO) ()
    source) ->
                Handle
    -> EntrySelector
    -> EntryOrigin
    -> ConduitT () ByteString (ResourceT IO) ()
    -> EditingActions
    -> IO EntryDescription
    sinkEntry Handle
    h EntrySelector
    selector EntryOrigin
    origin ConduitT () ByteString (ResourceT IO) ()
    source EditingActions
    editing
            )
            (sinking `M.difference` copiedCD)
        writeCD h comment (copiedCD `M.union` sunkCD)

    -- | 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.
    withNewFile ::
      -- | Name of file to create
      FilePath ->
      -- | Action that writes to given 'Handle'
      (Handle -> IO ()) ->
      IO ()
    withNewFile :: FilePath -> (Handle -> IO ()) -> IO ()
    withNewFile FilePath
    fpath Handle -> IO ()
    action =
      IO (FilePath, Handle)
    -> ((FilePath, Handle) -> IO ())
    -> ((FilePath, Handle) -> IO ())
    -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError IO (FilePath, Handle)
    allocate (FilePath, Handle) -> IO ()
    release (((FilePath, Handle) -> IO ()) -> IO ())
    -> ((FilePath, Handle) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(FilePath
    path, Handle
    h) -> do
        Handle -> IO ()
    action Handle
    h
        Handle -> IO ()
    hClose Handle
    h
        FilePath -> FilePath -> IO ()
    renameFile FilePath
    path FilePath
    fpath
      where
        allocate :: IO (FilePath, Handle)
    allocate = FilePath -> FilePath -> IO (FilePath, Handle)
    openBinaryTempFile (FilePath -> FilePath
    takeDirectory FilePath
    fpath) FilePath
    ".zip"
        release :: (FilePath, Handle) -> IO ()
    release (FilePath
    path, Handle
    h) = do
          Handle -> IO ()
    hClose Handle
    h
          -- Despite using `bracketOnError` the file is not guaranteed to exist
          -- here since we could be interrupted with an async exception after
          -- the file has been renamed. Therefore, we silentely ignore
          -- `DoesNotExistError`.
          (IOError -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
    catchJust (Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOError -> Bool
    isDoesNotExistError) (FilePath -> IO ()
    removeFile FilePath
    path) (IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())

    -- | Determine what comment in new archive will look like given its original
    -- value and a collection of pending actions.
    predictComment :: Maybe Text -> Seq PendingAction -> Maybe Text
    predictComment :: Maybe Text -> Seq PendingAction -> Maybe Text
    predictComment Maybe Text
    original Seq PendingAction
    xs =
      case Seq PendingAction -> Int -> PendingAction
    forall a. Seq a -> Int -> a
    S.index Seq PendingAction
    xs (Int -> PendingAction) -> Maybe Int -> Maybe PendingAction
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (PendingAction -> Bool) -> Seq PendingAction -> Maybe Int
    forall a. (a -> Bool) -> Seq a -> Maybe Int
    S.findIndexR (Maybe EntrySelector -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe EntrySelector -> Bool)
    -> (PendingAction -> Maybe EntrySelector) -> PendingAction -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PendingAction -> Maybe EntrySelector
    targetEntry) Seq PendingAction
    xs of
        Maybe PendingAction
    Nothing -> Maybe Text
    original
        Just PendingAction
    DeleteArchiveComment -> Maybe Text
    forall a. Maybe a
    Nothing
        Just (SetArchiveComment Text
    txt) -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    txt
        Just PendingAction
    _ -> Maybe Text
    forall a. Maybe a
    Nothing

    -- | Transform a map representing existing entries into a collection of
    -- actions that re-create those entires.
    toRecreatingActions ::
      -- | Name of the archive file where entires are found
      FilePath ->
      -- | Actual list of entires
      Map EntrySelector EntryDescription ->
      -- | Actions that recreate the archive entries
      Seq PendingAction
    toRecreatingActions :: FilePath -> Map EntrySelector EntryDescription -> Seq PendingAction
    toRecreatingActions FilePath
    path Map EntrySelector EntryDescription
    entries = (Seq PendingAction -> EntrySelector -> Seq PendingAction)
    -> Seq PendingAction -> Set EntrySelector -> Seq PendingAction
    forall a b. (a -> b -> a) -> a -> Set b -> a
    E.foldl' Seq PendingAction -> EntrySelector -> Seq PendingAction
    f Seq PendingAction
    forall a. Seq a
    S.empty (Map EntrySelector EntryDescription -> Set EntrySelector
    forall k a. Map k a -> Set k
    M.keysSet Map EntrySelector EntryDescription
    entries)
      where
        f :: Seq PendingAction -> EntrySelector -> Seq PendingAction
    f Seq PendingAction
    s EntrySelector
    e = Seq PendingAction
    s Seq PendingAction -> PendingAction -> Seq PendingAction
    forall a. Seq a -> a -> Seq a
    |> FilePath -> EntrySelector -> EntrySelector -> PendingAction
    CopyEntry FilePath
    path EntrySelector
    e EntrySelector
    e

    -- | Transform a collection of 'PendingAction's into 'ProducingActions' and
    -- 'EditingActions'—data that describes how to create resulting archive.
    optimize ::
      -- | Collection of pending actions
      Seq PendingAction ->
      -- | Optimized data
      (ProducingActions, EditingActions)
    optimize :: Seq PendingAction -> (ProducingActions, EditingActions)
    optimize =
      ((ProducingActions, EditingActions)
     -> PendingAction -> (ProducingActions, EditingActions))
    -> (ProducingActions, EditingActions)
    -> Seq PendingAction
    -> (ProducingActions, EditingActions)
    forall b a. (b -> a -> b) -> b -> Seq a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl'
        (ProducingActions, EditingActions)
    -> PendingAction -> (ProducingActions, EditingActions)
    f
        ( Map FilePath (Map EntrySelector EntrySelector)
    -> Map
         EntrySelector
         (EntryOrigin, ConduitT () ByteString (ResourceT IO) ())
    -> ProducingActions
    ProducingActions Map FilePath (Map EntrySelector EntrySelector)
    forall k a. Map k a
    M.empty Map
      EntrySelector
      (EntryOrigin, ConduitT () ByteString (ResourceT IO) ())
    forall k a. Map k a
    M.empty,
          Map EntrySelector CompressionMethod
    -> Map EntrySelector Text
    -> Map EntrySelector ()
    -> Map EntrySelector UTCTime
    -> Map EntrySelector (Map Word16 ByteString)
    -> Map EntrySelector (Map Word16 ())
    -> Map EntrySelector Word32
    -> EditingActions
    EditingActions Map EntrySelector CompressionMethod
    forall k a. Map k a
    M.empty Map EntrySelector Text
    forall k a. Map k a
    M.empty Map EntrySelector ()
    forall k a. Map k a
    M.empty Map EntrySelector UTCTime
    forall k a. Map k a
    M.empty Map EntrySelector (Map Word16 ByteString)
    forall k a. Map k a
    M.empty Map EntrySelector (Map Word16 ())
    forall k a. Map k a
    M.empty Map EntrySelector Word32
    forall k a. Map k a
    M.empty
        )
      where
        f :: (ProducingActions, EditingActions)
    -> PendingAction -> (ProducingActions, EditingActions)
    f (ProducingActions
    pa, EditingActions
    ea) PendingAction
    a = case PendingAction
    a of
          SinkEntry CompressionMethod
    m ConduitT () ByteString (ResourceT IO) ()
    src EntrySelector
    s ->
            ( ProducingActions
    pa
                { paSinkEntry = M.insert s (GenericOrigin, src) (paSinkEntry pa),
                  paCopyEntry = M.map (M.filter (/= s)) (paCopyEntry pa)
                },
              (EntrySelector -> EditingActions -> EditingActions
    clearEditingFor EntrySelector
    s EditingActions
    ea)
                { eaCompression = M.insert s m (eaCompression ea)
                }
            )
          StrictEntry CompressionMethod
    m ByteString
    bs EntrySelector
    s ->
            ( ProducingActions
    pa
                { paSinkEntry = M.insert s (origin, C.yield bs) (paSinkEntry pa),
                  paCopyEntry = M.map (M.filter (/= s)) (paCopyEntry pa)
                },
              (EntrySelector -> EditingActions -> EditingActions
    clearEditingFor EntrySelector
    s EditingActions
    ea)
                { eaCompression = M.insert s m (eaCompression ea)
                }
            )
            where
              origin :: EntryOrigin
    origin = Natural -> EntryOrigin
    StrictOrigin (Int -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Natural) -> Int -> Natural
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    bs)
          CopyEntry FilePath
    path EntrySelector
    os EntrySelector
    ns ->
            ( ProducingActions
    pa
                { paSinkEntry = M.delete ns (paSinkEntry pa),
                  paCopyEntry = M.alter (ef os ns) path (paCopyEntry pa)
                },
              EntrySelector -> EditingActions -> EditingActions
    clearEditingFor EntrySelector
    ns EditingActions
    ea
            )
          RenameEntry EntrySelector
    os EntrySelector
    ns ->
            ( ProducingActions
    pa
                { paCopyEntry = M.map (M.map $ re os ns) (paCopyEntry pa),
                  paSinkEntry = renameKey os ns (paSinkEntry pa)
                },
              EditingActions
    ea
                { eaCompression = renameKey os ns (eaCompression ea),
                  eaEntryComment = renameKey os ns (eaEntryComment ea),
                  eaDeleteComment = renameKey os ns (eaDeleteComment ea),
                  eaModTime = renameKey os ns (eaModTime ea),
                  eaExtraField = renameKey os ns (eaExtraField ea),
                  eaDeleteField = renameKey os ns (eaDeleteField ea)
                }
            )
          DeleteEntry EntrySelector
    s ->
            ( ProducingActions
    pa
                { paSinkEntry = M.delete s (paSinkEntry pa),
                  paCopyEntry = M.map (M.delete s) (paCopyEntry pa)
                },
              EntrySelector -> EditingActions -> EditingActions
    clearEditingFor EntrySelector
    s EditingActions
    ea
            )
          Recompress CompressionMethod
    m EntrySelector
    s ->
            (ProducingActions
    pa, EditingActions
    ea {eaCompression = M.insert s m (eaCompression ea)})
          SetEntryComment Text
    txt EntrySelector
    s ->
            ( ProducingActions
    pa,
              EditingActions
    ea
                { eaEntryComment = M.insert s txt (eaEntryComment ea),
                  eaDeleteComment = M.delete s (eaDeleteComment ea)
                }
            )
          DeleteEntryComment EntrySelector
    s ->
            ( ProducingActions
    pa,
              EditingActions
    ea
                { eaEntryComment = M.delete s (eaEntryComment ea),
                  eaDeleteComment = M.insert s () (eaDeleteComment ea)
                }
            )
          SetModTime UTCTime
    time EntrySelector
    s ->
            (ProducingActions
    pa, EditingActions
    ea {eaModTime = M.insert s time (eaModTime ea)})
          AddExtraField Word16
    n ByteString
    b EntrySelector
    s ->
            ( ProducingActions
    pa,
              EditingActions
    ea
                { eaExtraField = M.alter (ef n b) s (eaExtraField ea),
                  eaDeleteField = M.delete s (eaDeleteField ea)
                }
            )
          DeleteExtraField Word16
    n EntrySelector
    s ->
            ( ProducingActions
    pa,
              EditingActions
    ea
                { eaExtraField = M.alter (er n) s (eaExtraField ea),
                  eaDeleteField = M.alter (ef n ()) s (eaDeleteField ea)
                }
            )
          SetExternalFileAttributes Word32
    b EntrySelector
    s ->
            ( ProducingActions
    pa,
              EditingActions
    ea {eaExtFileAttr = M.insert s b (eaExtFileAttr ea)}
            )
          PendingAction
    _ -> (ProducingActions
    pa, EditingActions
    ea)
        clearEditingFor :: EntrySelector -> EditingActions -> EditingActions
    clearEditingFor EntrySelector
    s EditingActions
    ea =
          EditingActions
    ea
            { eaCompression = M.delete s (eaCompression ea),
              eaEntryComment = M.delete s (eaEntryComment ea),
              eaDeleteComment = M.delete s (eaDeleteComment ea),
              eaModTime = M.delete s (eaModTime ea),
              eaExtraField = M.delete s (eaExtraField ea),
              eaDeleteField = M.delete s (eaDeleteField ea),
              eaExtFileAttr = M.delete s (eaExtFileAttr ea)
            }
        re :: p -> p -> p -> p
    re p
    o p
    n p
    x = if p
    x p -> p -> Bool
    forall a. Eq a => a -> a -> Bool
    == p
    o then p
    n else p
    x
        ef :: k -> a -> Maybe (Map k a) -> Maybe (Map k a)
    ef k
    k a
    v (Just Map k a
    m) = Map k a -> Maybe (Map k a)
    forall a. a -> Maybe a
    Just (k -> a -> Map k a -> Map k a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert k
    k a
    v Map k a
    m)
        ef k
    k a
    v Maybe (Map k a)
    Nothing = Map k a -> Maybe (Map k a)
    forall a. a -> Maybe a
    Just (k -> a -> Map k a
    forall k a. k -> a -> Map k a
    M.singleton k
    k a
    v)
        er :: k -> Maybe (Map k a) -> Maybe (Map k a)
    er k
    k (Just Map k a
    m) =
          let n :: Map k a
    n = k -> Map k a -> Map k a
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete k
    k Map k a
    m
           in if Map k a -> Bool
    forall k a. Map k a -> Bool
    M.null Map k a
    n then Maybe (Map k a)
    forall a. Maybe a
    Nothing else Map k a -> Maybe (Map k a)
    forall a. a -> Maybe a
    Just Map k a
    n
        er k
    _ Maybe (Map k a)
    Nothing = Maybe (Map k a)
    forall a. Maybe a
    Nothing

    -- | 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.
    copyEntries ::
      -- | Opened 'Handle' of zip archive file
      Handle ->
      -- | Path to the file to copy the entries from
      FilePath ->
      -- | 'Map' from original name to name to use in new archive
      Map EntrySelector EntrySelector ->
      -- | Additional info that can influence result
      EditingActions ->
      -- | Info to generate central directory file headers later
      IO (Map EntrySelector EntryDescription)
    copyEntries :: Handle
    -> FilePath
    -> Map EntrySelector EntrySelector
    -> EditingActions
    -> IO (Map EntrySelector EntryDescription)
    copyEntries Handle
    h FilePath
    path Map EntrySelector EntrySelector
    names EditingActions
    editing = do
      entries <- (ArchiveDescription, Map EntrySelector EntryDescription)
    -> Map EntrySelector EntryDescription
    forall a b. (a, b) -> b
    snd ((ArchiveDescription, Map EntrySelector EntryDescription)
     -> Map EntrySelector EntryDescription)
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    -> IO (Map EntrySelector EntryDescription)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath
    -> IO (ArchiveDescription, Map EntrySelector EntryDescription)
    scanArchive FilePath
    path
      M.foldlWithKey
        ( \IO (Map EntrySelector EntryDescription)
    acc EntrySelector
    oldName EntrySelector
    newName ->
            case EntrySelector
    -> Map EntrySelector EntryDescription -> Maybe EntryDescription
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup EntrySelector
    oldName Map EntrySelector EntryDescription
    entries of
              Maybe EntryDescription
    Nothing -> ZipException -> IO (Map EntrySelector EntryDescription)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> EntrySelector -> ZipException
    EntryDoesNotExist FilePath
    path EntrySelector
    oldName)
              Just EntryDescription
    oldDesc ->
                EntrySelector
    -> EntryDescription
    -> Map EntrySelector EntryDescription
    -> Map EntrySelector EntryDescription
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert EntrySelector
    newName
                  (EntryDescription
     -> Map EntrySelector EntryDescription
     -> Map EntrySelector EntryDescription)
    -> IO EntryDescription
    -> IO
         (Map EntrySelector EntryDescription
          -> Map EntrySelector EntryDescription)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle
    -> EntrySelector
    -> EntryOrigin
    -> ConduitT () ByteString (ResourceT IO) ()
    -> EditingActions
    -> IO EntryDescription
    sinkEntry Handle
    h EntrySelector
    newName (EntryDescription -> EntryOrigin
    Borrowed EntryDescription
    oldDesc) ConduitT () ByteString (ResourceT IO) ()
    src EditingActions
    editing
                  IO
      (Map EntrySelector EntryDescription
       -> Map EntrySelector EntryDescription)
    -> IO (Map EntrySelector EntryDescription)
    -> IO (Map EntrySelector EntryDescription)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO (Map EntrySelector EntryDescription)
    acc
                where
                  src :: ConduitT () ByteString (ResourceT IO) ()
    src = FilePath
    -> EntryDescription
    -> Bool
    -> ConduitT () ByteString (ResourceT IO) ()
    forall (m :: * -> *).
    (PrimMonad m, MonadThrow m, MonadResource m) =>
    FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
    sourceEntry FilePath
    path EntryDescription
    oldDesc Bool
    False
        )
        mempty
        names

    -- | Sink an entry from the given stream into the file associated with the
    -- given 'Handle'.
    sinkEntry ::
      -- | Opened 'Handle' of zip archive file
      Handle ->
      -- | Name of the entry to add
      EntrySelector ->
      -- | Origin of the entry (can contain additional info)
      EntryOrigin ->
      -- | Source of the entry contents
      ConduitT () ByteString (ResourceT IO) () ->
      -- | Additional info that can influence result
      EditingActions ->
      -- | Info to generate the central directory file headers later
      IO EntryDescription
    sinkEntry :: Handle
    -> EntrySelector
    -> EntryOrigin
    -> ConduitT () ByteString (ResourceT IO) ()
    -> EditingActions
    -> IO EntryDescription
    sinkEntry Handle
    h EntrySelector
    s EntryOrigin
    o ConduitT () ByteString (ResourceT IO) ()
    src EditingActions {Map EntrySelector Word32
    Map EntrySelector ()
    Map EntrySelector (Map Word16 ())
    Map EntrySelector (Map Word16 ByteString)
    Map EntrySelector Text
    Map EntrySelector UTCTime
    Map EntrySelector CompressionMethod
    eaCompression :: EditingActions -> Map EntrySelector CompressionMethod
    eaEntryComment :: EditingActions -> Map EntrySelector Text
    eaDeleteComment :: EditingActions -> Map EntrySelector ()
    eaModTime :: EditingActions -> Map EntrySelector UTCTime
    eaExtraField :: EditingActions -> Map EntrySelector (Map Word16 ByteString)
    eaDeleteField :: EditingActions -> Map EntrySelector (Map Word16 ())
    eaExtFileAttr :: EditingActions -> Map EntrySelector Word32
    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
    ..} = do
      currentTime <- IO UTCTime
    getCurrentTime
      offset <- hTell h
      let compressed = case EntryOrigin
    o of
            Borrowed EntryDescription
    ed -> EntryDescription -> CompressionMethod
    edCompression EntryDescription
    ed
            EntryOrigin
    _ -> CompressionMethod
    Store
          compression = CompressionMethod
    -> EntrySelector
    -> Map EntrySelector CompressionMethod
    -> CompressionMethod
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault CompressionMethod
    compressed EntrySelector
    s Map EntrySelector CompressionMethod
    eaCompression
          recompression = CompressionMethod
    compression CompressionMethod -> CompressionMethod -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CompressionMethod
    compressed
          modTime = case EntryOrigin
    o of
            Borrowed EntryDescription
    ed -> EntryDescription -> UTCTime
    edModTime EntryDescription
    ed
            EntryOrigin
    _ -> UTCTime
    currentTime
          extFileAttr = Word32 -> EntrySelector -> Map EntrySelector Word32 -> Word32
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault Word32
    defaultFileMode EntrySelector
    s Map EntrySelector Word32
    eaExtFileAttr
          oldExtraFields = case EntryOrigin
    o of
            Borrowed EntryDescription
    ed -> EntryDescription -> Map Word16 ByteString
    edExtraField EntryDescription
    ed
            EntryOrigin
    _ -> Map Word16 ByteString
    forall k a. Map k a
    M.empty
          extraField =
            (Map Word16 ByteString
    -> EntrySelector
    -> Map EntrySelector (Map Word16 ByteString)
    -> Map Word16 ByteString
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault Map Word16 ByteString
    forall k a. Map k a
    M.empty EntrySelector
    s Map EntrySelector (Map Word16 ByteString)
    eaExtraField Map Word16 ByteString
    -> Map Word16 ByteString -> Map Word16 ByteString
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union` Map Word16 ByteString
    oldExtraFields)
              Map Word16 ByteString -> Map Word16 () -> Map Word16 ByteString
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `M.difference` Map Word16 ()
    -> EntrySelector
    -> Map EntrySelector (Map Word16 ())
    -> Map Word16 ()
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault Map Word16 ()
    forall k a. Map k a
    M.empty EntrySelector
    s Map EntrySelector (Map Word16 ())
    eaDeleteField
          oldComment = case (EntryOrigin
    o, EntrySelector -> Map EntrySelector () -> Maybe ()
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup EntrySelector
    s Map EntrySelector ()
    eaDeleteComment) of
            (Borrowed EntryDescription
    ed, Maybe ()
    Nothing) -> EntryDescription -> Maybe Text
    edComment EntryDescription
    ed
            (EntryOrigin, Maybe ())
    _ -> Maybe Text
    forall a. Maybe a
    Nothing
          desc0 =
            EntryDescription -- to write in local header
              { edVersionMadeBy :: Version
    edVersionMadeBy = Version
    zipVersion,
                edVersionNeeded :: Version
    edVersionNeeded = Version
    zipVersion,
                edCompression :: CompressionMethod
    edCompression = CompressionMethod
    compression,
                edModTime :: UTCTime
    edModTime = UTCTime -> EntrySelector -> Map EntrySelector UTCTime -> UTCTime
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault UTCTime
    modTime EntrySelector
    s Map EntrySelector UTCTime
    eaModTime,
                edCRC32 :: Word32
    edCRC32 = Word32
    0, -- to be overwritten after streaming
                edCompressedSize :: Natural
    edCompressedSize = Natural
    0, -- ↑
                edUncompressedSize :: Natural
    edUncompressedSize = Natural
    0, -- ↑
                edOffset :: Natural
    edOffset = Integer -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    offset,
                edComment :: Maybe Text
    edComment = EntrySelector -> Map EntrySelector Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup EntrySelector
    s Map EntrySelector Text
    eaEntryComment Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe Text
    oldComment,
                edExtraField :: Map Word16 ByteString
    edExtraField = Map Word16 ByteString
    extraField,
                edExternalFileAttrs :: Word32
    edExternalFileAttrs = Word32
    extFileAttr
              }
      B.hPut h (runPut (putHeader (LocalHeader o) s desc0))
      DataDescriptor {..} <-
        C.runConduitRes $
          if recompression
            then
              if compressed == Store
                then src .| sinkData h compression
                else src .| decompressingPipe compressed .| sinkData h compression
            else src .| sinkData h Store
      afterStreaming <- hTell h
      let desc1 = case EntryOrigin
    o of
            Borrowed EntryDescription
    ed ->
              EntryDescription
    desc0
                { edCRC32 =
                    bool (edCRC32 ed) ddCRC32 recompression,
                  edCompressedSize =
                    bool (edCompressedSize ed) ddCompressedSize recompression,
                  edUncompressedSize =
                    bool (edUncompressedSize ed) ddUncompressedSize recompression
                }
            EntryOrigin
    _ ->
              EntryDescription
    desc0
                { edCRC32 = ddCRC32,
                  edCompressedSize = ddCompressedSize,
                  edUncompressedSize = ddUncompressedSize
                }
          desc2 =
            EntryDescription
    desc1
              { edVersionNeeded =
                  getZipVersion (needsZip64 desc1) (Just compression)
              }
      hSeek h AbsoluteSeek offset
      B.hPut h (runPut (putHeader (LocalHeader o) s desc2))
      hSeek h AbsoluteSeek afterStreaming
      return desc2

    {- ORMOLU_DISABLE -}

    -- | 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'.
    sinkData ::
      -- | Opened 'Handle' of zip archive file
      Handle ->
      -- | Compression method to apply
      CompressionMethod ->
      -- | 'Sink' where to stream data
      ConduitT ByteString Void (ResourceT IO) DataDescriptor
    sinkData :: Handle
    -> CompressionMethod
    -> ConduitT ByteString Void (ResourceT IO) DataDescriptor
    sinkData Handle
    h CompressionMethod
    compression = do
      let sizeSink :: ConduitT ByteString o (ResourceT IO) Natural
    sizeSink = (Natural -> ByteString -> Natural)
    -> Natural -> ConduitT ByteString o (ResourceT IO) Natural
    forall (m :: * -> *) b a o.
    Monad m =>
    (b -> a -> b) -> b -> ConduitT a o m b
    CL.fold (\Natural
    acc ByteString
    input -> Int -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    input) Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    + Natural
    acc) Natural
    0
          dataSink :: ConduitT ByteString Void (ResourceT IO) Natural
    dataSink =
            ZipSink ByteString (ResourceT IO) Natural
    -> ConduitT ByteString Void (ResourceT IO) Natural
    forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
    getZipSink (ZipSink ByteString (ResourceT IO) Natural
     -> ConduitT ByteString Void (ResourceT IO) Natural)
    -> ZipSink ByteString (ResourceT IO) Natural
    -> ConduitT ByteString Void (ResourceT IO) Natural
    forall a b. (a -> b) -> a -> b
    $
              ConduitT ByteString Void (ResourceT IO) Natural
    -> ZipSink ByteString (ResourceT IO) Natural
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink ConduitT ByteString Void (ResourceT IO) Natural
    forall {o}. ConduitT ByteString o (ResourceT IO) Natural
    sizeSink ZipSink ByteString (ResourceT IO) Natural
    -> ZipSink ByteString (ResourceT IO) ()
    -> ZipSink ByteString (ResourceT IO) Natural
    forall a b.
    ZipSink ByteString (ResourceT IO) a
    -> ZipSink ByteString (ResourceT IO) b
    -> ZipSink ByteString (ResourceT IO) a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ConduitT ByteString Void (ResourceT IO) ()
    -> ZipSink ByteString (ResourceT IO) ()
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink (Handle -> ConduitT ByteString Void (ResourceT IO) ()
    forall (m :: * -> *) o.
    MonadIO m =>
    Handle -> ConduitT ByteString o m ()
    CB.sinkHandle Handle
    h)
          withCompression :: ConduitT ByteString Void (ResourceT IO) a
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    withCompression ConduitT ByteString Void (ResourceT IO) a
    sink =
            ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
    getZipSink (ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
     -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a))
    -> ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    forall a b. (a -> b) -> a -> b
    $
              (,,) (Natural -> Word32 -> a -> (Natural, Word32, a))
    -> ZipSink ByteString (ResourceT IO) Natural
    -> ZipSink
         ByteString (ResourceT IO) (Word32 -> a -> (Natural, Word32, a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConduitT ByteString Void (ResourceT IO) Natural
    -> ZipSink ByteString (ResourceT IO) Natural
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink ConduitT ByteString Void (ResourceT IO) Natural
    forall {o}. ConduitT ByteString o (ResourceT IO) Natural
    sizeSink
                ZipSink
      ByteString (ResourceT IO) (Word32 -> a -> (Natural, Word32, a))
    -> ZipSink ByteString (ResourceT IO) Word32
    -> ZipSink ByteString (ResourceT IO) (a -> (Natural, Word32, a))
    forall a b.
    ZipSink ByteString (ResourceT IO) (a -> b)
    -> ZipSink ByteString (ResourceT IO) a
    -> ZipSink ByteString (ResourceT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ConduitT ByteString Void (ResourceT IO) Word32
    -> ZipSink ByteString (ResourceT IO) Word32
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink ConduitT ByteString Void (ResourceT IO) Word32
    crc32Sink
                ZipSink ByteString (ResourceT IO) (a -> (Natural, Word32, a))
    -> ZipSink ByteString (ResourceT IO) a
    -> ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
    forall a b.
    ZipSink ByteString (ResourceT IO) (a -> b)
    -> ZipSink ByteString (ResourceT IO) a
    -> ZipSink ByteString (ResourceT IO) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ConduitT ByteString Void (ResourceT IO) a
    -> ZipSink ByteString (ResourceT IO) a
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink ConduitT ByteString Void (ResourceT IO) a
    sink
      (uncompressedSize, crc32, compressedSize) <-
        case CompressionMethod
    compression of
          CompressionMethod
    Store ->
            ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall {a}.
    ConduitT ByteString Void (ResourceT IO) a
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    withCompression
              ConduitT ByteString Void (ResourceT IO) Natural
    dataSink
          CompressionMethod
    Deflate ->
            ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall {a}.
    ConduitT ByteString Void (ResourceT IO) a
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    withCompression (ConduitT ByteString Void (ResourceT IO) Natural
     -> ConduitT
          ByteString Void (ResourceT IO) (Natural, Word32, Natural))
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall a b. (a -> b) -> a -> b
    $
              Int
    -> WindowBits -> ConduitT ByteString ByteString (ResourceT IO) ()
    forall (m :: * -> *).
    (PrimMonad m, MonadThrow m) =>
    Int -> WindowBits -> ConduitT ByteString ByteString m ()
    Z.compress Int
    9 (Int -> WindowBits
    Z.WindowBits (-Int
    15)) ConduitT ByteString ByteString (ResourceT IO) ()
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT ByteString Void (ResourceT IO) Natural
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void (ResourceT IO) Natural
    dataSink
    #ifdef ENABLE_BZIP2
          CompressionMethod
    BZip2 ->
            ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall {a}.
    ConduitT ByteString Void (ResourceT IO) a
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    withCompression (ConduitT ByteString Void (ResourceT IO) Natural
     -> ConduitT
          ByteString Void (ResourceT IO) (Natural, Word32, Natural))
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall a b. (a -> b) -> a -> b
    $
              ConduitT ByteString ByteString (ResourceT IO) ()
    forall (m :: * -> *).
    MonadResource m =>
    ConduitT ByteString ByteString m ()
    BZ.bzip2 ConduitT ByteString ByteString (ResourceT IO) ()
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT ByteString Void (ResourceT IO) Natural
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void (ResourceT IO) Natural
    dataSink
    #else
          BZip2 -> throwM (UnsupportedCompressionMethod BZip2)
    #endif
    #ifdef ENABLE_ZSTD
          CompressionMethod
    Zstd ->
            ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall {a}.
    ConduitT ByteString Void (ResourceT IO) a
    -> ConduitT ByteString Void (ResourceT IO) (Natural, Word32, a)
    withCompression (ConduitT ByteString Void (ResourceT IO) Natural
     -> ConduitT
          ByteString Void (ResourceT IO) (Natural, Word32, Natural))
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT
         ByteString Void (ResourceT IO) (Natural, Word32, Natural)
    forall a b. (a -> b) -> a -> b
    $
              Int -> ConduitT ByteString ByteString (ResourceT IO) ()
    forall (m :: * -> *).
    MonadIO m =>
    Int -> ConduitT ByteString ByteString m ()
    Zstandard.compress Int
    1 ConduitT ByteString ByteString (ResourceT IO) ()
    -> ConduitT ByteString Void (ResourceT IO) Natural
    -> ConduitT ByteString Void (ResourceT IO) Natural
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void (ResourceT IO) Natural
    dataSink
    #else
          Zstd -> throwM (UnsupportedCompressionMethod Zstd)
    #endif
      return
        DataDescriptor
          { ddCRC32 = fromIntegral crc32,
            ddCompressedSize = compressedSize,
            ddUncompressedSize = uncompressedSize
          }

    {- ORMOLU_ENABLE -}

    -- | 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.
    writeCD ::
      -- | Opened handle of zip archive file
      Handle ->
      -- | Commentary to the entire archive
      Maybe Text ->
      -- | Info about already written local headers and entry data
      Map EntrySelector EntryDescription ->
      IO ()
    writeCD :: Handle -> Maybe Text -> Map EntrySelector EntryDescription -> IO ()
    writeCD Handle
    h Maybe Text
    comment Map EntrySelector EntryDescription
    m = do
      let cd :: ByteString
    cd = Put -> ByteString
    runPut (Map EntrySelector EntryDescription -> Put
    putCD Map EntrySelector EntryDescription
    m)
      cdOffset <- Integer -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Natural) -> IO Integer -> IO Natural
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO Integer
    hTell Handle
    h
      B.hPut h cd -- write central directory
      let totalCount = Int -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Map EntrySelector EntryDescription -> Int
    forall k a. Map k a -> Int
    M.size Map EntrySelector EntryDescription
    m)
          cdSize = Int -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    cd)
          needZip64 =
            Natural
    totalCount Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffff
              Bool -> Bool -> Bool
    || Natural
    cdSize Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff
              Bool -> Bool -> Bool
    || Natural
    cdOffset Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff
      when needZip64 $ do
        zip64ecdOffset <- fromIntegral <$> hTell h
        (B.hPut h . runPut) (putZip64ECD totalCount cdSize cdOffset)
        (B.hPut h . runPut) (putZip64ECDLocator zip64ecdOffset)
      (B.hPut h . runPut) (putECD totalCount cdSize cdOffset comment)

    ----------------------------------------------------------------------------
    -- Binary serialization

    -- | Extract the number of bytes between the start of file name in local
    -- header and the start of actual data.
    getLocalHeaderGap :: Get Integer
    getLocalHeaderGap :: Get Integer
    getLocalHeaderGap = do
      Word32 -> Get ()
    getSignature Word32
    0x04034b50
      Int -> Get ()
    skip Int
    2 -- version needed to extract
      Int -> Get ()
    skip Int
    2 -- general purpose bit flag
      Int -> Get ()
    skip Int
    2 -- compression method
      Int -> Get ()
    skip Int
    2 -- last mod file time
      Int -> Get ()
    skip Int
    2 -- last mod file date
      Int -> Get ()
    skip Int
    4 -- crc-32 check sum
      Int -> Get ()
    skip Int
    4 -- compressed size
      Int -> Get ()
    skip Int
    4 -- uncompressed size
      fileNameSize <- Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Integer) -> Get Word16 -> Get Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word16
    getWord16le -- file name length
      extraFieldSize <- fromIntegral <$> getWord16le -- extra field length
      return (fileNameSize + extraFieldSize)

    -- | Parse central directory file headers and put them into a 'Map'.
    getCD :: Get (Map EntrySelector EntryDescription)
    getCD :: Get (Map EntrySelector EntryDescription)
    getCD = [(EntrySelector, EntryDescription)]
    -> Map EntrySelector EntryDescription
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(EntrySelector, EntryDescription)]
     -> Map EntrySelector EntryDescription)
    -> ([Maybe (EntrySelector, EntryDescription)]
        -> [(EntrySelector, EntryDescription)])
    -> [Maybe (EntrySelector, EntryDescription)]
    -> Map EntrySelector EntryDescription
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (EntrySelector, EntryDescription)]
    -> [(EntrySelector, EntryDescription)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (EntrySelector, EntryDescription)]
     -> Map EntrySelector EntryDescription)
    -> Get [Maybe (EntrySelector, EntryDescription)]
    -> Get (Map EntrySelector EntryDescription)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get (Maybe (EntrySelector, EntryDescription))
    -> Get [Maybe (EntrySelector, EntryDescription)]
    forall a. Get a -> Get [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Get (Maybe (EntrySelector, EntryDescription))
    getCDHeader

    -- | Parse a single central directory file header. If it's a directory or
    -- file compressed with unsupported compression method, 'Nothing' is
    -- returned.
    getCDHeader :: Get (Maybe (EntrySelector, EntryDescription))
    getCDHeader :: Get (Maybe (EntrySelector, EntryDescription))
    getCDHeader = do
      Word32 -> Get ()
    getSignature Word32
    0x02014b50 -- central file header signature
      versionMadeBy <- Word16 -> Version
    toVersion (Word16 -> Version) -> Get Word16 -> Get Version
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word16
    getWord16le -- version made by
      versionNeeded <- toVersion <$> getWord16le -- version needed to extract
      when (versionNeeded > zipVersion) . fail $
        "Version required to extract the archive is "
          ++ showVersion versionNeeded
          ++ " (can do "
          ++ showVersion zipVersion
          ++ ")"
      bitFlag <- getWord16le -- general purpose bit flag
      when (any (testBit bitFlag) [0, 6, 13]) . fail $
        "Encrypted archives are not supported"
      let needUnicode = Word16 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word16
    bitFlag Int
    11
      mcompression <- toCompressionMethod <$> getWord16le -- compression method
      modTime <- getWord16le -- last mod file time
      modDate <- getWord16le -- last mod file date
      crc32 <- getWord32le -- CRC32 check sum
      compressed <- fromIntegral <$> getWord32le -- compressed size
      uncompressed <- fromIntegral <$> getWord32le -- uncompressed size
      fileNameSize <- getWord16le -- file name length
      extraFieldSize <- getWord16le -- extra field length
      commentSize <- getWord16le -- file comment size
      skip 4 -- disk number start, internal file attributes
      externalFileAttrs <- getWord32le -- external file attributes
      offset <- fromIntegral <$> getWord32le -- offset of local header
      fileName <-
        decodeText needUnicode
          <$> getBytes (fromIntegral fileNameSize) -- file name
      extraField <-
        M.fromList
          <$> isolate (fromIntegral extraFieldSize) (many getExtraField)
      -- ↑ extra fields in their raw form
      comment <- decodeText needUnicode <$> getBytes (fromIntegral commentSize)
      -- ↑ file comment
      let dfltZip64 =
            Zip64ExtraField
              { z64efUncompressedSize :: Natural
    z64efUncompressedSize = Natural
    uncompressed,
                z64efCompressedSize :: Natural
    z64efCompressedSize = Natural
    compressed,
                z64efOffset :: Natural
    z64efOffset = Natural
    offset
              }
          z64ef = case Word16 -> Map Word16 ByteString -> Maybe ByteString
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Word16
    1 Map Word16 ByteString
    extraField of
            Maybe ByteString
    Nothing -> Zip64ExtraField
    dfltZip64
            Just ByteString
    b -> Zip64ExtraField -> ByteString -> Zip64ExtraField
    parseZip64ExtraField Zip64ExtraField
    dfltZip64 ByteString
    b
      case mcompression of
        Maybe CompressionMethod
    Nothing -> Maybe (EntrySelector, EntryDescription)
    -> Get (Maybe (EntrySelector, EntryDescription))
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (EntrySelector, EntryDescription)
    forall a. Maybe a
    Nothing
        Just CompressionMethod
    compression ->
          let desc :: EntryDescription
    desc =
                EntryDescription
                  { edVersionMadeBy :: Version
    edVersionMadeBy = Version
    versionMadeBy,
                    edVersionNeeded :: Version
    edVersionNeeded = Version
    versionNeeded,
                    edCompression :: CompressionMethod
    edCompression = CompressionMethod
    compression,
                    edModTime :: UTCTime
    edModTime = MsDosTime -> UTCTime
    fromMsDosTime (Word16 -> Word16 -> MsDosTime
    MsDosTime Word16
    modDate Word16
    modTime),
                    edCRC32 :: Word32
    edCRC32 = Word32
    crc32,
                    edCompressedSize :: Natural
    edCompressedSize = Zip64ExtraField -> Natural
    z64efCompressedSize Zip64ExtraField
    z64ef,
                    edUncompressedSize :: Natural
    edUncompressedSize = Zip64ExtraField -> Natural
    z64efUncompressedSize Zip64ExtraField
    z64ef,
                    edOffset :: Natural
    edOffset = Zip64ExtraField -> Natural
    z64efOffset Zip64ExtraField
    z64ef,
                    edComment :: Maybe Text
    edComment = if Word16
    commentSize Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word16
    0 then Maybe Text
    forall a. Maybe a
    Nothing else Maybe Text
    comment,
                    edExtraField :: Map Word16 ByteString
    edExtraField = Map Word16 ByteString
    extraField,
                    edExternalFileAttrs :: Word32
    edExternalFileAttrs = Word32
    externalFileAttrs
                  }
           in Maybe (EntrySelector, EntryDescription)
    -> Get (Maybe (EntrySelector, EntryDescription))
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (EntrySelector, EntryDescription)
     -> Get (Maybe (EntrySelector, EntryDescription)))
    -> Maybe (EntrySelector, EntryDescription)
    -> Get (Maybe (EntrySelector, EntryDescription))
    forall a b. (a -> b) -> a -> b
    $ (,EntryDescription
    desc) (EntrySelector -> (EntrySelector, EntryDescription))
    -> Maybe EntrySelector -> Maybe (EntrySelector, EntryDescription)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe Text
    fileName Maybe Text -> (Text -> Maybe EntrySelector) -> Maybe EntrySelector
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FilePath -> Maybe EntrySelector
    forall (m :: * -> *). MonadThrow m => FilePath -> m EntrySelector
    mkEntrySelector (FilePath -> Maybe EntrySelector)
    -> (Text -> FilePath) -> Text -> Maybe EntrySelector
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> FilePath
    T.unpack)

    -- | Parse an extra-field.
    getExtraField :: Get (Word16, ByteString)
    getExtraField :: Get (Word16, ByteString)
    getExtraField = do
      header <- Get Word16
    getWord16le -- header id
      size <- getWord16le -- data size
      body <- getBytes (fromIntegral size) -- content
      return (header, body)

    -- | Get signature. If the extracted data is not equal to the provided
    -- signature, fail.
    getSignature :: Word32 -> Get ()
    getSignature :: Word32 -> Get ()
    getSignature Word32
    sig = do
      x <- Get Word32
    getWord32le -- grab 4-byte signature
      unless (x == sig) . fail $
        "Expected signature " ++ show sig ++ ", but got: " ++ show x

    -- | Parse 'Zip64ExtraField' from its binary representation.
    parseZip64ExtraField ::
      -- | What is read from central directory file header
      Zip64ExtraField ->
      -- | Actual binary representation
      ByteString ->
      -- | Result
      Zip64ExtraField
    parseZip64ExtraField :: Zip64ExtraField -> ByteString -> Zip64ExtraField
    parseZip64ExtraField dflt :: Zip64ExtraField
    dflt@Zip64ExtraField {Natural
    z64efUncompressedSize :: Zip64ExtraField -> Natural
    z64efCompressedSize :: Zip64ExtraField -> Natural
    z64efOffset :: Zip64ExtraField -> Natural
    z64efUncompressedSize :: Natural
    z64efCompressedSize :: Natural
    z64efOffset :: Natural
    ..} ByteString
    b =
      (FilePath -> Zip64ExtraField)
    -> (Zip64ExtraField -> Zip64ExtraField)
    -> Either FilePath Zip64ExtraField
    -> Zip64ExtraField
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Zip64ExtraField -> FilePath -> Zip64ExtraField
    forall a b. a -> b -> a
    const Zip64ExtraField
    dflt) Zip64ExtraField -> Zip64ExtraField
    forall a. a -> a
    id (Either FilePath Zip64ExtraField -> Zip64ExtraField)
    -> (Get Zip64ExtraField -> Either FilePath Zip64ExtraField)
    -> Get Zip64ExtraField
    -> Zip64ExtraField
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Get Zip64ExtraField
     -> ByteString -> Either FilePath Zip64ExtraField)
    -> ByteString
    -> Get Zip64ExtraField
    -> Either FilePath Zip64ExtraField
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Get Zip64ExtraField
    -> ByteString -> Either FilePath Zip64ExtraField
    forall a. Get a -> ByteString -> Either FilePath a
    runGet ByteString
    b (Get Zip64ExtraField -> Zip64ExtraField)
    -> Get Zip64ExtraField -> Zip64ExtraField
    forall a b. (a -> b) -> a -> b
    $ do
        let ifsat :: Natural -> Get Natural
    ifsat Natural
    v =
              if Natural
    v Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff
                then Word64 -> Natural
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Natural) -> Get Word64 -> Get Natural
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word64
    getWord64le
                else Natural -> Get Natural
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Natural
    v
        uncompressed <- Natural -> Get Natural
    ifsat Natural
    z64efUncompressedSize -- uncompressed size
        compressed <- ifsat z64efCompressedSize -- compressed size
        offset <- ifsat z64efOffset -- offset of local file header
        return (Zip64ExtraField uncompressed compressed offset)

    -- | Produce binary representation of 'Zip64ExtraField'.
    makeZip64ExtraField ::
      -- | Is this for local or central directory header?
      HeaderType ->
      -- | Zip64 extra field's data
      Zip64ExtraField ->
      -- | Resulting representation
      ByteString
    makeZip64ExtraField :: HeaderType -> Zip64ExtraField -> ByteString
    makeZip64ExtraField HeaderType
    headerType Zip64ExtraField {Natural
    z64efUncompressedSize :: Zip64ExtraField -> Natural
    z64efCompressedSize :: Zip64ExtraField -> Natural
    z64efOffset :: Zip64ExtraField -> Natural
    z64efUncompressedSize :: Natural
    z64efCompressedSize :: Natural
    z64efOffset :: Natural
    ..} = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
      case HeaderType
    headerType of
        LocalHeader EntryOrigin
    _ -> do
          Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    z64efUncompressedSize) -- uncompressed size
          Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    z64efCompressedSize) -- compressed size
        HeaderType
    CentralDirHeader -> do
          Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Natural
    z64efUncompressedSize Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
            Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    z64efUncompressedSize) -- uncompressed size
          Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Natural
    z64efCompressedSize Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
            Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    z64efCompressedSize) -- compressed size
      Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Natural
    z64efOffset Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
        Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    z64efOffset) -- offset of local file header

    -- | Create 'ByteString' representing an extra field.
    putExtraField :: Map Word16 ByteString -> Put
    putExtraField :: Map Word16 ByteString -> Put
    putExtraField = (Word16 -> ByteString -> Put) -> Map Word16 ByteString -> Put
    forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
    M.foldMapWithKey ((Word16 -> ByteString -> Put) -> Map Word16 ByteString -> Put)
    -> (Word16 -> ByteString -> Put) -> Map Word16 ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ \Word16
    headerId ByteString
    bs -> do
      let b :: ByteString
    b = Int -> ByteString -> ByteString
    B.take Int
    0xffff ByteString
    bs
      Putter Word16
    putWord16le Word16
    headerId
      Putter Word16
    putWord16le (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    b)
      ByteString -> Put
    putByteString ByteString
    b

    -- | Create 'ByteString' representing the entire central directory.
    putCD :: Map EntrySelector EntryDescription -> Put
    putCD :: Map EntrySelector EntryDescription -> Put
    putCD = (EntrySelector -> EntryDescription -> Put)
    -> Map EntrySelector EntryDescription -> Put
    forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
    M.foldMapWithKey (HeaderType -> EntrySelector -> EntryDescription -> Put
    putHeader HeaderType
    CentralDirHeader)

    -- | Create 'ByteString' representing either a local file header or a
    -- central directory file header.
    putHeader ::
      -- | Type of header to generate
      HeaderType ->
      -- | Name of entry to write
      EntrySelector ->
      -- | Description of entry
      EntryDescription ->
      Put
    putHeader :: HeaderType -> EntrySelector -> EntryDescription -> Put
    putHeader HeaderType
    headerType EntrySelector
    s entry :: EntryDescription
    entry@EntryDescription {Natural
    Maybe Text
    Word32
    Version
    Map Word16 ByteString
    UTCTime
    CompressionMethod
    edExternalFileAttrs :: EntryDescription -> Word32
    edExtraField :: EntryDescription -> Map Word16 ByteString
    edComment :: EntryDescription -> Maybe Text
    edOffset :: EntryDescription -> Natural
    edUncompressedSize :: EntryDescription -> Natural
    edCompressedSize :: EntryDescription -> Natural
    edCRC32 :: EntryDescription -> Word32
    edModTime :: EntryDescription -> UTCTime
    edCompression :: EntryDescription -> CompressionMethod
    edVersionNeeded :: EntryDescription -> Version
    edVersionMadeBy :: EntryDescription -> Version
    edVersionMadeBy :: Version
    edVersionNeeded :: Version
    edCompression :: CompressionMethod
    edModTime :: UTCTime
    edCRC32 :: Word32
    edCompressedSize :: Natural
    edUncompressedSize :: Natural
    edOffset :: Natural
    edComment :: Maybe Text
    edExtraField :: Map Word16 ByteString
    edExternalFileAttrs :: Word32
    ..} = do
      let isCentralDirHeader :: Bool
    isCentralDirHeader = HeaderType
    headerType HeaderType -> HeaderType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderType
    CentralDirHeader
      Putter Word32
    putWord32le (Word32 -> Word32 -> Bool -> Word32
    forall a. a -> a -> Bool -> a
    bool Word32
    0x04034b50 Word32
    0x02014b50 Bool
    isCentralDirHeader)
      -- ↑ local/central file header signature
      Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isCentralDirHeader (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
        Putter Word16
    putWord16le (Version -> Word16
    fromVersion Version
    edVersionMadeBy) -- version made by
      Putter Word16
    putWord16le (Version -> Word16
    fromVersion Version
    edVersionNeeded) -- version needed to extract
      let entryName :: Text
    entryName = EntrySelector -> Text
    getEntryName EntrySelector
    s
          rawName :: ByteString
    rawName = Text -> ByteString
    T.encodeUtf8 Text
    entryName
          comment :: ByteString
    comment = Int -> ByteString -> ByteString
    B.take Int
    0xffff (ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    B.empty Text -> ByteString
    T.encodeUtf8 Maybe Text
    edComment)
          unicode :: Bool
    unicode =
            Text -> Bool
    needsUnicode Text
    entryName
              Bool -> Bool -> Bool
    || Bool -> (Text -> Bool) -> Maybe Text -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False Text -> Bool
    needsUnicode Maybe Text
    edComment
          modTime :: MsDosTime
    modTime = UTCTime -> MsDosTime
    toMsDosTime UTCTime
    edModTime
      Putter Word16
    putWord16le (if Bool
    unicode then Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    setBit Word16
    0 Int
    11 else Word16
    0)
      -- ↑ general purpose bit-flag
      Putter Word16
    putWord16le (CompressionMethod -> Word16
    fromCompressionMethod CompressionMethod
    edCompression) -- compression method
      Putter Word16
    putWord16le (MsDosTime -> Word16
    msDosTime MsDosTime
    modTime) -- last mod file time
      Putter Word16
    putWord16le (MsDosTime -> Word16
    msDosDate MsDosTime
    modTime) -- last mod file date
      Putter Word32
    putWord32le Word32
    edCRC32 -- CRC-32 checksum
      Putter Word32
    putWord32le (Natural -> Word32
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    edCompressedSize) -- compressed size
      Putter Word32
    putWord32le (Natural -> Word32
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    edUncompressedSize) -- uncompressed size
      Putter Word16
    putWord16le (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    rawName) -- file name length
      let zip64ef :: ByteString
    zip64ef =
            HeaderType -> Zip64ExtraField -> ByteString
    makeZip64ExtraField
              HeaderType
    headerType
              Zip64ExtraField
                { z64efUncompressedSize :: Natural
    z64efUncompressedSize = Natural
    edUncompressedSize,
                  z64efCompressedSize :: Natural
    z64efCompressedSize = Natural
    edCompressedSize,
                  z64efOffset :: Natural
    z64efOffset = Natural
    edOffset
                }
          appendZip64 :: Bool
    appendZip64 =
            case HeaderType
    headerType of
              LocalHeader (StrictOrigin Natural
    size) -> Natural
    size Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff
              LocalHeader (Borrowed EntryDescription
    ed) -> EntryDescription -> Bool
    entryUsesZip64 EntryDescription
    ed
              LocalHeader EntryOrigin
    GenericOrigin -> Bool
    True
              HeaderType
    CentralDirHeader -> EntryDescription -> Bool
    needsZip64 EntryDescription
    entry
          extraField :: ByteString
    extraField =
            Int -> ByteString -> ByteString
    B.take Int
    0xffff (ByteString -> ByteString)
    -> (Map Word16 ByteString -> ByteString)
    -> Map Word16 ByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Put -> ByteString
    runPut (Put -> ByteString)
    -> (Map Word16 ByteString -> Put)
    -> Map Word16 ByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Word16 ByteString -> Put
    putExtraField (Map Word16 ByteString -> ByteString)
    -> Map Word16 ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
              if Bool
    appendZip64
                then Word16
    -> ByteString -> Map Word16 ByteString -> Map Word16 ByteString
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Word16
    1 ByteString
    zip64ef Map Word16 ByteString
    edExtraField
                else Map Word16 ByteString
    edExtraField
      Putter Word16
    putWord16le (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    extraField) -- extra field length
      Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isCentralDirHeader (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $ do
        Putter Word16
    putWord16le (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    comment) -- file comment length
        Putter Word16
    putWord16le Word16
    0 -- disk number start
        Putter Word16
    putWord16le Word16
    0 -- internal file attributes
        Putter Word32
    putWord32le Word32
    edExternalFileAttrs -- external file attributes
        Putter Word32
    putWord32le (Natural -> Word32
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    edOffset) -- relative offset of local header
      ByteString -> Put
    putByteString ByteString
    rawName -- file name (variable size)
      ByteString -> Put
    putByteString ByteString
    extraField -- extra field (variable size)
      Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isCentralDirHeader (ByteString -> Put
    putByteString ByteString
    comment) -- file comment (variable size)

    -- | Create 'ByteString' representing Zip64 end of central directory record.
    putZip64ECD ::
      -- | Total number of entries
      Natural ->
      -- | Size of the central directory
      Natural ->
      -- | Offset of central directory record
      Natural ->
      Put
    putZip64ECD :: Natural -> Natural -> Natural -> Put
    putZip64ECD Natural
    totalCount Natural
    cdSize Natural
    cdOffset = do
      Putter Word32
    putWord32le Word32
    0x06064b50 -- zip64 end of central dir signature
      Putter Word64
    putWord64le Word64
    44 -- size of zip64 end of central dir record
      Putter Word16
    putWord16le (Version -> Word16
    fromVersion Version
    zipVersion) -- version made by
      Putter Word16
    putWord16le (Version -> Word16
    fromVersion (Version -> Word16) -> Version -> Word16
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe CompressionMethod -> Version
    getZipVersion Bool
    True Maybe CompressionMethod
    forall a. Maybe a
    Nothing)
      -- ↑ version needed to extract
      Putter Word32
    putWord32le Word32
    0 -- number of this disk
      Putter Word32
    putWord32le Word32
    0 -- number of the disk with the start of the central directory
      Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    totalCount) -- total number of entries (this disk)
      Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    totalCount) -- total number of entries
      Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    cdSize) -- size of the central directory
      Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    cdOffset) -- offset of central directory

    -- | Create 'ByteString' representing Zip64 end of the central directory
    -- locator.
    putZip64ECDLocator ::
      -- | Offset of Zip64 end of central directory
      Natural ->
      Put
    putZip64ECDLocator :: Natural -> Put
    putZip64ECDLocator Natural
    ecdOffset = do
      Putter Word32
    putWord32le Word32
    0x07064b50 -- zip64 end of central dir locator signature
      Putter Word32
    putWord32le Word32
    0 -- number of the disk with the start of the zip64 end of
      -- central directory
      Putter Word64
    putWord64le (Natural -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Natural
    ecdOffset) -- relative offset of the zip64 end
      -- of central directory record
      Putter Word32
    putWord32le Word32
    1 -- total number of disks

    -- | Parse end of the central directory record or Zip64 end of the central
    -- directory record depending on signature binary data begins with.
    getECD :: Get ArchiveDescription
    getECD :: Get ArchiveDescription
    getECD = do
      sig <- Get Word32
    getWord32le -- end of central directory signature
      let zip64 = Word32
    sig Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0x06064b50
      unless (sig == 0x06054b50 || sig == 0x06064b50) $
        fail "Cannot locate end of central directory"
      zip64size <-
        if zip64
          then do
            x <- getWord64le -- size of zip64 end of central directory record
            skip 2 -- version made by
            skip 2 -- version needed to extract
            return (Just x)
          else return Nothing
      thisDisk <- bool (fromIntegral <$> getWord16le) getWord32le zip64
      -- ↑ number of this disk
      cdDisk <- bool (fromIntegral <$> getWord16le) getWord32le zip64
      -- ↑ number of the disk with the start of the central directory
      unless (thisDisk == 0 && cdDisk == 0) $
        fail "No support for multi-disk archives"
      skip (bool 2 8 zip64)
      -- ↑ total number of entries in the central directory on this disk
      skip (bool 2 8 zip64)
      -- ↑ total number of entries in the central directory
      cdSize <- bool (fromIntegral <$> getWord32le) getWord64le zip64
      -- ↑ size of the central directory
      cdOffset <- bool (fromIntegral <$> getWord32le) getWord64le zip64
      -- ↑ offset of start of central directory with respect to the starting
      -- disk number
      when zip64 . skip . fromIntegral $ fromJust zip64size - 4 -- obviously
      commentSize <- getWord16le -- .ZIP file comment length
      comment <- decodeText True <$> getBytes (fromIntegral commentSize)
      -- ↑ archive comment, it's uncertain how we should decide on encoding here
      return
        ArchiveDescription
          { adComment = if commentSize == 0 then Nothing else comment,
            adCDOffset = fromIntegral cdOffset,
            adCDSize = fromIntegral cdSize
          }

    -- | Create a 'ByteString' representing the end of central directory record.
    putECD ::
      -- | Total number of entries
      Natural ->
      -- | Size of the central directory
      Natural ->
      -- | Offset of central directory record
      Natural ->
      -- | Zip file comment
      Maybe Text ->
      Put
    putECD :: Natural -> Natural -> Natural -> Maybe Text -> Put
    putECD Natural
    totalCount Natural
    cdSize Natural
    cdOffset Maybe Text
    mcomment = do
      Putter Word32
    putWord32le Word32
    0x06054b50 -- end of central dir signature
      Putter Word16
    putWord16le Word16
    0 -- number of this disk
      Putter Word16
    putWord16le Word16
    0 -- number of the disk with the start of the central directory
      Putter Word16
    putWord16le (Natural -> Word16
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    totalCount)
      -- ↑ total number of entries on this disk
      Putter Word16
    putWord16le (Natural -> Word16
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    totalCount) -- total number of entries
      Putter Word32
    putWord32le (Natural -> Word32
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    cdSize) -- size of central directory
      Putter Word32
    putWord32le (Natural -> Word32
    forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation Natural
    cdOffset) -- offset of start of central directory
      let comment :: ByteString
    comment = ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    B.empty Text -> ByteString
    T.encodeUtf8 Maybe Text
    mcomment
      Putter Word16
    putWord16le (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    comment)
      ByteString -> Put
    putByteString ByteString
    comment

    -- | Find the absolute offset of the end of central directory record or, if
    -- present, Zip64 end of central directory record.
    locateECD :: FilePath -> Handle -> IO (Maybe Integer)
    locateECD :: FilePath -> Handle -> IO (Maybe Integer)
    locateECD FilePath
    path Handle
    h = IO (Maybe Integer)
    sizeCheck
      where
        sizeCheck :: IO (Maybe Integer)
    sizeCheck = do
          fsize <- Handle -> IO Integer
    hFileSize Handle
    h
          let limit = Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max Integer
    0 (Integer
    fsize Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    0xffff Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    22)
          if fsize < 22
            then return Nothing
            else hSeek h SeekFromEnd (-22) >> loop limit
        loop :: Integer -> IO (Maybe Integer)
    loop Integer
    limit = do
          sig <- Get Word32 -> Int -> IO Word32
    forall {b}. Get b -> Int -> IO b
    getNum Get Word32
    getWord32le Int
    4
          pos <- subtract 4 <$> hTell h
          let again = Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Integer
    pos Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1) IO () -> IO (Maybe Integer) -> IO (Maybe Integer)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Integer -> IO (Maybe Integer)
    loop Integer
    limit
              done = Integer
    pos Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    limit
          if sig == 0x06054b50
            then do
              result <-
                runMaybeT $
                  MaybeT (checkComment pos)
                    >>= MaybeT . checkCDSig
                    >>= MaybeT . checkZip64
              case result of
                Maybe Integer
    Nothing -> IO (Maybe Integer)
    -> IO (Maybe Integer) -> Bool -> IO (Maybe Integer)
    forall a. a -> a -> Bool -> a
    bool IO (Maybe Integer)
    again (Maybe Integer -> IO (Maybe Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Integer
    forall a. Maybe a
    Nothing) Bool
    done
                Just Integer
    ecd -> Maybe Integer -> IO (Maybe Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    ecd)
            else bool again (return Nothing) done
        checkComment :: Integer -> IO (Maybe Integer)
    checkComment Integer
    pos = do
          size <- Handle -> IO Integer
    hFileSize Handle
    h
          hSeek h AbsoluteSeek (pos + 20)
          l <- fromIntegral <$> getNum getWord16le 2
          return $
            if l + 22 == size - pos
              then Just pos
              else Nothing
        checkCDSig :: Integer -> IO (Maybe Integer)
    checkCDSig Integer
    pos = do
          Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Integer
    pos Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    16)
          sigPos <- Word32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Integer) -> IO Word32 -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32 -> Int -> IO Word32
    forall {b}. Get b -> Int -> IO b
    getNum Get Word32
    getWord32le Int
    4
          if sigPos == 0xffffffff -- Zip64 is probably used
            then return (Just pos)
            else do
              hSeek h AbsoluteSeek sigPos
              cdSig <- getNum getWord32le 4
              return $
                if cdSig == 0x02014b50
                  ||
                  -- ↑ normal case: central directory file header signature
                  cdSig == 0x06064b50
                  ||
                  -- ↑ happens when zip 64 archive is empty
                  cdSig == 0x06054b50
                  then -- ↑ happens when vanilla archive is empty
                    Just pos
                  else Nothing
        checkZip64 :: Integer -> IO (Maybe Integer)
    checkZip64 Integer
    pos =
          if Integer
    pos Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    20
            then Maybe Integer -> IO (Maybe Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    pos)
            else do
              Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Integer
    pos Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    20)
              zip64locatorSig <- Get Word32 -> Int -> IO Word32
    forall {b}. Get b -> Int -> IO b
    getNum Get Word32
    getWord32le Int
    4
              if zip64locatorSig == 0x07064b50
                then do
                  hSeek h AbsoluteSeek (pos - 12)
                  Just . fromIntegral <$> getNum getWord64le 8
                else return (Just pos)
        getNum :: Get b -> Int -> IO b
    getNum Get b
    f Int
    n = do
          result <- Get b -> ByteString -> Either FilePath b
    forall a. Get a -> ByteString -> Either FilePath a
    runGet Get b
    f (ByteString -> Either FilePath b)
    -> IO ByteString -> IO (Either FilePath b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> Int -> IO ByteString
    B.hGet Handle
    h Int
    n
          case result of
            Left FilePath
    msg -> ZipException -> IO b
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (FilePath -> FilePath -> ZipException
    ParsingFailed FilePath
    path FilePath
    msg)
            Right b
    val -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    val

    ----------------------------------------------------------------------------
    -- Helpers

    -- | Rename an entry (key) in a 'Map'.
    renameKey :: (Ord k) => k -> k -> Map k a -> Map k a
    renameKey :: forall k a. Ord k => k -> k -> Map k a -> Map k a
    renameKey k
    ok k
    nk Map k a
    m = case k -> Map k a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup k
    ok Map k a
    m of
      Maybe a
    Nothing -> Map k a
    m
      Just a
    e -> k -> a -> Map k a -> Map k a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert k
    nk a
    e (k -> Map k a -> Map k a
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete k
    ok Map k a
    m)

    -- | Like 'fromIntegral', but with saturation when converting to bounded
    -- types.
    withSaturation :: forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation :: forall a b. (Integral a, Integral b, Bounded b) => a -> b
    withSaturation a
    x =
      if (a -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Integer) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > (b -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral b
    bound :: Integer)
        then b
    bound
        else a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x
      where
        bound :: b
    bound = b
    forall a. Bounded a => a
    maxBound :: b

    -- | Determine the target entry of an action.
    targetEntry :: PendingAction -> Maybe EntrySelector
    targetEntry :: PendingAction -> Maybe EntrySelector
    targetEntry (SinkEntry CompressionMethod
    _ ConduitT () ByteString (ResourceT IO) ()
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (StrictEntry CompressionMethod
    _ ByteString
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (CopyEntry FilePath
    _ EntrySelector
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (RenameEntry EntrySelector
    s EntrySelector
    _) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (DeleteEntry EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (Recompress CompressionMethod
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (SetEntryComment Text
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (DeleteEntryComment EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (SetModTime UTCTime
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (AddExtraField Word16
    _ ByteString
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (DeleteExtraField Word16
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (SetExternalFileAttributes Word32
    _ EntrySelector
    s) = EntrySelector -> Maybe EntrySelector
    forall a. a -> Maybe a
    Just EntrySelector
    s
    targetEntry (SetArchiveComment Text
    _) = Maybe EntrySelector
    forall a. Maybe a
    Nothing
    targetEntry PendingAction
    DeleteArchiveComment = Maybe EntrySelector
    forall a. Maybe a
    Nothing

    -- | 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.
    decodeText ::
      -- | Whether bit 11 of general-purpose bit flag is set
      Bool ->
      -- | Binary data to decode
      ByteString ->
      -- | Decoded 'Text' in case of success
      Maybe Text
    decodeText :: Bool -> ByteString -> Maybe Text
    decodeText Bool
    False = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text)
    -> (ByteString -> Text) -> ByteString -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    decodeCP437
    decodeText Bool
    True = (UnicodeException -> Maybe Text)
    -> (Text -> Maybe Text)
    -> Either UnicodeException Text
    -> Maybe Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe Text -> UnicodeException -> Maybe Text
    forall a b. a -> b -> a
    const Maybe Text
    forall a. Maybe a
    Nothing) Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Either UnicodeException Text -> Maybe Text)
    -> (ByteString -> Either UnicodeException Text)
    -> ByteString
    -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either UnicodeException Text
    T.decodeUtf8'

    -- | Detect if the given text needs newer Unicode-aware features to be
    -- properly encoded in the archive.
    needsUnicode :: Text -> Bool
    needsUnicode :: Text -> Bool
    needsUnicode = Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    validCP437
      where
        validCP437 :: Char -> Bool
    validCP437 Char
    x = Char -> Int
    ord Char
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    127

    -- | Convert numeric representation (as per the .ZIP specification) of
    -- version into 'Version'.
    toVersion :: Word16 -> Version
    toVersion :: Word16 -> Version
    toVersion Word16
    x = [Int] -> Version
    makeVersion [Int
    major, Int
    minor]
      where
        (Int
    major, Int
    minor) = Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    quotRem (Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word16
    x Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x00ff) Int
    10

    -- | Covert 'Version' to its numeric representation as per the .ZIP
    -- specification.
    fromVersion :: Version -> Word16
    fromVersion :: Version -> Word16
    fromVersion Version
    v = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((ZIP_OS `shiftL` 8) .|. (major Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 10 + minor))
      where
        (Int
    major, Int
    minor) =
          case Version -> [Int]
    versionBranch Version
    v of
            Int
    v0 : Int
    v1 : [Int]
    _ -> (Int
    v0, Int
    v1)
            Int
    v0 : [Int]
    _ -> (Int
    v0, Int
    0)
            [] -> (Int
    0, Int
    0)

    -- | Get the compression method form its numeric representation.
    toCompressionMethod :: Word16 -> Maybe CompressionMethod
    toCompressionMethod :: Word16 -> Maybe CompressionMethod
    toCompressionMethod Word16
    0 = CompressionMethod -> Maybe CompressionMethod
    forall a. a -> Maybe a
    Just CompressionMethod
    Store
    toCompressionMethod Word16
    8 = CompressionMethod -> Maybe CompressionMethod
    forall a. a -> Maybe a
    Just CompressionMethod
    Deflate
    toCompressionMethod Word16
    12 = CompressionMethod -> Maybe CompressionMethod
    forall a. a -> Maybe a
    Just CompressionMethod
    BZip2
    toCompressionMethod Word16
    93 = CompressionMethod -> Maybe CompressionMethod
    forall a. a -> Maybe a
    Just CompressionMethod
    Zstd
    toCompressionMethod Word16
    _ = Maybe CompressionMethod
    forall a. Maybe a
    Nothing

    -- | Convert 'CompressionMethod' to its numeric representation as per the
    -- .ZIP specification.
    fromCompressionMethod :: CompressionMethod -> Word16
    fromCompressionMethod :: CompressionMethod -> Word16
    fromCompressionMethod CompressionMethod
    Store = Word16
    0
    fromCompressionMethod CompressionMethod
    Deflate = Word16
    8
    fromCompressionMethod CompressionMethod
    BZip2 = Word16
    12
    fromCompressionMethod CompressionMethod
    Zstd = Word16
    93

    -- | Check if an entry with these parameters needs the Zip64 extension.
    needsZip64 :: EntryDescription -> Bool
    needsZip64 :: EntryDescription -> Bool
    needsZip64 EntryDescription {Natural
    Maybe Text
    Word32
    Version
    Map Word16 ByteString
    UTCTime
    CompressionMethod
    edExternalFileAttrs :: EntryDescription -> Word32
    edExtraField :: EntryDescription -> Map Word16 ByteString
    edComment :: EntryDescription -> Maybe Text
    edOffset :: EntryDescription -> Natural
    edUncompressedSize :: EntryDescription -> Natural
    edCompressedSize :: EntryDescription -> Natural
    edCRC32 :: EntryDescription -> Word32
    edModTime :: EntryDescription -> UTCTime
    edCompression :: EntryDescription -> CompressionMethod
    edVersionNeeded :: EntryDescription -> Version
    edVersionMadeBy :: EntryDescription -> Version
    edVersionMadeBy :: Version
    edVersionNeeded :: Version
    edCompression :: CompressionMethod
    edModTime :: UTCTime
    edCRC32 :: Word32
    edCompressedSize :: Natural
    edUncompressedSize :: Natural
    edOffset :: Natural
    edComment :: Maybe Text
    edExtraField :: Map Word16 ByteString
    edExternalFileAttrs :: Word32
    ..} =
      (Natural -> Bool) -> [Natural] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any
        (Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Natural
    ffffffff)
        [Natural
    edOffset, Natural
    edCompressedSize, Natural
    edUncompressedSize]

    -- | Check if an entry has Zip64 extra fields.
    entryUsesZip64 :: EntryDescription -> Bool
    entryUsesZip64 :: EntryDescription -> Bool
    entryUsesZip64 EntryDescription {Natural
    Maybe Text
    Word32
    Version
    Map Word16 ByteString
    UTCTime
    CompressionMethod
    edExternalFileAttrs :: EntryDescription -> Word32
    edExtraField :: EntryDescription -> Map Word16 ByteString
    edComment :: EntryDescription -> Maybe Text
    edOffset :: EntryDescription -> Natural
    edUncompressedSize :: EntryDescription -> Natural
    edCompressedSize :: EntryDescription -> Natural
    edCRC32 :: EntryDescription -> Word32
    edModTime :: EntryDescription -> UTCTime
    edCompression :: EntryDescription -> CompressionMethod
    edVersionNeeded :: EntryDescription -> Version
    edVersionMadeBy :: EntryDescription -> Version
    edVersionMadeBy :: Version
    edVersionNeeded :: Version
    edCompression :: CompressionMethod
    edModTime :: UTCTime
    edCRC32 :: Word32
    edCompressedSize :: Natural
    edUncompressedSize :: Natural
    edOffset :: Natural
    edComment :: Maybe Text
    edExtraField :: Map Word16 ByteString
    edExternalFileAttrs :: Word32
    ..} = Word16 -> Map Word16 ByteString -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member Word16
    1 Map Word16 ByteString
    edExtraField

    -- | Determine “version needed to extract” that should be written to the
    -- headers given the need of the Zip64 feature and the compression method.
    getZipVersion :: Bool -> Maybe CompressionMethod -> Version
    getZipVersion :: Bool -> Maybe CompressionMethod -> Version
    getZipVersion Bool
    zip64 Maybe CompressionMethod
    m = Version -> Version -> Version
    forall a. Ord a => a -> a -> a
    max Version
    zip64ver Version
    mver
      where
        zip64ver :: Version
    zip64ver = [Int] -> Version
    makeVersion (if Bool
    zip64 then [Int
    4, Int
    5] else [Int
    2, Int
    0])
        mver :: Version
    mver = [Int] -> Version
    makeVersion ([Int] -> Version) -> [Int] -> Version
    forall a b. (a -> b) -> a -> b
    $ case Maybe CompressionMethod
    m of
          Maybe CompressionMethod
    Nothing -> [Int
    2, Int
    0]
          Just CompressionMethod
    Store -> [Int
    2, Int
    0]
          Just CompressionMethod
    Deflate -> [Int
    2, Int
    0]
          Just CompressionMethod
    BZip2 -> [Int
    4, Int
    6]
          Just CompressionMethod
    Zstd -> [Int
    6, Int
    3]

    -- | Return a decompressing 'Conduit' corresponding to the given compression
    -- method.
    decompressingPipe ::
      (PrimMonad m, MonadThrow m, MonadResource m) =>
      CompressionMethod ->
      ConduitT ByteString ByteString m ()
    decompressingPipe :: forall (m :: * -> *).
    (PrimMonad m, MonadThrow m, MonadResource m) =>
    CompressionMethod -> ConduitT ByteString ByteString m ()
    decompressingPipe CompressionMethod
    Store = (ByteString -> ConduitT ByteString ByteString m ())
    -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    C.awaitForever ByteString -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    C.yield
    decompressingPipe CompressionMethod
    Deflate = WindowBits -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *).
    (PrimMonad m, MonadThrow m) =>
    WindowBits -> ConduitT ByteString ByteString m ()
    Z.decompress (WindowBits -> ConduitT ByteString ByteString m ())
    -> WindowBits -> ConduitT ByteString ByteString m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> WindowBits
    Z.WindowBits (-Int
    15)

    #ifdef ENABLE_BZIP2
    decompressingPipe CompressionMethod
    BZip2 = ConduitT ByteString ByteString m ()
    forall (m :: * -> *).
    MonadResource m =>
    ConduitT ByteString ByteString m ()
    BZ.bunzip2
    #else
    decompressingPipe BZip2 = throwM (UnsupportedCompressionMethod BZip2)
    #endif

    #ifdef ENABLE_ZSTD
    decompressingPipe CompressionMethod
    Zstd = ConduitT ByteString ByteString m ()
    forall (m :: * -> *).
    MonadIO m =>
    ConduitT ByteString ByteString m ()
    Zstandard.decompress
    #else
    decompressingPipe Zstd = throwM (UnsupportedCompressionMethod Zstd)
    #endif

    -- | A sink that calculates the CRC32 check sum for an incoming stream.
    crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32
    crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32
    crc32Sink = (Word32 -> ByteString -> Word32)
    -> Word32 -> ConduitT ByteString Void (ResourceT IO) Word32
    forall (m :: * -> *) b a o.
    Monad m =>
    (b -> a -> b) -> b -> ConduitT a o m b
    CL.fold Word32 -> ByteString -> Word32
    forall a. CRC32 a => Word32 -> a -> Word32
    crc32Update Word32
    0

    -- | Convert 'UTCTime' to the MS-DOS time format.
    toMsDosTime :: UTCTime -> MsDosTime
    toMsDosTime :: UTCTime -> MsDosTime
    toMsDosTime UTCTime {Day
    DiffTime
    utctDay :: Day
    utctDayTime :: DiffTime
    utctDayTime :: UTCTime -> DiffTime
    utctDay :: UTCTime -> Day
    ..} = Word16 -> Word16 -> MsDosTime
    MsDosTime Word16
    dosDate Word16
    dosTime
      where
        dosTime :: Word16
    dosTime = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    seconds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftL Int
    minutes Int
    5 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftL Int
    hours Int
    11)
        dosDate :: Word16
    dosDate = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    day Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftL Int
    month Int
    5 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftL Int
    year Int
    9)
        seconds :: Int
    seconds =
          let (MkFixed Integer
    x) = TimeOfDay -> Fixed E12
    todSec TimeOfDay
    tod
           in Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer
    x Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `quot` Integer
    2000000000000)
        minutes :: Int
    minutes = TimeOfDay -> Int
    todMin TimeOfDay
    tod
        hours :: Int
    hours = TimeOfDay -> Int
    todHour TimeOfDay
    tod
        tod :: TimeOfDay
    tod = DiffTime -> TimeOfDay
    timeToTimeOfDay DiffTime
    utctDayTime
        year :: Int
    year = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    year' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1980
        (Integer
    year', Int
    month, Int
    day) = Day -> (Integer, Int, Int)
    toGregorian Day
    utctDay

    -- | Convert MS-DOS date-time to 'UTCTime'.
    fromMsDosTime :: MsDosTime -> UTCTime
    fromMsDosTime :: MsDosTime -> UTCTime
    fromMsDosTime MsDosTime {Word16
    msDosDate :: MsDosTime -> Word16
    msDosTime :: MsDosTime -> Word16
    msDosDate :: Word16
    msDosTime :: Word16
    ..} =
      Day -> DiffTime -> UTCTime
    UTCTime
        (Integer -> Int -> Int -> Day
    fromGregorian Integer
    year Int
    month Int
    day)
        (Integer -> DiffTime
    secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
    forall a b. (a -> b) -> a -> b
    $ Integer
    hours Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    3600 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    minutes Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    60 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    seconds)
      where
        seconds :: Integer
    seconds = Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Integer) -> Word16 -> Integer
    forall a b. (a -> b) -> a -> b
    $ Word16
    2 Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    * (Word16
    msDosTime Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x1f)
        minutes :: Integer
    minutes = Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    shiftR Word16
    msDosTime Int
    5 Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x3f)
        hours :: Integer
    hours = Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    shiftR Word16
    msDosTime Int
    11 Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x1f)
        day :: Int
    day = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    msDosDate Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x1f)
        month :: Int
    month = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    shiftR Word16
    msDosDate Int
    5 Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0x0f
        year :: Integer
    year = Integer
    1980 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    shiftR Word16
    msDosDate Int
    9)

    -- We use the constants of the type 'Natural' instead of literals to protect
    -- ourselves from overflows on 32 bit systems.
    --
    -- If we're in the development mode, use lower values so the tests get a
    -- chance to check all cases (otherwise we would need to generate way too
    -- big archives on CI).

    ffff, ffffffff :: Natural

    #ifdef HASKELL_ZIP_DEV_MODE
    ffff     = 25
    ffffffff = 250
    #else
    ffff :: Natural
    ffff     = Natural
    0xffff
    ffffffff :: Natural
    ffffffff = Natural
    0xffffffff
    #endif

    -- | 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.
    defaultFileMode :: Word32

    #ifdef mingw32_HOST_OS
    defaultFileMode = 0

    #else
    defaultFileMode :: Word32
    defaultFileMode = CMode -> Word32
    Unix.fromFileMode CMode
    0o600
    #endif