    {-# LANGUAGE BangPatterns #-}
    -- | The files we cache from the repository
    --
    -- Both the Local and the Remote repositories make use of this module.
    module Hackage.Security.Client.Repository.Cache (
        Cache(..)
      , getCached
      , getCachedRoot
      , getCachedIndex
      , clearCache
      , withIndex
      , getIndexIdx
      , cacheRemoteFile
      , lockCache
      , lockCacheWithLogger
      ) where

    import Prelude
    import Control.Exception
    import Control.Monad
    import Control.Monad.IO.Class
    import Data.Maybe
    import Codec.Archive.Tar (Entries, pattern Done, pattern Fail, pattern Next)
    import Codec.Archive.Tar.Index (TarIndex, IndexBuilder, TarEntryOffset)
    import qualified Codec.Archive.Tar       as Tar
    import qualified Codec.Archive.Tar.Index as TarIndex
    import qualified Codec.Compression.GZip  as GZip
    import qualified Data.ByteString         as BS
    import qualified Data.ByteString.Lazy    as BS.L

    import Hackage.Security.Client.Repository
    import Hackage.Security.Client.Formats
    import Hackage.Security.TUF
    import Hackage.Security.Util.Checked
    import Hackage.Security.Util.Exit
    import Hackage.Security.Util.IO
    import Hackage.Security.Util.Path

    -- | Location and layout of the local cache
    data Cache = Cache {
          Cache -> Path Absolute
    cacheRoot   :: Path Absolute
        , Cache -> CacheLayout
    cacheLayout :: CacheLayout
        }

    -- | Cache a previously downloaded remote file
    cacheRemoteFile :: forall down typ f. DownloadedFile down
                    => Cache -> down typ -> Format f -> IsCached typ -> IO ()
    cacheRemoteFile :: forall (down :: * -> *) typ f.
    DownloadedFile down =>
    Cache -> down typ -> Format f -> IsCached typ -> IO ()
    cacheRemoteFile Cache
    cache down typ
    downloaded Format f
    f IsCached typ
    isCached = do
        Format f -> IsCached typ -> IO ()
    go Format f
    f IsCached typ
    isCached
        case IsCached typ
    isCached of
          IsCached typ
    CacheIndex -> Cache -> IO ()
    rebuildTarIndex Cache
    cache
          IsCached typ
    _otherwise -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        go :: Format f -> IsCached typ -> IO ()
        go :: Format f -> IsCached typ -> IO ()
    go Format f
    _   IsCached typ
    DontCache      = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go Format f
    FUn (CacheAs CachedFile
    file) = Path Absolute -> IO ()
    copyTo (Cache -> CachedFile -> Path Absolute
    cachedFilePath Cache
    cache CachedFile
    file)
        go Format f
    FGz IsCached typ
    CacheIndex     = Path Absolute -> IO ()
    copyTo (Cache -> Format FormatGz -> Path Absolute
    forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache
    cache Format FormatGz
    FGz) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    unzipIndex
        go Format f
    _ IsCached typ
    _ = [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "cacheRemoteFile: unexpected case" -- TODO: enforce in types?

        copyTo :: Path Absolute -> IO ()
        copyTo :: Path Absolute -> IO ()
    copyTo Path Absolute
    fp = do
          Bool -> Path Absolute -> IO ()
    forall root. FsRoot root => Bool -> Path root -> IO ()
    createDirectoryIfMissing Bool
    True (Path Absolute -> Path Absolute
    forall a. Path a -> Path a
    takeDirectory Path Absolute
    fp)
          down typ -> Path Absolute -> IO ()
    forall a. down a -> Path Absolute -> IO ()
    forall (down :: * -> *) a.
    DownloadedFile down =>
    down a -> Path Absolute -> IO ()
    downloadedCopyTo down typ
    downloaded Path Absolute
    fp

        -- Whether or not we downloaded the compressed index incrementally, we can
        -- update the uncompressed index incrementally (assuming the local files
        -- have not been corrupted).
        -- NOTE: This assumes we already updated the compressed file.
        unzipIndex :: IO ()
        unzipIndex :: IO ()
    unzipIndex = do
            Bool -> Path Absolute -> IO ()
    forall root. FsRoot root => Bool -> Path root -> IO ()
    createDirectoryIfMissing Bool
    True (Path Absolute -> Path Absolute
    forall a. Path a -> Path a
    takeDirectory Path Absolute
    indexUn)
            shouldTryIncremental <- IO Bool
    cachedIndexProbablyValid
            if shouldTryIncremental
              then do
                success <- unzipIncremental
                unless success unzipNonIncremental
              else unzipNonIncremental
          where
            unzipIncremental :: IO Bool
    unzipIncremental = do
              compressed <- Path Absolute -> IO ByteString
    forall root. FsRoot root => Path root -> IO ByteString
    readLazyByteString Path Absolute
    indexGz
              let uncompressed = ByteString -> ByteString
    GZip.decompress ByteString
    compressed

              -- compare prefix of old index with prefix of new index to
              -- ensure that it's safe to incrementally append
              (seekTo',newTail') <- withFile indexUn ReadMode $ \Handle
    h ->
                                    ExceptT (Integer, ByteString) IO (Integer, ByteString)
    -> IO (Integer, ByteString)
    forall (m :: * -> *) a. Monad m => ExceptT a m a -> m a
    multipleExitPoints (ExceptT (Integer, ByteString) IO (Integer, ByteString)
     -> IO (Integer, ByteString))
    -> ExceptT (Integer, ByteString) IO (Integer, ByteString)
    -> IO (Integer, ByteString)
    forall a b. (a -> b) -> a -> b
    $ do
                currentSize <- IO Integer -> ExceptT (Integer, ByteString) IO Integer
    forall a. IO a -> ExceptT (Integer, ByteString) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Integer -> ExceptT (Integer, ByteString) IO Integer)
    -> IO Integer -> ExceptT (Integer, ByteString) IO Integer
    forall a b. (a -> b) -> a -> b
    $ Handle -> IO Integer
    hFileSize Handle
    h
                let seekTo = Integer
    0 Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    `max` (Integer
    currentSize Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    tarTrailer)
                    (newPrefix,newTail) = BS.L.splitAt (fromInteger seekTo)
                                          uncompressed

                (oldPrefix,oldTrailer) <- BS.L.splitAt (fromInteger seekTo) <$>
                                          liftIO (BS.L.hGetContents h)

                unless (oldPrefix == newPrefix) $
                  exit (0,mempty) -- corrupted index.tar prefix

                -- sanity check: verify there's a 1KiB zero-filled trailer
                unless (oldTrailer == tarTrailerBs) $
                  exit (0,mempty) -- corrupted .tar trailer

                return (seekTo,newTail)

              if seekTo' <= 0
              then return False -- fallback to non-incremental update
              else withFile indexUn ReadWriteMode $ \Handle
    h -> do
                -- everything seems fine; append the new data
                IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek Integer
    seekTo'
                IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> ByteString -> IO ()
    BS.L.hPut Handle
    h ByteString
    newTail'
                Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

            unzipNonIncremental :: IO ()
    unzipNonIncremental = do
              compressed <- Path Absolute -> IO ByteString
    forall root. FsRoot root => Path root -> IO ByteString
    readLazyByteString Path Absolute
    indexGz
              let uncompressed = ByteString -> ByteString
    GZip.decompress ByteString
    compressed
              withFile indexUn WriteMode $ \Handle
    h ->
                Handle -> ByteString -> IO ()
    BS.L.hPut Handle
    h ByteString
    uncompressed
              void . handleDoesNotExist $
                removeFile indexIdx -- Force a full rebuild of the index too

            -- When we update the 00-index.tar we also update the 00-index.tar.idx
            -- so the expected state is that the modification time for the tar.idx
            -- is the same or later than the .tar file. But if someone modified
            -- the 00-index.tar then the modification times will be reversed. So,
            -- if the modification times are reversed then we should not do an
            -- incremental update but should rewrite the whole file.
            cachedIndexProbablyValid :: IO Bool
            cachedIndexProbablyValid :: IO Bool
    cachedIndexProbablyValid =
              (Maybe Bool -> Bool) -> IO (Maybe Bool) -> IO Bool
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False) (IO (Maybe Bool) -> IO Bool) -> IO (Maybe Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
              IO Bool -> IO (Maybe Bool)
    forall a. IO a -> IO (Maybe a)
    handleDoesNotExist (IO Bool -> IO (Maybe Bool)) -> IO Bool -> IO (Maybe Bool)
    forall a b. (a -> b) -> a -> b
    $ do
                tsUn  <- Path Absolute -> IO UTCTime
    forall root. FsRoot root => Path root -> IO UTCTime
    getModificationTime Path Absolute
    indexUn
                tsIdx <- getModificationTime indexIdx
                return (tsIdx >= tsUn)

            indexGz :: Path Absolute
    indexGz  = Cache -> Format FormatGz -> Path Absolute
    forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache
    cache Format FormatGz
    FGz
            indexUn :: Path Absolute
    indexUn  = Cache -> Format FormatUn -> Path Absolute
    forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache
    cache Format FormatUn
    FUn
            indexIdx :: Path Absolute
    indexIdx = Cache -> Path Absolute
    cachedIndexIdxPath Cache
    cache

        tarTrailer :: Integer
        tarTrailer :: Integer
    tarTrailer = Integer
    1024

        tarTrailerBs :: ByteString
    tarTrailerBs = Int64 -> Word8 -> ByteString
    BS.L.replicate (Integer -> Int64
    forall a. Num a => Integer -> a
    fromInteger Integer
    tarTrailer) Word8
    0x00

    -- | Rebuild the tarball index
    --
    -- Attempts to add to the existing index, if one exists.
    --
    -- TODO: Use throwChecked rather than throwUnchecked, and deal with the fallout.
    -- See <https://github.com/well-typed/hackage-security/issues/84>.
    rebuildTarIndex :: Cache -> IO ()
    rebuildTarIndex :: Cache -> IO ()
    rebuildTarIndex Cache
    cache = do
        (builder, offset) <- Either (Maybe IOException) TarIndex
    -> (IndexBuilder, TarEntryOffset)
    forall e. Either e TarIndex -> (IndexBuilder, TarEntryOffset)
    initBuilder (Either (Maybe IOException) TarIndex
     -> (IndexBuilder, TarEntryOffset))
    -> IO (Either (Maybe IOException) TarIndex)
    -> IO (IndexBuilder, TarEntryOffset)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path Absolute -> IO (Either (Maybe IOException) TarIndex)
    tryReadIndex (Cache -> Path Absolute
    cachedIndexIdxPath Cache
    cache)
        withFile (cachedIndexPath cache FUn) ReadMode $ \Handle
    hTar -> do
          Handle -> TarEntryOffset -> IO ()
    TarIndex.hSeekEntryOffset Handle
    hTar TarEntryOffset
    offset
          newEntries <- ByteString -> Entries FormatError
    Tar.read (ByteString -> Entries FormatError)
    -> IO ByteString -> IO (Entries FormatError)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO ByteString
    BS.L.hGetContents Handle
    hTar
          case addEntries builder newEntries of
            Left  FormatError
    ex  -> FormatError -> IO ()
    forall e a. Exception e => e -> IO a
    throwUnchecked FormatError
    ex
            Right TarIndex
    idx -> Path Absolute -> IOMode -> (Handle -> IO ()) -> IO ()
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile (Cache -> Path Absolute
    cachedIndexIdxPath Cache
    cache) IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hIdx -> do
                           Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    hIdx (Maybe Int -> BufferMode
    BlockBuffering Maybe Int
    forall a. Maybe a
    Nothing)
                           Handle -> ByteString -> IO ()
    BS.hPut Handle
    hIdx (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TarIndex -> ByteString
    TarIndex.serialise TarIndex
    idx
      where
        -- The initial index builder
        -- If we don't have an index (or it's broken), we start from scratch
        initBuilder :: Either e TarIndex -> (IndexBuilder, TarEntryOffset)
        initBuilder :: forall e. Either e TarIndex -> (IndexBuilder, TarEntryOffset)
    initBuilder (Left  e
    _)   = ( IndexBuilder
    TarIndex.empty, TarEntryOffset
    0 )
        initBuilder (Right TarIndex
    idx) = ( TarIndex -> IndexBuilder
    TarIndex.unfinalise          TarIndex
    idx
                                  , TarIndex -> TarEntryOffset
    TarIndex.indexEndEntryOffset TarIndex
    idx
                                  )

    -- | Get a cached file (if available)
    getCached :: Cache -> CachedFile -> IO (Maybe (Path Absolute))
    getCached :: Cache -> CachedFile -> IO (Maybe (Path Absolute))
    getCached Cache
    cache CachedFile
    cachedFile = do
        exists <- Path Absolute -> IO Bool
    forall root. FsRoot root => Path root -> IO Bool
    doesFileExist Path Absolute
    localPath
        if exists then return $ Just localPath
                  else return $ Nothing
      where
        localPath :: Path Absolute
    localPath = Cache -> CachedFile -> Path Absolute
    cachedFilePath Cache
    cache CachedFile
    cachedFile

    -- | Get the cached index (if available)
    getCachedIndex :: Cache -> Format f -> IO (Maybe (Path Absolute))
    getCachedIndex :: forall f. Cache -> Format f -> IO (Maybe (Path Absolute))
    getCachedIndex Cache
    cache Format f
    format = do
        exists <- Path Absolute -> IO Bool
    forall root. FsRoot root => Path root -> IO Bool
    doesFileExist Path Absolute
    localPath
        if exists then return $ Just localPath
                  else return $ Nothing
      where
        localPath :: Path Absolute
    localPath = Cache -> Format f -> Path Absolute
    forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache
    cache Format f
    format

    -- | Get the cached root
    --
    -- Calling 'getCachedRoot' without root info available is a programmer error
    -- and will result in an unchecked exception. See 'requiresBootstrap'.
    getCachedRoot :: Cache -> IO (Path Absolute)
    getCachedRoot :: Cache -> IO (Path Absolute)
    getCachedRoot Cache
    cache = do
        mPath <- Cache -> CachedFile -> IO (Maybe (Path Absolute))
    getCached Cache
    cache CachedFile
    CachedRoot
        case mPath of
          Just Path Absolute
    p  -> Path Absolute -> IO (Path Absolute)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Path Absolute
    p
          Maybe (Path Absolute)
    Nothing -> [Char] -> IO (Path Absolute)
    forall a. [Char] -> IO a
    internalError [Char]
    "Client missing root info"

    getIndexIdx :: Cache -> IO TarIndex
    getIndexIdx :: Cache -> IO TarIndex
    getIndexIdx Cache
    cache = do
        mIndex <- Path Absolute -> IO (Either (Maybe IOException) TarIndex)
    tryReadIndex (Path Absolute -> IO (Either (Maybe IOException) TarIndex))
    -> Path Absolute -> IO (Either (Maybe IOException) TarIndex)
    forall a b. (a -> b) -> a -> b
    $ Cache -> Path Absolute
    cachedIndexIdxPath Cache
    cache
        case mIndex of
          Left  Maybe IOException
    _   -> IOException -> IO TarIndex
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (IOException -> IO TarIndex) -> IOException -> IO TarIndex
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IOException
    userError [Char]
    "Could not read index. Did you call 'checkForUpdates'?"
          Right TarIndex
    idx -> TarIndex -> IO TarIndex
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TarIndex
    idx

    withIndex :: Cache -> (Handle -> IO a) -> IO a
    withIndex :: forall a. Cache -> (Handle -> IO a) -> IO a
    withIndex Cache
    cache = Path Absolute -> IOMode -> (Handle -> IO a) -> IO a
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile (Cache -> Format FormatUn -> Path Absolute
    forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache
    cache Format FormatUn
    FUn) IOMode
    ReadMode

    -- | Delete a previously downloaded remote file
    clearCache :: Cache -> IO ()
    clearCache :: Cache -> IO ()
    clearCache Cache
    cache = IO (Maybe ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe ()) -> IO ())
    -> (IO () -> IO (Maybe ())) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> IO (Maybe ())
    forall a. IO a -> IO (Maybe a)
    handleDoesNotExist (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Path Absolute -> IO ()
    forall root. FsRoot root => Path root -> IO ()
    removeFile (Path Absolute -> IO ()) -> Path Absolute -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Cache -> CachedFile -> Path Absolute
    cachedFilePath Cache
    cache CachedFile
    CachedTimestamp
        Path Absolute -> IO ()
    forall root. FsRoot root => Path root -> IO ()
    removeFile (Path Absolute -> IO ()) -> Path Absolute -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Cache -> CachedFile -> Path Absolute
    cachedFilePath Cache
    cache CachedFile
    CachedSnapshot

    -- | Lock the cache
    --
    -- This avoids two concurrent processes updating the cache at the same time,
    -- provided they both take the lock.
    lockCache :: Cache -> IO () -> IO ()
    lockCache :: Cache -> IO () -> IO ()
    lockCache Cache{Path Absolute
    CacheLayout
    cacheRoot :: Cache -> Path Absolute
    cacheLayout :: Cache -> CacheLayout
    cacheRoot :: Path Absolute
    cacheLayout :: CacheLayout
    ..} = (WithDirLockEvent -> IO ()) -> Path Absolute -> IO () -> IO ()
    forall a.
    (WithDirLockEvent -> IO ()) -> Path Absolute -> IO a -> IO a
    withDirLock (\WithDirLockEvent
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Path Absolute
    cacheRoot

    -- | Variant of 'lockCache' which emits 'LogMessage's before and after
    -- a possibly blocking file-locking system call
    --
    -- @since 0.6.0
    lockCacheWithLogger :: (LogMessage -> IO ()) -> Cache -> IO () -> IO ()
    lockCacheWithLogger :: (LogMessage -> IO ()) -> Cache -> IO () -> IO ()
    lockCacheWithLogger LogMessage -> IO ()
    logger Cache{Path Absolute
    CacheLayout
    cacheRoot :: Cache -> Path Absolute
    cacheLayout :: Cache -> CacheLayout
    cacheRoot :: Path Absolute
    cacheLayout :: CacheLayout
    ..} = (WithDirLockEvent -> IO ()) -> Path Absolute -> IO () -> IO ()
    forall a.
    (WithDirLockEvent -> IO ()) -> Path Absolute -> IO a -> IO a
    withDirLock WithDirLockEvent -> IO ()
    logger' Path Absolute
    cacheRoot
      where
        logger' :: WithDirLockEvent -> IO ()
    logger' (WithDirLockEventPre    Path Absolute
    fn) = LogMessage -> IO ()
    logger (Path Absolute -> LogMessage
    LogLockWait     Path Absolute
    fn)
        logger' (WithDirLockEventPost   Path Absolute
    fn) = LogMessage -> IO ()
    logger (Path Absolute -> LogMessage
    LogLockWaitDone Path Absolute
    fn)
        logger' (WithDirLockEventUnlock Path Absolute
    fn) = LogMessage -> IO ()
    logger (Path Absolute -> LogMessage
    LogUnlock       Path Absolute
    fn)

    {-------------------------------------------------------------------------------
      Auxiliary: tar
    -------------------------------------------------------------------------------}

    -- | Variation on 'TarIndex.build' that takes in the initial 'IndexBuilder'
    addEntries :: IndexBuilder -> Entries e -> Either e TarIndex
    addEntries :: forall e. IndexBuilder -> Entries e -> Either e TarIndex
    addEntries = IndexBuilder
    -> GenEntries TarPath LinkTarget e -> Either e TarIndex
    forall e. IndexBuilder -> Entries e -> Either e TarIndex
    go
      where
        go :: IndexBuilder
    -> GenEntries TarPath LinkTarget a -> Either a TarIndex
    go !IndexBuilder
    builder (Next GenEntry TarPath LinkTarget
    e GenEntries TarPath LinkTarget a
    es) = IndexBuilder
    -> GenEntries TarPath LinkTarget a -> Either a TarIndex
    go (GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
    TarIndex.addNextEntry GenEntry TarPath LinkTarget
    e IndexBuilder
    builder) GenEntries TarPath LinkTarget a
    es
        go !IndexBuilder
    builder  GenEntries TarPath LinkTarget a
    Done       = TarIndex -> Either a TarIndex
    forall a b. b -> Either a b
    Right (TarIndex -> Either a TarIndex) -> TarIndex -> Either a TarIndex
    forall a b. (a -> b) -> a -> b
    $! IndexBuilder -> TarIndex
    TarIndex.finalise IndexBuilder
    builder
        go !IndexBuilder
    _       (Fail a
    err)  = a -> Either a TarIndex
    forall a b. a -> Either a b
    Left a
    err

    -- TODO: How come 'deserialise' uses _strict_ ByteStrings?
    tryReadIndex :: Path Absolute -> IO (Either (Maybe IOException) TarIndex)
    tryReadIndex :: Path Absolute -> IO (Either (Maybe IOException) TarIndex)
    tryReadIndex Path Absolute
    fp =
        Either IOException (Maybe (TarIndex, ByteString))
    -> Either (Maybe IOException) TarIndex
    forall e a leftover.
    Either e (Maybe (a, leftover)) -> Either (Maybe e) a
    aux (Either IOException (Maybe (TarIndex, ByteString))
     -> Either (Maybe IOException) TarIndex)
    -> IO (Either IOException (Maybe (TarIndex, ByteString)))
    -> IO (Either (Maybe IOException) TarIndex)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe (TarIndex, ByteString))
    -> IO (Either IOException (Maybe (TarIndex, ByteString)))
    forall e a. Exception e => IO a -> IO (Either e a)
    try (ByteString -> Maybe (TarIndex, ByteString)
    TarIndex.deserialise (ByteString -> Maybe (TarIndex, ByteString))
    -> IO ByteString -> IO (Maybe (TarIndex, ByteString))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path Absolute -> IO ByteString
    forall root. FsRoot root => Path root -> IO ByteString
    readStrictByteString Path Absolute
    fp)
      where
        aux :: Either e (Maybe (a, leftover)) -> Either (Maybe e) a
        aux :: forall e a leftover.
    Either e (Maybe (a, leftover)) -> Either (Maybe e) a
    aux (Left e
    e)              = Maybe e -> Either (Maybe e) a
    forall a b. a -> Either a b
    Left (e -> Maybe e
    forall a. a -> Maybe a
    Just e
    e)
        aux (Right Maybe (a, leftover)
    Nothing)       = Maybe e -> Either (Maybe e) a
    forall a b. a -> Either a b
    Left Maybe e
    forall a. Maybe a
    Nothing
        aux (Right (Just (a
    a, leftover
    _))) = a -> Either (Maybe e) a
    forall a b. b -> Either a b
    Right a
    a

    {-------------------------------------------------------------------------------
      Auxiliary: paths
    -------------------------------------------------------------------------------}

    cachedFilePath :: Cache -> CachedFile -> Path Absolute
    cachedFilePath :: Cache -> CachedFile -> Path Absolute
    cachedFilePath Cache{cacheLayout :: Cache -> CacheLayout
    cacheLayout=CacheLayout{CachePath
    cacheLayoutRoot :: CachePath
    cacheLayoutTimestamp :: CachePath
    cacheLayoutSnapshot :: CachePath
    cacheLayoutMirrors :: CachePath
    cacheLayoutIndexTar :: CachePath
    cacheLayoutIndexIdx :: CachePath
    cacheLayoutIndexTarGz :: CachePath
    cacheLayoutIndexTarGz :: CacheLayout -> CachePath
    cacheLayoutIndexIdx :: CacheLayout -> CachePath
    cacheLayoutIndexTar :: CacheLayout -> CachePath
    cacheLayoutMirrors :: CacheLayout -> CachePath
    cacheLayoutSnapshot :: CacheLayout -> CachePath
    cacheLayoutTimestamp :: CacheLayout -> CachePath
    cacheLayoutRoot :: CacheLayout -> CachePath
    ..}, Path Absolute
    cacheRoot :: Cache -> Path Absolute
    cacheRoot :: Path Absolute
    ..} CachedFile
    file =
        Path Absolute -> CachePath -> Path Absolute
    forall root. Path root -> CachePath -> Path root
    anchorCachePath Path Absolute
    cacheRoot (CachePath -> Path Absolute) -> CachePath -> Path Absolute
    forall a b. (a -> b) -> a -> b
    $ CachedFile -> CachePath
    go CachedFile
    file
      where
        go :: CachedFile -> CachePath
        go :: CachedFile -> CachePath
    go CachedFile
    CachedRoot      = CachePath
    cacheLayoutRoot
        go CachedFile
    CachedTimestamp = CachePath
    cacheLayoutTimestamp
        go CachedFile
    CachedSnapshot  = CachePath
    cacheLayoutSnapshot
        go CachedFile
    CachedMirrors   = CachePath
    cacheLayoutMirrors

    cachedIndexPath :: Cache -> Format f -> Path Absolute
    cachedIndexPath :: forall f. Cache -> Format f -> Path Absolute
    cachedIndexPath Cache{Path Absolute
    CacheLayout
    cacheRoot :: Cache -> Path Absolute
    cacheLayout :: Cache -> CacheLayout
    cacheRoot :: Path Absolute
    cacheLayout :: CacheLayout
    ..} Format f
    format =
        Path Absolute -> CachePath -> Path Absolute
    forall root. Path root -> CachePath -> Path root
    anchorCachePath Path Absolute
    cacheRoot (CachePath -> Path Absolute) -> CachePath -> Path Absolute
    forall a b. (a -> b) -> a -> b
    $ Format f -> CachePath
    forall f. Format f -> CachePath
    go Format f
    format
      where
        go :: Format f -> CachePath
        go :: forall f. Format f -> CachePath
    go Format f
    FUn = CacheLayout -> CachePath
    cacheLayoutIndexTar   CacheLayout
    cacheLayout
        go Format f
    FGz = CacheLayout -> CachePath
    cacheLayoutIndexTarGz CacheLayout
    cacheLayout

    cachedIndexIdxPath :: Cache -> Path Absolute
    cachedIndexIdxPath :: Cache -> Path Absolute
    cachedIndexIdxPath Cache{Path Absolute
    CacheLayout
    cacheRoot :: Cache -> Path Absolute
    cacheLayout :: Cache -> CacheLayout
    cacheRoot :: Path Absolute
    cacheLayout :: CacheLayout
    ..} =
        Path Absolute -> CachePath -> Path Absolute
    forall root. Path root -> CachePath -> Path root
    anchorCachePath Path Absolute
    cacheRoot (CachePath -> Path Absolute) -> CachePath -> Path Absolute
    forall a b. (a -> b) -> a -> b
    $ CacheLayout -> CachePath
    cacheLayoutIndexIdx CacheLayout
    cacheLayout