    {-# LANGUAGE NoImplicitPrelude   #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections       #-}

    -- | Logic for loading up trees from HTTPS archives.

    module Pantry.Archive
      ( getArchivePackage
      , getArchive
      , getArchiveKey
      , fetchArchivesRaw
      , fetchArchives
      , findCabalOrHpackFile
      ) where

    import qualified Codec.Archive.Zip as Zip
    import           Conduit
    import           Data.Bits ( (.&.), shiftR )
    import qualified Data.Conduit.Tar as Tar
    import           Data.Conduit.Zlib ( ungzip )
    import qualified Data.Digest.CRC32 as CRC32
    import           Distribution.PackageDescription ( package, packageDescription )
    import qualified Hpack.Config as Hpack
    import           Pantry.HPack ( hpackVersion )
    import           Pantry.HTTP
    import           Pantry.Internal ( makeTarRelative, normalizeParents )
    import qualified Pantry.SHA256 as SHA256
    import           Pantry.Storage hiding
                       ( Tree, TreeEntry, findOrGenerateCabalFile )
    import           Pantry.Tree
    import           Pantry.Types
    import           Path ( toFilePath )
    import           RIO
    import qualified RIO.ByteString.Lazy as BL
    import qualified RIO.List as List
    import qualified RIO.Map as Map
    import           RIO.Process
    import qualified RIO.Set as Set
    import qualified RIO.Text as T
    import qualified RIO.Text.Partial as T

    fetchArchivesRaw ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(RawArchive, RawPackageMetadata)]
      -> RIO env ()
    fetchArchivesRaw :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(RawArchive, RawPackageMetadata)] -> RIO env ()
    fetchArchivesRaw [(RawArchive, RawPackageMetadata)]
    pairs =
      [(RawArchive, RawPackageMetadata)]
    -> ((RawArchive, RawPackageMetadata)
        -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [(RawArchive, RawPackageMetadata)]
    pairs (((RawArchive, RawPackageMetadata)
      -> RIO env (SHA256, FileSize, Package, CachedTree))
     -> RIO env ())
    -> ((RawArchive, RawPackageMetadata)
        -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ \(RawArchive
    ra, RawPackageMetadata
    rpm) ->
        RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    getArchive (RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
    RPLIArchive RawArchive
    ra RawPackageMetadata
    rpm) RawArchive
    ra RawPackageMetadata
    rpm

    fetchArchives ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(Archive, PackageMetadata)]
      -> RIO env ()
    fetchArchives :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Archive, PackageMetadata)] -> RIO env ()
    fetchArchives [(Archive, PackageMetadata)]
    pairs =
      -- TODO be more efficient, group together shared archives

      [(RawArchive, RawPackageMetadata)] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(RawArchive, RawPackageMetadata)] -> RIO env ()
    fetchArchivesRaw [(Archive -> RawArchive
    toRawArchive Archive
    a, PackageMetadata -> RawPackageMetadata
    toRawPM PackageMetadata
    pm) | (Archive
    a, PackageMetadata
    pm) <- [(Archive, PackageMetadata)]
    pairs]

    getArchiveKey ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable -- ^ for exceptions

      -> RawArchive
      -> RawPackageMetadata
      -> RIO env TreeKey
    getArchiveKey :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env TreeKey
    getArchiveKey RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    rpm =
      Package -> TreeKey
    packageTreeKey (Package -> TreeKey) -> RIO env Package -> RIO env TreeKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    rpm -- potential optimization

    thd4 :: (a, b, c, d) -> c
    thd4 :: forall a b c d. (a, b, c, d) -> c
    thd4 (a
    _, b
    _, c
    z, d
    _) = c
    z

    getArchivePackage ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env, HasCallStack)
      => RawPackageLocationImmutable -- ^ for exceptions

      -> RawArchive
      -> RawPackageMetadata
      -> RIO env Package
    getArchivePackage :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    rpm = (SHA256, FileSize, Package, CachedTree) -> Package
    forall a b c d. (a, b, c, d) -> c
    thd4 ((SHA256, FileSize, Package, CachedTree) -> Package)
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    -> RIO env Package
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    getArchive RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    rpm

    getArchive ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env, HasCallStack)
      => RawPackageLocationImmutable -- ^ for exceptions

      -> RawArchive
      -> RawPackageMetadata
      -> RIO env (SHA256, FileSize, Package, CachedTree)
    getArchive :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    getArchive RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    rpm = do
      -- Check if the value is in the cache, and use it if possible

      Maybe (SHA256, FileSize, Package)
    mcached <- RawPackageLocationImmutable
    -> RawArchive -> RIO env (Maybe (SHA256, FileSize, Package))
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> RIO env (Maybe (SHA256, FileSize, Package))
    loadCache RawPackageLocationImmutable
    rpli RawArchive
    archive
      -- Ensure that all of the blobs referenced exist in the cache

      -- See: https://github.com/commercialhaskell/pantry/issues/27

      Maybe CachedTree
    mtree <-
        case Maybe (SHA256, FileSize, Package)
    mcached of
          Maybe (SHA256, FileSize, Package)
    Nothing -> Maybe CachedTree -> RIO env (Maybe CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CachedTree
    forall a. Maybe a
    Nothing
          Just (SHA256
    _, FileSize
    _, Package
    pa) -> do
            Either LoadCachedTreeException CachedTree
    etree <- ReaderT
      SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    -> RIO env (Either LoadCachedTreeException CachedTree)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT
       SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
     -> RIO env (Either LoadCachedTreeException CachedTree))
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    -> RIO env (Either LoadCachedTreeException CachedTree)
    forall a b. (a -> b) -> a -> b
    $ Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    forall env.
    Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    loadCachedTree (Tree
     -> ReaderT
          SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree))
    -> Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    forall a b. (a -> b) -> a -> b
    $ Package -> Tree
    packageTree Package
    pa
            case Either LoadCachedTreeException CachedTree
    etree of
              Left LoadCachedTreeException
    e -> do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                     Utf8Builder
    "getArchive of "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawPackageLocationImmutable -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow RawPackageLocationImmutable
    rpli
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ": loadCachedTree failed: "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> LoadCachedTreeException -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow LoadCachedTreeException
    e
                Maybe CachedTree -> RIO env (Maybe CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CachedTree
    forall a. Maybe a
    Nothing
              Right CachedTree
    x -> Maybe CachedTree -> RIO env (Maybe CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe CachedTree -> RIO env (Maybe CachedTree))
    -> Maybe CachedTree -> RIO env (Maybe CachedTree)
    forall a b. (a -> b) -> a -> b
    $ CachedTree -> Maybe CachedTree
    forall a. a -> Maybe a
    Just CachedTree
    x
      cached :: (SHA256, FileSize, Package, CachedTree)
    cached@(SHA256
    _, FileSize
    _, Package
    pa, CachedTree
    _) <-
        case (Maybe (SHA256, FileSize, Package)
    mcached, Maybe CachedTree
    mtree) of
          (Just (SHA256
    a, FileSize
    b, Package
    c), Just CachedTree
    d) -> (SHA256, FileSize, Package, CachedTree)
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256
    a, FileSize
    b, Package
    c, CachedTree
    d)
          -- Not in the archive. Load the archive. Completely ignore the

          -- PackageMetadata for now, we'll check that the Package info matches

          -- next.

          (Maybe (SHA256, FileSize, Package), Maybe CachedTree)
    _ -> RawArchive
    -> (FilePath
        -> SHA256
        -> FileSize
        -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall env a.
    HasLogFunc env =>
    RawArchive
    -> (FilePath -> SHA256 -> FileSize -> RIO env a) -> RIO env a
    withArchiveLoc RawArchive
    archive ((FilePath
      -> SHA256
      -> FileSize
      -> RIO env (SHA256, FileSize, Package, CachedTree))
     -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> (FilePath
        -> SHA256
        -> FileSize
        -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    fp SHA256
    sha FileSize
    size -> do
            (Package
    pa, CachedTree
    tree) <- RawPackageLocationImmutable
    -> RawArchive -> FilePath -> RIO env (Package, CachedTree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> FilePath -> RIO env (Package, CachedTree)
    parseArchive RawPackageLocationImmutable
    rpli RawArchive
    archive FilePath
    fp
            -- Storing in the cache exclusively uses information we have about the

            -- archive itself, not metadata from the user.

            RawArchive -> SHA256 -> FileSize -> Package -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawArchive -> SHA256 -> FileSize -> Package -> RIO env ()
    storeCache RawArchive
    archive SHA256
    sha FileSize
    size Package
    pa
            (SHA256, FileSize, Package, CachedTree)
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256
    sha, FileSize
    size, Package
    pa, CachedTree
    tree)

      (PantryException
     -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> (Package -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> Either PantryException Package
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either PantryException -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (\Package
    _ -> (SHA256, FileSize, Package, CachedTree)
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256, FileSize, Package, CachedTree)
    cached) (Either PantryException Package
     -> RIO env (SHA256, FileSize, Package, CachedTree))
    -> Either PantryException Package
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> RawPackageMetadata -> Package -> Either PantryException Package
    checkPackageMetadata RawPackageLocationImmutable
    rpli RawPackageMetadata
    rpm Package
    pa

    storeCache ::
         forall env. (HasPantryConfig env, HasLogFunc env)
      => RawArchive
      -> SHA256
      -> FileSize
      -> Package
      -> RIO env ()
    storeCache :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawArchive -> SHA256 -> FileSize -> Package -> RIO env ()
    storeCache RawArchive
    archive SHA256
    sha FileSize
    size Package
    pa =
      case RawArchive -> ArchiveLocation
    raLocation RawArchive
    archive of
        ALUrl Text
    url -> ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) () -> RIO env ())
    -> ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
          Text
    -> Text
    -> SHA256
    -> FileSize
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    forall env.
    Text
    -> Text
    -> SHA256
    -> FileSize
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    storeArchiveCache Text
    url (RawArchive -> Text
    raSubdir RawArchive
    archive) SHA256
    sha FileSize
    size (Package -> TreeKey
    packageTreeKey Package
    pa)
        ALFilePath ResolvedPath File
    _ -> () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure () -- TODO cache local as well

    loadCache ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RawArchive
      -> RIO env (Maybe (SHA256, FileSize, Package))
    loadCache :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> RIO env (Maybe (SHA256, FileSize, Package))
    loadCache RawPackageLocationImmutable
    rpli RawArchive
    archive =
      case ArchiveLocation
    loc of
        ALFilePath ResolvedPath File
    _ -> Maybe (SHA256, FileSize, Package)
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (SHA256, FileSize, Package)
    forall a. Maybe a
    Nothing -- TODO can we do something intelligent here?

        ALUrl Text
    url -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeId)]
    -> RIO env [(SHA256, FileSize, TreeId)]
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (Text
    -> Text
    -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeId)]
    forall env.
    Text
    -> Text
    -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeId)]
    loadArchiveCache Text
    url (RawArchive -> Text
    raSubdir RawArchive
    archive)) RIO env [(SHA256, FileSize, TreeId)]
    -> ([(SHA256, FileSize, TreeId)]
        -> RIO env (Maybe (SHA256, FileSize, Package)))
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [(SHA256, FileSize, TreeId)]
    -> RIO env (Maybe (SHA256, FileSize, Package))
    loop
     where
      loc :: ArchiveLocation
    loc = RawArchive -> ArchiveLocation
    raLocation RawArchive
    archive
      msha :: Maybe SHA256
    msha = RawArchive -> Maybe SHA256
    raHash RawArchive
    archive
      msize :: Maybe FileSize
    msize = RawArchive -> Maybe FileSize
    raSize RawArchive
    archive

      loadFromCache :: TreeId -> RIO env (Maybe Package)
      loadFromCache :: TreeId -> RIO env (Maybe Package)
    loadFromCache TreeId
    tid = (Package -> Maybe Package)
    -> RIO env Package -> RIO env (Maybe Package)
    forall a b. (a -> b) -> RIO env a -> RIO env b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Package -> Maybe Package
    forall a. a -> Maybe a
    Just (RIO env Package -> RIO env (Maybe Package))
    -> RIO env Package -> RIO env (Maybe Package)
    forall a b. (a -> b) -> a -> b
    $ ReaderT SqlBackend (RIO env) Package -> RIO env Package
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) Package -> RIO env Package)
    -> ReaderT SqlBackend (RIO env) Package -> RIO env Package
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    loadPackageById RawPackageLocationImmutable
    rpli TreeId
    tid

      loop :: [(SHA256, FileSize, TreeId)]
    -> RIO env (Maybe (SHA256, FileSize, Package))
    loop [] = Maybe (SHA256, FileSize, Package)
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (SHA256, FileSize, Package)
    forall a. Maybe a
    Nothing
      loop ((SHA256
    sha, FileSize
    size, TreeId
    tid):[(SHA256, FileSize, TreeId)]
    rest) =
        case Maybe SHA256
    msha of
          Maybe SHA256
    Nothing -> do
            case Maybe FileSize
    msize of
              Just FileSize
    size' | FileSize
    size FileSize -> FileSize -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FileSize
    size' -> [(SHA256, FileSize, TreeId)]
    -> RIO env (Maybe (SHA256, FileSize, Package))
    loop [(SHA256, FileSize, TreeId)]
    rest
              Maybe FileSize
    _ -> do
                case ArchiveLocation
    loc of
                  ALUrl Text
    url -> do
                    -- Only debug level, let lock files solve this

                    Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                         Utf8Builder
    "Using archive from "
                      Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url
                      Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " without a specified cryptographic hash"
                    Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                         Utf8Builder
    "Cached hash is "
                      Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SHA256 -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SHA256
    sha
                      Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ", file size "
                      Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FileSize -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display FileSize
    size
                  ALFilePath ResolvedPath File
    _ -> () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                (Package -> (SHA256, FileSize, Package))
    -> Maybe Package -> Maybe (SHA256, FileSize, Package)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (SHA256
    sha, FileSize
    size,) (Maybe Package -> Maybe (SHA256, FileSize, Package))
    -> RIO env (Maybe Package)
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TreeId -> RIO env (Maybe Package)
    loadFromCache TreeId
    tid
          Just SHA256
    sha'
            | SHA256
    sha SHA256 -> SHA256 -> Bool
    forall a. Eq a => a -> a -> Bool
    == SHA256
    sha' ->
                case Maybe FileSize
    msize of
                  Maybe FileSize
    Nothing -> do
                    case ArchiveLocation
    loc of
                      -- Only debug level, let lock files solve this

                      ALUrl Text
    url -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                           Utf8Builder
    "Archive from "
                        Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url
                        Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " does not specify a size"
                      ALFilePath ResolvedPath File
    _ -> () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                    (Package -> (SHA256, FileSize, Package))
    -> Maybe Package -> Maybe (SHA256, FileSize, Package)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (SHA256
    sha, FileSize
    size,) (Maybe Package -> Maybe (SHA256, FileSize, Package))
    -> RIO env (Maybe Package)
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TreeId -> RIO env (Maybe Package)
    loadFromCache TreeId
    tid
                  Just FileSize
    size'
                    | FileSize
    size FileSize -> FileSize -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileSize
    size' -> (Package -> (SHA256, FileSize, Package))
    -> Maybe Package -> Maybe (SHA256, FileSize, Package)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (SHA256
    sha, FileSize
    size,) (Maybe Package -> Maybe (SHA256, FileSize, Package))
    -> RIO env (Maybe Package)
    -> RIO env (Maybe (SHA256, FileSize, Package))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TreeId -> RIO env (Maybe Package)
    loadFromCache TreeId
    tid
                    | Bool
    otherwise -> do
                        -- This is an actual warning, since we have a concrete

                        -- mismatch

                        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                             Utf8Builder
    "Archive from "
                          Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> ArchiveLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display ArchiveLocation
    loc
                          Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " has a matching hash but mismatched size"
                        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn Utf8Builder
    "Please verify that your configuration provides \
                                \the correct size"
                        [(SHA256, FileSize, TreeId)]
    -> RIO env (Maybe (SHA256, FileSize, Package))
    loop [(SHA256, FileSize, TreeId)]
    rest
            | Bool
    otherwise -> [(SHA256, FileSize, TreeId)]
    -> RIO env (Maybe (SHA256, FileSize, Package))
    loop [(SHA256, FileSize, TreeId)]
    rest

    -- ensure name, version, etc are correct

    checkPackageMetadata ::
         RawPackageLocationImmutable
      -> RawPackageMetadata
      -> Package
      -> Either PantryException Package
    checkPackageMetadata :: RawPackageLocationImmutable
    -> RawPackageMetadata -> Package -> Either PantryException Package
    checkPackageMetadata RawPackageLocationImmutable
    pl RawPackageMetadata
    pm Package
    pa = do
      let
          err :: PantryException
    err = RawPackageLocationImmutable
    -> RawPackageMetadata
    -> Maybe TreeKey
    -> PackageIdentifier
    -> PantryException
    MismatchedPackageMetadata
                  RawPackageLocationImmutable
    pl
                  RawPackageMetadata
    pm
                  (TreeKey -> Maybe TreeKey
    forall a. a -> Maybe a
    Just (Package -> TreeKey
    packageTreeKey Package
    pa))
                  (Package -> PackageIdentifier
    packageIdent Package
    pa)

          test :: Eq a => Maybe a -> a -> Bool
          test :: forall a. Eq a => Maybe a -> a -> Bool
    test (Just a
    x) a
    y = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y
          test Maybe a
    Nothing a
    _ = Bool
    True

          tests :: [Bool]
    tests =
            [ Maybe TreeKey -> TreeKey -> Bool
    forall a. Eq a => Maybe a -> a -> Bool
    test (RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    pm) (Package -> TreeKey
    packageTreeKey Package
    pa)
            , Maybe PackageName -> PackageName -> Bool
    forall a. Eq a => Maybe a -> a -> Bool
    test (RawPackageMetadata -> Maybe PackageName
    rpmName RawPackageMetadata
    pm) (PackageIdentifier -> PackageName
    pkgName (PackageIdentifier -> PackageName)
    -> PackageIdentifier -> PackageName
    forall a b. (a -> b) -> a -> b
    $ Package -> PackageIdentifier
    packageIdent Package
    pa)
            , Maybe Version -> Version -> Bool
    forall a. Eq a => Maybe a -> a -> Bool
    test (RawPackageMetadata -> Maybe Version
    rpmVersion RawPackageMetadata
    pm) (PackageIdentifier -> Version
    pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
    forall a b. (a -> b) -> a -> b
    $ Package -> PackageIdentifier
    packageIdent Package
    pa)
            ]

       in if [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [Bool]
    tests then Package -> Either PantryException Package
    forall a b. b -> Either a b
    Right Package
    pa else PantryException -> Either PantryException Package
    forall a b. a -> Either a b
    Left PantryException
    err

    -- | Provide a local file with the contents of the archive, regardless of where

    -- it comes from. Perform SHA256 and file size validation if downloading.

    withArchiveLoc ::
         HasLogFunc env
      => RawArchive
      -> (FilePath -> SHA256 -> FileSize -> RIO env a)
      -> RIO env a
    withArchiveLoc :: forall env a.
    HasLogFunc env =>
    RawArchive
    -> (FilePath -> SHA256 -> FileSize -> RIO env a) -> RIO env a
    withArchiveLoc (RawArchive (ALFilePath ResolvedPath File
    resolved) Maybe SHA256
    msha Maybe FileSize
    msize Text
    _subdir) FilePath -> SHA256 -> FileSize -> RIO env a
    f = do
      let abs' :: Path Abs File
    abs' = ResolvedPath File -> Path Abs File
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath File
    resolved
          fp :: FilePath
    fp = Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    abs'
      (SHA256
    sha, FileSize
    size) <- FilePath
    -> IOMode
    -> (Handle -> RIO env (SHA256, FileSize))
    -> RIO env (SHA256, FileSize)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> IOMode -> (Handle -> m a) -> m a
    withBinaryFile FilePath
    fp IOMode
    ReadMode ((Handle -> RIO env (SHA256, FileSize))
     -> RIO env (SHA256, FileSize))
    -> (Handle -> RIO env (SHA256, FileSize))
    -> RIO env (SHA256, FileSize)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        FileSize
    size <- Word -> FileSize
    FileSize (Word -> FileSize) -> (Integer -> Word) -> Integer -> FileSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> FileSize) -> RIO env Integer -> RIO env FileSize
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> RIO env Integer
    forall (m :: * -> *). MonadIO m => Handle -> m Integer
    hFileSize Handle
    h
        Maybe FileSize -> (FileSize -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe FileSize
    msize ((FileSize -> RIO env ()) -> RIO env ())
    -> (FileSize -> RIO env ()) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ \FileSize
    size' ->
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (FileSize
    size FileSize -> FileSize -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FileSize
    size') (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
            PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> Mismatch FileSize -> PantryException
    LocalInvalidSize Path Abs File
    abs' Mismatch
              { mismatchExpected :: FileSize
    mismatchExpected = FileSize
    size'
              , mismatchActual :: FileSize
    mismatchActual = FileSize
    size
              }

        SHA256
    sha <- ConduitT () Void (RIO env) SHA256 -> RIO env SHA256
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (Handle -> ConduitT () ByteString (RIO env) ()
    forall (m :: * -> *) i.
    MonadIO m =>
    Handle -> ConduitT i ByteString m ()
    sourceHandle Handle
    h ConduitT () ByteString (RIO env) ()
    -> ConduitT ByteString Void (RIO env) SHA256
    -> ConduitT () Void (RIO env) SHA256
    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 (RIO env) SHA256
    forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
    SHA256.sinkHash)
        Maybe SHA256 -> (SHA256 -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe SHA256
    msha ((SHA256 -> RIO env ()) -> RIO env ())
    -> (SHA256 -> RIO env ()) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ \SHA256
    sha' ->
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SHA256
    sha SHA256 -> SHA256 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SHA256
    sha') (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
            PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> Mismatch SHA256 -> PantryException
    LocalInvalidSHA256 Path Abs File
    abs' Mismatch
              { mismatchExpected :: SHA256
    mismatchExpected = SHA256
    sha'
              , mismatchActual :: SHA256
    mismatchActual = SHA256
    sha
              }

        (SHA256, FileSize) -> RIO env (SHA256, FileSize)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256
    sha, FileSize
    size)
      FilePath -> SHA256 -> FileSize -> RIO env a
    f FilePath
    fp SHA256
    sha FileSize
    size
    withArchiveLoc (RawArchive (ALUrl Text
    url) Maybe SHA256
    msha Maybe FileSize
    msize Text
    _subdir) FilePath -> SHA256 -> FileSize -> RIO env a
    f =
      FilePath -> (FilePath -> Handle -> RIO env a) -> RIO env a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> (FilePath -> Handle -> m a) -> m a
    withSystemTempFile FilePath
    "archive" ((FilePath -> Handle -> RIO env a) -> RIO env a)
    -> (FilePath -> Handle -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    fp Handle
    hout -> do
        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder
    "Downloading archive from " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url
        (SHA256
    sha, FileSize
    size, ()) <- Text
    -> Maybe SHA256
    -> Maybe FileSize
    -> ConduitT ByteString Void (RIO env) ()
    -> RIO env (SHA256, FileSize, ())
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Text
    -> Maybe SHA256
    -> Maybe FileSize
    -> ConduitT ByteString Void m a
    -> m (SHA256, FileSize, a)
    httpSinkChecked Text
    url Maybe SHA256
    msha Maybe FileSize
    msize (Handle -> ConduitT ByteString Void (RIO env) ()
    forall (m :: * -> *) o.
    MonadIO m =>
    Handle -> ConduitT ByteString o m ()
    sinkHandle Handle
    hout)
        Handle -> RIO env ()
    forall (m :: * -> *). MonadIO m => Handle -> m ()
    hClose Handle
    hout
        FilePath -> SHA256 -> FileSize -> RIO env a
    f FilePath
    fp SHA256
    sha FileSize
    size

    data ArchiveType = ATTarGz | ATTar | ATZip
      deriving (Int -> ArchiveType
    ArchiveType -> Int
    ArchiveType -> [ArchiveType]
    ArchiveType -> ArchiveType
    ArchiveType -> ArchiveType -> [ArchiveType]
    ArchiveType -> ArchiveType -> ArchiveType -> [ArchiveType]
    (ArchiveType -> ArchiveType)
    -> (ArchiveType -> ArchiveType)
    -> (Int -> ArchiveType)
    -> (ArchiveType -> Int)
    -> (ArchiveType -> [ArchiveType])
    -> (ArchiveType -> ArchiveType -> [ArchiveType])
    -> (ArchiveType -> ArchiveType -> [ArchiveType])
    -> (ArchiveType -> ArchiveType -> ArchiveType -> [ArchiveType])
    -> Enum ArchiveType
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: ArchiveType -> ArchiveType
    succ :: ArchiveType -> ArchiveType
    $cpred :: ArchiveType -> ArchiveType
    pred :: ArchiveType -> ArchiveType
    $ctoEnum :: Int -> ArchiveType
    toEnum :: Int -> ArchiveType
    $cfromEnum :: ArchiveType -> Int
    fromEnum :: ArchiveType -> Int
    $cenumFrom :: ArchiveType -> [ArchiveType]
    enumFrom :: ArchiveType -> [ArchiveType]
    $cenumFromThen :: ArchiveType -> ArchiveType -> [ArchiveType]
    enumFromThen :: ArchiveType -> ArchiveType -> [ArchiveType]
    $cenumFromTo :: ArchiveType -> ArchiveType -> [ArchiveType]
    enumFromTo :: ArchiveType -> ArchiveType -> [ArchiveType]
    $cenumFromThenTo :: ArchiveType -> ArchiveType -> ArchiveType -> [ArchiveType]
    enumFromThenTo :: ArchiveType -> ArchiveType -> ArchiveType -> [ArchiveType]
    Enum, ArchiveType
    ArchiveType -> ArchiveType -> Bounded ArchiveType
    forall a. a -> a -> Bounded a
    $cminBound :: ArchiveType
    minBound :: ArchiveType
    $cmaxBound :: ArchiveType
    maxBound :: ArchiveType
    Bounded)

    instance Display ArchiveType where
      display :: ArchiveType -> Utf8Builder
    display ArchiveType
    ATTarGz = Utf8Builder
    "GZIP-ed tar file"
      display ArchiveType
    ATTar = Utf8Builder
    "Uncompressed tar file"
      display ArchiveType
    ATZip = Utf8Builder
    "Zip file"

    data METype
      = METNormal
      | METExecutable
      | METLink !FilePath
      deriving Int -> METype -> ShowS
    [METype] -> ShowS
    METype -> FilePath
    (Int -> METype -> ShowS)
    -> (METype -> FilePath) -> ([METype] -> ShowS) -> Show METype
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> METype -> ShowS
    showsPrec :: Int -> METype -> ShowS
    $cshow :: METype -> FilePath
    show :: METype -> FilePath
    $cshowList :: [METype] -> ShowS
    showList :: [METype] -> ShowS
    Show

    data MetaEntry = MetaEntry
      { MetaEntry -> FilePath
    mePath :: !FilePath
      , MetaEntry -> METype
    meType :: !METype
      }
      deriving Int -> MetaEntry -> ShowS
    [MetaEntry] -> ShowS
    MetaEntry -> FilePath
    (Int -> MetaEntry -> ShowS)
    -> (MetaEntry -> FilePath)
    -> ([MetaEntry] -> ShowS)
    -> Show MetaEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> MetaEntry -> ShowS
    showsPrec :: Int -> MetaEntry -> ShowS
    $cshow :: MetaEntry -> FilePath
    show :: MetaEntry -> FilePath
    $cshowList :: [MetaEntry] -> ShowS
    showList :: [MetaEntry] -> ShowS
    Show

    foldArchive ::
         (HasPantryConfig env, HasLogFunc env)
      => ArchiveLocation -- ^ for error reporting

      -> FilePath
      -> ArchiveType
      -> a
      -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
      -> RIO env a
    foldArchive :: forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> FilePath
    -> ArchiveType
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
    -> RIO env a
    foldArchive ArchiveLocation
    loc FilePath
    fp ArchiveType
    ATTarGz a
    accum a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f =
      FilePath
    -> (ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a
    forall (m :: * -> *) (n :: * -> *) i a.
    (MonadUnliftIO m, MonadIO n) =>
    FilePath -> (ConduitM i ByteString n () -> m a) -> m a
    withSourceFile FilePath
    fp ((ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a)
    -> (ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \ConduitM () ByteString (RIO env) ()
    src -> ConduitT () Void (RIO env) a -> RIO env a
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (RIO env) a -> RIO env a)
    -> ConduitT () Void (RIO env) a -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ ConduitM () ByteString (RIO env) ()
    src ConduitM () ByteString (RIO env) ()
    -> ConduitT ByteString Void (RIO env) a
    -> ConduitT () Void (RIO env) a
    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 (RIO env) ()
    forall (m :: * -> *).
    (PrimMonad m, MonadThrow m) =>
    ConduitT ByteString ByteString m ()
    ungzip ConduitT ByteString ByteString (RIO env) ()
    -> ConduitT ByteString Void (RIO env) a
    -> ConduitT ByteString Void (RIO env) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ArchiveLocation
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
    -> ConduitT ByteString Void (RIO env) a
    forall env a o.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString o (RIO env) a)
    -> ConduitT ByteString o (RIO env) a
    foldTar ArchiveLocation
    loc a
    accum a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f
    foldArchive ArchiveLocation
    loc FilePath
    fp ArchiveType
    ATTar a
    accum a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f =
      FilePath
    -> (ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a
    forall (m :: * -> *) (n :: * -> *) i a.
    (MonadUnliftIO m, MonadIO n) =>
    FilePath -> (ConduitM i ByteString n () -> m a) -> m a
    withSourceFile FilePath
    fp ((ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a)
    -> (ConduitM () ByteString (RIO env) () -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \ConduitM () ByteString (RIO env) ()
    src -> ConduitT () Void (RIO env) a -> RIO env a
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (RIO env) a -> RIO env a)
    -> ConduitT () Void (RIO env) a -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ ConduitM () ByteString (RIO env) ()
    src ConduitM () ByteString (RIO env) ()
    -> ConduitT ByteString Void (RIO env) a
    -> ConduitT () Void (RIO env) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ArchiveLocation
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
    -> ConduitT ByteString Void (RIO env) a
    forall env a o.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString o (RIO env) a)
    -> ConduitT ByteString o (RIO env) a
    foldTar ArchiveLocation
    loc a
    accum a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f
    foldArchive ArchiveLocation
    loc FilePath
    fp ArchiveType
    ATZip a
    accum0 a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f = FilePath -> IOMode -> (Handle -> RIO env a) -> RIO env a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> IOMode -> (Handle -> m a) -> m a
    withBinaryFile FilePath
    fp IOMode
    ReadMode ((Handle -> RIO env a) -> RIO env a)
    -> (Handle -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
      let go :: a -> Entry -> RIO env a
    go a
    accum Entry
    entry = do
            let me :: MetaEntry
    me = FilePath -> METype -> MetaEntry
    MetaEntry (Entry -> FilePath
    Zip.eRelativePath Entry
    entry) METype
    met
                met :: METype
    met = METype -> Maybe METype -> METype
    forall a. a -> Maybe a -> a
    fromMaybe METype
    METNormal (Maybe METype -> METype) -> Maybe METype -> METype
    forall a b. (a -> b) -> a -> b
    $ do
                  let modes :: Word32
    modes = Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftR (Entry -> Word32
    Zip.eExternalFileAttributes Entry
    entry) Int
    16
                  Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Entry -> Word16
    Zip.eVersionMadeBy Entry
    entry Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0xFF00 Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word16
    0x0300
                  Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Word32
    modes Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    0
                  METype -> Maybe METype
    forall a. a -> Maybe a
    Just (METype -> Maybe METype) -> METype -> Maybe METype
    forall a b. (a -> b) -> a -> b
    $
                    if (Word32
    modes Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0o100) Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0
                      then METype
    METNormal
                      else METype
    METExecutable
                lbs :: ByteString
    lbs = Entry -> ByteString
    Zip.fromEntry Entry
    entry
            let crcExpected :: Word32
    crcExpected = Entry -> Word32
    Zip.eCRC32 Entry
    entry
                crcActual :: Word32
    crcActual = ByteString -> Word32
    forall a. CRC32 a => a -> Word32
    CRC32.crc32 ByteString
    lbs
            Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word32
    crcExpected Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    crcActual)
              (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ ArchiveLocation -> FilePath -> Mismatch Word32 -> PantryException
    CRC32Mismatch ArchiveLocation
    loc (Entry -> FilePath
    Zip.eRelativePath Entry
    entry) Mismatch
                  { mismatchExpected :: Word32
    mismatchExpected = Word32
    crcExpected
                  , mismatchActual :: Word32
    mismatchActual = Word32
    crcActual
                  }
            ConduitT () Void (RIO env) a -> RIO env a
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (RIO env) a -> RIO env a)
    -> ConduitT () Void (RIO env) a -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ConduitM () ByteString (RIO env) ()
    forall (m :: * -> *) lazy strict i.
    (Monad m, LazySequence lazy strict) =>
    lazy -> ConduitT i strict m ()
    sourceLazy ByteString
    lbs ConduitM () ByteString (RIO env) ()
    -> ConduitT ByteString Void (RIO env) a
    -> ConduitT () Void (RIO env) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| a -> MetaEntry -> ConduitT ByteString Void (RIO env) a
    f a
    accum MetaEntry
    me
          isDir :: Entry -> Bool
    isDir Entry
    entry =
            case ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Entry -> FilePath
    Zip.eRelativePath Entry
    entry of
              Char
    '/':FilePath
    _ -> Bool
    True
              FilePath
    _ -> Bool
    False
      -- We're entering lazy I/O land thanks to zip-archive.

      ByteString
    lbs <- Handle -> RIO env ByteString
    forall (m :: * -> *). MonadIO m => Handle -> m ByteString
    BL.hGetContents Handle
    h
      (a -> Entry -> RIO env a) -> a -> [Entry] -> RIO env a
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM a -> Entry -> RIO env a
    go a
    accum0 ((Entry -> Bool) -> [Entry] -> [Entry]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Entry -> Bool) -> Entry -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entry -> Bool
    isDir) ([Entry] -> [Entry]) -> [Entry] -> [Entry]
    forall a b. (a -> b) -> a -> b
    $ Archive -> [Entry]
    Zip.zEntries (Archive -> [Entry]) -> Archive -> [Entry]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Archive
    Zip.toArchive ByteString
    lbs)

    foldTar ::
         (HasPantryConfig env, HasLogFunc env)
      => ArchiveLocation -- ^ for exceptions

      -> a
      -> (a -> MetaEntry -> ConduitT ByteString o (RIO env) a)
      -> ConduitT ByteString o (RIO env) a
    foldTar :: forall env a o.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString o (RIO env) a)
    -> ConduitT ByteString o (RIO env) a
    foldTar ArchiveLocation
    loc a
    accum0 a -> MetaEntry -> ConduitT ByteString o (RIO env) a
    f = do
      IORef a
    ref <- a -> ConduitT ByteString o (RIO env) (IORef a)
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef a
    accum0
      (FileInfo -> ConduitM ByteString o (RIO env) ())
    -> ConduitM ByteString o (RIO env) ()
    forall (m :: * -> *) o.
    MonadThrow m =>
    (FileInfo -> ConduitM ByteString o m ())
    -> ConduitM ByteString o m ()
    Tar.untar ((FileInfo -> ConduitM ByteString o (RIO env) ())
     -> ConduitM ByteString o (RIO env) ())
    -> (FileInfo -> ConduitM ByteString o (RIO env) ())
    -> ConduitM ByteString o (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ FileInfo -> ConduitT ByteString o (RIO env) (Maybe MetaEntry)
    forall (m :: * -> *). MonadIO m => FileInfo -> m (Maybe MetaEntry)
    toME (FileInfo -> ConduitT ByteString o (RIO env) (Maybe MetaEntry))
    -> (Maybe MetaEntry -> ConduitM ByteString o (RIO env) ())
    -> FileInfo
    -> ConduitM ByteString o (RIO env) ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (MetaEntry -> ConduitM ByteString o (RIO env) ())
    -> Maybe MetaEntry -> ConduitM ByteString o (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (\MetaEntry
    me -> do
        a
    accum <- IORef a -> ConduitT ByteString o (RIO env) a
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef a
    ref
        a
    accum' <- a -> MetaEntry -> ConduitT ByteString o (RIO env) a
    f a
    accum MetaEntry
    me
        IORef a -> a -> ConduitM ByteString o (RIO env) ()
    forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
    writeIORef IORef a
    ref (a -> ConduitM ByteString o (RIO env) ())
    -> a -> ConduitM ByteString o (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $! a
    accum')
      IORef a -> ConduitT ByteString o (RIO env) a
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef a
    ref
     where
      toME :: MonadIO m => Tar.FileInfo -> m (Maybe MetaEntry)
      toME :: forall (m :: * -> *). MonadIO m => FileInfo -> m (Maybe MetaEntry)
    toME FileInfo
    fi = do
        let exc :: PantryException
    exc = ArchiveLocation -> FilePath -> FileType -> PantryException
    InvalidTarFileType ArchiveLocation
    loc (FileInfo -> FilePath
    Tar.getFileInfoPath FileInfo
    fi) (FileInfo -> FileType
    Tar.fileType FileInfo
    fi)
        Maybe METype
    mmet <-
          case FileInfo -> FileType
    Tar.fileType FileInfo
    fi of
            Tar.FTSymbolicLink ByteString
    bs ->
              case ByteString -> Either UnicodeException Text
    decodeUtf8' ByteString
    bs of
                Left UnicodeException
    _ -> PantryException -> m (Maybe METype)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc
                Right Text
    text -> Maybe METype -> m (Maybe METype)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe METype -> m (Maybe METype))
    -> Maybe METype -> m (Maybe METype)
    forall a b. (a -> b) -> a -> b
    $ METype -> Maybe METype
    forall a. a -> Maybe a
    Just (METype -> Maybe METype) -> METype -> Maybe METype
    forall a b. (a -> b) -> a -> b
    $ FilePath -> METype
    METLink (FilePath -> METype) -> FilePath -> METype
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    text
            FileType
    Tar.FTNormal -> Maybe METype -> m (Maybe METype)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe METype -> m (Maybe METype))
    -> Maybe METype -> m (Maybe METype)
    forall a b. (a -> b) -> a -> b
    $ METype -> Maybe METype
    forall a. a -> Maybe a
    Just (METype -> Maybe METype) -> METype -> Maybe METype
    forall a b. (a -> b) -> a -> b
    $
              if FileInfo -> FileMode
    Tar.fileMode FileInfo
    fi FileMode -> FileMode -> FileMode
    forall a. Bits a => a -> a -> a
    .&. FileMode
    0o100 FileMode -> FileMode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FileMode
    0
                then METype
    METExecutable
                else METype
    METNormal
            FileType
    Tar.FTDirectory -> Maybe METype -> m (Maybe METype)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe METype
    forall a. Maybe a
    Nothing
            FileType
    _ -> PantryException -> m (Maybe METype)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc
        Maybe MetaEntry -> m (Maybe MetaEntry)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe MetaEntry -> m (Maybe MetaEntry))
    -> Maybe MetaEntry -> m (Maybe MetaEntry)
    forall a b. (a -> b) -> a -> b
    $
          (\METype
    met -> MetaEntry
            { mePath :: FilePath
    mePath = FileInfo -> FilePath
    Tar.getFileInfoPath FileInfo
    fi
            , meType :: METype
    meType = METype
    met
            })
          (METype -> MetaEntry) -> Maybe METype -> Maybe MetaEntry
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe METype
    mmet

    data SimpleEntry = SimpleEntry
      { SimpleEntry -> FilePath
    seSource :: !FilePath
      , SimpleEntry -> FileType
    seType :: !FileType
      }
      deriving Int -> SimpleEntry -> ShowS
    [SimpleEntry] -> ShowS
    SimpleEntry -> FilePath
    (Int -> SimpleEntry -> ShowS)
    -> (SimpleEntry -> FilePath)
    -> ([SimpleEntry] -> ShowS)
    -> Show SimpleEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SimpleEntry -> ShowS
    showsPrec :: Int -> SimpleEntry -> ShowS
    $cshow :: SimpleEntry -> FilePath
    show :: SimpleEntry -> FilePath
    $cshowList :: [SimpleEntry] -> ShowS
    showList :: [SimpleEntry] -> ShowS
    Show

    -- | Attempt to parse the contents of the given archive in the given subdir into

    -- a 'Tree'. This will not consult any caches. It will ensure that:

    --

    -- * The cabal file exists

    --

    -- * The cabal file can be parsed

    --

    -- * The name inside the cabal file matches the name of the cabal file itself

    parseArchive ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RawArchive
      -> FilePath -- ^ file holding the archive

      -> RIO env (Package, CachedTree)
    parseArchive :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> FilePath -> RIO env (Package, CachedTree)
    parseArchive RawPackageLocationImmutable
    rpli RawArchive
    archive FilePath
    fp = do
      let loc :: ArchiveLocation
    loc = RawArchive -> ArchiveLocation
    raLocation RawArchive
    archive
          getFiles :: [ArchiveType] -> RIO env (ArchiveType, Map FilePath MetaEntry)
    getFiles [] = PantryException -> RIO env (ArchiveType, Map FilePath MetaEntry)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (ArchiveType, Map FilePath MetaEntry))
    -> PantryException -> RIO env (ArchiveType, Map FilePath MetaEntry)
    forall a b. (a -> b) -> a -> b
    $ ArchiveLocation -> PantryException
    UnknownArchiveType ArchiveLocation
    loc
          getFiles (ArchiveType
    at:[ArchiveType]
    ats) = do
            Either SomeException ([MetaEntry] -> [MetaEntry])
    eres <- RIO env ([MetaEntry] -> [MetaEntry])
    -> RIO env (Either SomeException ([MetaEntry] -> [MetaEntry]))
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> m (Either SomeException a)
    tryAny (RIO env ([MetaEntry] -> [MetaEntry])
     -> RIO env (Either SomeException ([MetaEntry] -> [MetaEntry])))
    -> RIO env ([MetaEntry] -> [MetaEntry])
    -> RIO env (Either SomeException ([MetaEntry] -> [MetaEntry]))
    forall a b. (a -> b) -> a -> b
    $ ArchiveLocation
    -> FilePath
    -> ArchiveType
    -> ([MetaEntry] -> [MetaEntry])
    -> (([MetaEntry] -> [MetaEntry])
        -> MetaEntry
        -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry]))
    -> RIO env ([MetaEntry] -> [MetaEntry])
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> FilePath
    -> ArchiveType
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
    -> RIO env a
    foldArchive ArchiveLocation
    loc FilePath
    fp ArchiveType
    at [MetaEntry] -> [MetaEntry]
    forall a. a -> a
    id ((([MetaEntry] -> [MetaEntry])
      -> MetaEntry
      -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry]))
     -> RIO env ([MetaEntry] -> [MetaEntry]))
    -> (([MetaEntry] -> [MetaEntry])
        -> MetaEntry
        -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry]))
    -> RIO env ([MetaEntry] -> [MetaEntry])
    forall a b. (a -> b) -> a -> b
    $ \[MetaEntry] -> [MetaEntry]
    m MetaEntry
    me -> ([MetaEntry] -> [MetaEntry])
    -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry])
    forall a. a -> ConduitT ByteString Void (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([MetaEntry] -> [MetaEntry])
     -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry]))
    -> ([MetaEntry] -> [MetaEntry])
    -> ConduitT ByteString Void (RIO env) ([MetaEntry] -> [MetaEntry])
    forall a b. (a -> b) -> a -> b
    $ [MetaEntry] -> [MetaEntry]
    m ([MetaEntry] -> [MetaEntry])
    -> ([MetaEntry] -> [MetaEntry]) -> [MetaEntry] -> [MetaEntry]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MetaEntry
    meMetaEntry -> [MetaEntry] -> [MetaEntry]
    forall a. a -> [a] -> [a]
    :)
            case Either SomeException ([MetaEntry] -> [MetaEntry])
    eres of
              Left SomeException
    e -> do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder
    "parseArchive of " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> ArchiveType -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display ArchiveType
    at Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ": " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow SomeException
    e
                [ArchiveType] -> RIO env (ArchiveType, Map FilePath MetaEntry)
    getFiles [ArchiveType]
    ats
              Right [MetaEntry] -> [MetaEntry]
    files -> (ArchiveType, Map FilePath MetaEntry)
    -> RIO env (ArchiveType, Map FilePath MetaEntry)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ArchiveType
    at, [(FilePath, MetaEntry)] -> Map FilePath MetaEntry
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(FilePath, MetaEntry)] -> Map FilePath MetaEntry)
    -> [(FilePath, MetaEntry)] -> Map FilePath MetaEntry
    forall a b. (a -> b) -> a -> b
    $ (MetaEntry -> (FilePath, MetaEntry))
    -> [MetaEntry] -> [(FilePath, MetaEntry)]
    forall a b. (a -> b) -> [a] -> [b]
    map (MetaEntry -> FilePath
    mePath (MetaEntry -> FilePath)
    -> (MetaEntry -> MetaEntry) -> MetaEntry -> (FilePath, MetaEntry)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& MetaEntry -> MetaEntry
    forall a. a -> a
    id) ([MetaEntry] -> [(FilePath, MetaEntry)])
    -> [MetaEntry] -> [(FilePath, MetaEntry)]
    forall a b. (a -> b) -> a -> b
    $ [MetaEntry] -> [MetaEntry]
    files [])
      (ArchiveType
    at :: ArchiveType, Map FilePath MetaEntry
    files :: Map FilePath MetaEntry) <- [ArchiveType] -> RIO env (ArchiveType, Map FilePath MetaEntry)
    forall {env}.
    (HasPantryConfig env, HasLogFunc env) =>
    [ArchiveType] -> RIO env (ArchiveType, Map FilePath MetaEntry)
    getFiles [ArchiveType
    forall a. Bounded a => a
    minBound..ArchiveType
    forall a. Bounded a => a
    maxBound]
      let toSimple :: FilePath -> MetaEntry -> Either String (Map FilePath SimpleEntry)
          toSimple :: FilePath -> MetaEntry -> Either FilePath (Map FilePath SimpleEntry)
    toSimple FilePath
    key MetaEntry
    me =
            case MetaEntry -> METype
    meType MetaEntry
    me of
              METype
    METNormal ->
                Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. b -> Either a b
    Right (Map FilePath SimpleEntry
     -> Either FilePath (Map FilePath SimpleEntry))
    -> Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SimpleEntry -> Map FilePath SimpleEntry
    forall k a. k -> a -> Map k a
    Map.singleton FilePath
    key (SimpleEntry -> Map FilePath SimpleEntry)
    -> SimpleEntry -> Map FilePath SimpleEntry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileType -> SimpleEntry
    SimpleEntry (MetaEntry -> FilePath
    mePath MetaEntry
    me) FileType
    FTNormal
              METype
    METExecutable ->
                Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. b -> Either a b
    Right (Map FilePath SimpleEntry
     -> Either FilePath (Map FilePath SimpleEntry))
    -> Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SimpleEntry -> Map FilePath SimpleEntry
    forall k a. k -> a -> Map k a
    Map.singleton FilePath
    key (SimpleEntry -> Map FilePath SimpleEntry)
    -> SimpleEntry -> Map FilePath SimpleEntry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileType -> SimpleEntry
    SimpleEntry (MetaEntry -> FilePath
    mePath MetaEntry
    me) FileType
    FTExecutable
              METLink FilePath
    relDest -> do
                case FilePath
    relDest of
                  Char
    '/':FilePath
    _ -> FilePath -> Either FilePath ()
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                             [ FilePath
    "File located at "
                             , ShowS
    forall a. Show a => a -> FilePath
    show ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ MetaEntry -> FilePath
    mePath MetaEntry
    me
                             , FilePath
    " is a symbolic link to absolute path "
                             , FilePath
    relDest
                             ]
                  FilePath
    _ -> () -> Either FilePath ()
    forall a b. b -> Either a b
    Right ()
                FilePath
    dest0 <-
                  case FilePath -> FilePath -> Either FilePath FilePath
    makeTarRelative (MetaEntry -> FilePath
    mePath MetaEntry
    me) FilePath
    relDest of
                    Left FilePath
    e -> FilePath -> Either FilePath FilePath
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath FilePath)
    -> FilePath -> Either FilePath FilePath
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                      [ FilePath
    "Error resolving relative path "
                      , FilePath
    relDest
                      , FilePath
    " from symlink at "
                      , MetaEntry -> FilePath
    mePath MetaEntry
    me
                      , FilePath
    ": "
                      , FilePath
    e
                      ]
                    Right FilePath
    x -> FilePath -> Either FilePath FilePath
    forall a b. b -> Either a b
    Right FilePath
    x
                FilePath
    dest <-
                  case FilePath -> Either FilePath FilePath
    normalizeParents FilePath
    dest0 of
                    Left FilePath
    e -> FilePath -> Either FilePath FilePath
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath FilePath)
    -> FilePath -> Either FilePath FilePath
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                      [ FilePath
    "Invalid symbolic link from "
                      , MetaEntry -> FilePath
    mePath MetaEntry
    me
                      , FilePath
    " to "
                      , FilePath
    relDest
                      , FilePath
    ", tried parsing "
                      , FilePath
    dest0
                      , FilePath
    ": "
                      , FilePath
    e
                      ]
                    Right FilePath
    x -> FilePath -> Either FilePath FilePath
    forall a b. b -> Either a b
    Right FilePath
    x
                -- Check if it's a symlink to a file

                case FilePath -> Map FilePath MetaEntry -> Maybe MetaEntry
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup FilePath
    dest Map FilePath MetaEntry
    files of
                  Maybe MetaEntry
    Nothing ->
                    -- Check if it's a symlink to a directory

                    case FilePath -> Map FilePath MetaEntry -> [(FilePath, MetaEntry)]
    findWithPrefix FilePath
    dest Map FilePath MetaEntry
    files of
                      [] -> FilePath -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath (Map FilePath SimpleEntry))
    -> FilePath -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $
                                 FilePath
    "Symbolic link dest not found from "
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ MetaEntry -> FilePath
    mePath MetaEntry
    me
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to "
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    relDest
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ", looking for "
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    dest
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ".\n"
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "This may indicate that the source is a git \
                                 \archive which uses git-annex.\n"
                              FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "See https://github.com/commercialhaskell/stack/issues/4579 \
                                 \for further information."
                      [(FilePath, MetaEntry)]
    pairs ->
                        ([Map FilePath SimpleEntry] -> Map FilePath SimpleEntry)
    -> Either FilePath [Map FilePath SimpleEntry]
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Map FilePath SimpleEntry] -> Map FilePath SimpleEntry
    forall m. Monoid m => [m] -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (Either FilePath [Map FilePath SimpleEntry]
     -> Either FilePath (Map FilePath SimpleEntry))
    -> Either FilePath [Map FilePath SimpleEntry]
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $ [(FilePath, MetaEntry)]
    -> ((FilePath, MetaEntry)
        -> Either FilePath (Map FilePath SimpleEntry))
    -> Either FilePath [Map FilePath SimpleEntry]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [(FilePath, MetaEntry)]
    pairs (((FilePath, MetaEntry)
      -> Either FilePath (Map FilePath SimpleEntry))
     -> Either FilePath [Map FilePath SimpleEntry])
    -> ((FilePath, MetaEntry)
        -> Either FilePath (Map FilePath SimpleEntry))
    -> Either FilePath [Map FilePath SimpleEntry]
    forall a b. (a -> b) -> a -> b
    $ \(FilePath
    suffix, MetaEntry
    me') -> FilePath -> MetaEntry -> Either FilePath (Map FilePath SimpleEntry)
    toSimple (FilePath
    key FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/' Char -> ShowS
    forall a. a -> [a] -> [a]
    : FilePath
    suffix) MetaEntry
    me'
                  Just MetaEntry
    me' ->
                    case MetaEntry -> METype
    meType MetaEntry
    me' of
                      METype
    METNormal ->
                        Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. b -> Either a b
    Right (Map FilePath SimpleEntry
     -> Either FilePath (Map FilePath SimpleEntry))
    -> Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SimpleEntry -> Map FilePath SimpleEntry
    forall k a. k -> a -> Map k a
    Map.singleton FilePath
    key (SimpleEntry -> Map FilePath SimpleEntry)
    -> SimpleEntry -> Map FilePath SimpleEntry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileType -> SimpleEntry
    SimpleEntry FilePath
    dest FileType
    FTNormal
                      METype
    METExecutable ->
                        Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. b -> Either a b
    Right (Map FilePath SimpleEntry
     -> Either FilePath (Map FilePath SimpleEntry))
    -> Map FilePath SimpleEntry
    -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SimpleEntry -> Map FilePath SimpleEntry
    forall k a. k -> a -> Map k a
    Map.singleton FilePath
    key (SimpleEntry -> Map FilePath SimpleEntry)
    -> SimpleEntry -> Map FilePath SimpleEntry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileType -> SimpleEntry
    SimpleEntry FilePath
    dest FileType
    FTExecutable
                      METLink FilePath
    _ ->
                        FilePath -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath (Map FilePath SimpleEntry))
    -> FilePath -> Either FilePath (Map FilePath SimpleEntry)
    forall a b. (a -> b) -> a -> b
    $
                             FilePath
    "Symbolic link dest cannot be a symbolic link, from "
                          FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ MetaEntry -> FilePath
    mePath MetaEntry
    me
                          FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to "
                          FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    relDest

      case Map FilePath (Map FilePath SimpleEntry) -> Map FilePath SimpleEntry
    forall m. Monoid m => Map FilePath m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (Map FilePath (Map FilePath SimpleEntry)
     -> Map FilePath SimpleEntry)
    -> Either FilePath (Map FilePath (Map FilePath SimpleEntry))
    -> Either FilePath (Map FilePath SimpleEntry)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath
     -> MetaEntry -> Either FilePath (Map FilePath SimpleEntry))
    -> Map FilePath MetaEntry
    -> Either FilePath (Map FilePath (Map FilePath SimpleEntry))
    forall (t :: * -> *) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey FilePath -> MetaEntry -> Either FilePath (Map FilePath SimpleEntry)
    toSimple Map FilePath MetaEntry
    files of
        Left FilePath
    e -> PantryException -> RIO env (Package, CachedTree)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (Package, CachedTree))
    -> PantryException -> RIO env (Package, CachedTree)
    forall a b. (a -> b) -> a -> b
    $ ArchiveLocation -> Text -> PantryException
    UnsupportedTarball ArchiveLocation
    loc (Text -> PantryException) -> Text -> PantryException
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    e
        Right Map FilePath SimpleEntry
    files1 -> do
          let files2 :: [(FilePath, SimpleEntry)]
    files2 = [(FilePath, SimpleEntry)] -> [(FilePath, SimpleEntry)]
    forall a. [(FilePath, a)] -> [(FilePath, a)]
    stripCommonPrefix ([(FilePath, SimpleEntry)] -> [(FilePath, SimpleEntry)])
    -> [(FilePath, SimpleEntry)] -> [(FilePath, SimpleEntry)]
    forall a b. (a -> b) -> a -> b
    $ Map FilePath SimpleEntry -> [(FilePath, SimpleEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map FilePath SimpleEntry
    files1
              files3 :: [(Text, SimpleEntry)]
    files3 = Text -> [(FilePath, SimpleEntry)] -> [(Text, SimpleEntry)]
    forall a. Text -> [(FilePath, a)] -> [(Text, a)]
    takeSubdir (RawArchive -> Text
    raSubdir RawArchive
    archive) [(FilePath, SimpleEntry)]
    files2
              toSafe :: (Text, b) -> Either FilePath (SafeFilePath, b)
    toSafe (Text
    fp', b
    a) =
                case Text -> Maybe SafeFilePath
    mkSafeFilePath Text
    fp' of
                  Maybe SafeFilePath
    Nothing -> FilePath -> Either FilePath (SafeFilePath, b)
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath (SafeFilePath, b))
    -> FilePath -> Either FilePath (SafeFilePath, b)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Not a safe file path: " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> FilePath
    forall a. Show a => a -> FilePath
    show Text
    fp'
                  Just SafeFilePath
    sfp -> (SafeFilePath, b) -> Either FilePath (SafeFilePath, b)
    forall a b. b -> Either a b
    Right (SafeFilePath
    sfp, b
    a)
          case ((Text, SimpleEntry)
     -> Either FilePath (SafeFilePath, SimpleEntry))
    -> [(Text, SimpleEntry)]
    -> Either FilePath [(SafeFilePath, SimpleEntry)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (Text, SimpleEntry) -> Either FilePath (SafeFilePath, SimpleEntry)
    forall {b}. (Text, b) -> Either FilePath (SafeFilePath, b)
    toSafe [(Text, SimpleEntry)]
    files3 of
            Left FilePath
    e -> PantryException -> RIO env (Package, CachedTree)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (Package, CachedTree))
    -> PantryException -> RIO env (Package, CachedTree)
    forall a b. (a -> b) -> a -> b
    $ ArchiveLocation -> Text -> PantryException
    UnsupportedTarball ArchiveLocation
    loc (Text -> PantryException) -> Text -> PantryException
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    e
            Right [(SafeFilePath, SimpleEntry)]
    safeFiles -> do
              let toSave :: Set FilePath
    toSave = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    Set.fromList ([FilePath] -> Set FilePath) -> [FilePath] -> Set FilePath
    forall a b. (a -> b) -> a -> b
    $ ((SafeFilePath, SimpleEntry) -> FilePath)
    -> [(SafeFilePath, SimpleEntry)] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (SimpleEntry -> FilePath
    seSource (SimpleEntry -> FilePath)
    -> ((SafeFilePath, SimpleEntry) -> SimpleEntry)
    -> (SafeFilePath, SimpleEntry)
    -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SafeFilePath, SimpleEntry) -> SimpleEntry
    forall a b. (a, b) -> b
    snd) [(SafeFilePath, SimpleEntry)]
    safeFiles
              (Map FilePath (BlobKey, BlobId)
    blobs :: Map FilePath (BlobKey, BlobId))  <-
                ArchiveLocation
    -> FilePath
    -> ArchiveType
    -> Map FilePath (BlobKey, BlobId)
    -> (Map FilePath (BlobKey, BlobId)
        -> MetaEntry
        -> ConduitT
             ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId)))
    -> RIO env (Map FilePath (BlobKey, BlobId))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ArchiveLocation
    -> FilePath
    -> ArchiveType
    -> a
    -> (a -> MetaEntry -> ConduitT ByteString Void (RIO env) a)
    -> RIO env a
    foldArchive ArchiveLocation
    loc FilePath
    fp ArchiveType
    at Map FilePath (BlobKey, BlobId)
    forall a. Monoid a => a
    mempty ((Map FilePath (BlobKey, BlobId)
      -> MetaEntry
      -> ConduitT
           ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId)))
     -> RIO env (Map FilePath (BlobKey, BlobId)))
    -> (Map FilePath (BlobKey, BlobId)
        -> MetaEntry
        -> ConduitT
             ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId)))
    -> RIO env (Map FilePath (BlobKey, BlobId))
    forall a b. (a -> b) -> a -> b
    $ \Map FilePath (BlobKey, BlobId)
    m MetaEntry
    me ->
                  if MetaEntry -> FilePath
    mePath MetaEntry
    me FilePath -> Set FilePath -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set FilePath
    toSave
                    then do
                      ByteString
    bs <- [ByteString] -> ByteString
    forall m. Monoid m => [m] -> m
    mconcat ([ByteString] -> ByteString)
    -> ConduitT ByteString Void (RIO env) [ByteString]
    -> ConduitT ByteString Void (RIO env) ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConduitT ByteString Void (RIO env) [ByteString]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    sinkList
                      (BlobId
    blobId, BlobKey
    blobKey) <- RIO env (BlobId, BlobKey)
    -> ConduitT ByteString Void (RIO env) (BlobId, BlobKey)
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ConduitT ByteString Void m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env (BlobId, BlobKey)
     -> ConduitT ByteString Void (RIO env) (BlobId, BlobKey))
    -> RIO env (BlobId, BlobKey)
    -> ConduitT ByteString Void (RIO env) (BlobId, BlobKey)
    forall a b. (a -> b) -> a -> b
    $ ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    -> RIO env (BlobId, BlobKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
     -> RIO env (BlobId, BlobKey))
    -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    -> RIO env (BlobId, BlobKey)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    storeBlob ByteString
    bs
                      Map FilePath (BlobKey, BlobId)
    -> ConduitT
         ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId))
    forall a. a -> ConduitT ByteString Void (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map FilePath (BlobKey, BlobId)
     -> ConduitT
          ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId)))
    -> Map FilePath (BlobKey, BlobId)
    -> ConduitT
         ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId))
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> (BlobKey, BlobId)
    -> Map FilePath (BlobKey, BlobId)
    -> Map FilePath (BlobKey, BlobId)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (MetaEntry -> FilePath
    mePath MetaEntry
    me) (BlobKey
    blobKey, BlobId
    blobId) Map FilePath (BlobKey, BlobId)
    m
                    else Map FilePath (BlobKey, BlobId)
    -> ConduitT
         ByteString Void (RIO env) (Map FilePath (BlobKey, BlobId))
    forall a. a -> ConduitT ByteString Void (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Map FilePath (BlobKey, BlobId)
    m
              CachedTree
    tree :: CachedTree <- ([(SafeFilePath, (TreeEntry, BlobId))] -> CachedTree)
    -> RIO env [(SafeFilePath, (TreeEntry, BlobId))]
    -> RIO env CachedTree
    forall a b. (a -> b) -> RIO env a -> RIO env b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Map SafeFilePath (TreeEntry, BlobId) -> CachedTree
    CachedTreeMap (Map SafeFilePath (TreeEntry, BlobId) -> CachedTree)
    -> ([(SafeFilePath, (TreeEntry, BlobId))]
        -> Map SafeFilePath (TreeEntry, BlobId))
    -> [(SafeFilePath, (TreeEntry, BlobId))]
    -> CachedTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SafeFilePath, (TreeEntry, BlobId))]
    -> Map SafeFilePath (TreeEntry, BlobId)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList) (RIO env [(SafeFilePath, (TreeEntry, BlobId))]
     -> RIO env CachedTree)
    -> RIO env [(SafeFilePath, (TreeEntry, BlobId))]
    -> RIO env CachedTree
    forall a b. (a -> b) -> a -> b
    $ [(SafeFilePath, SimpleEntry)]
    -> ((SafeFilePath, SimpleEntry)
        -> RIO env (SafeFilePath, (TreeEntry, BlobId)))
    -> RIO env [(SafeFilePath, (TreeEntry, BlobId))]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [(SafeFilePath, SimpleEntry)]
    safeFiles (((SafeFilePath, SimpleEntry)
      -> RIO env (SafeFilePath, (TreeEntry, BlobId)))
     -> RIO env [(SafeFilePath, (TreeEntry, BlobId))])
    -> ((SafeFilePath, SimpleEntry)
        -> RIO env (SafeFilePath, (TreeEntry, BlobId)))
    -> RIO env [(SafeFilePath, (TreeEntry, BlobId))]
    forall a b. (a -> b) -> a -> b
    $ \(SafeFilePath
    sfp, SimpleEntry
    se) ->
                case FilePath
    -> Map FilePath (BlobKey, BlobId) -> Maybe (BlobKey, BlobId)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (SimpleEntry -> FilePath
    seSource SimpleEntry
    se) Map FilePath (BlobKey, BlobId)
    blobs of
                  Maybe (BlobKey, BlobId)
    Nothing ->
                    FilePath -> RIO env (SafeFilePath, (TreeEntry, BlobId))
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> RIO env (SafeFilePath, (TreeEntry, BlobId)))
    -> FilePath -> RIO env (SafeFilePath, (TreeEntry, BlobId))
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Impossible: blob not found for: " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SimpleEntry -> FilePath
    seSource SimpleEntry
    se
                  Just (BlobKey
    blobKey, BlobId
    blobId) ->
                    (SafeFilePath, (TreeEntry, BlobId))
    -> RIO env (SafeFilePath, (TreeEntry, BlobId))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SafeFilePath
    sfp, (BlobKey -> FileType -> TreeEntry
    TreeEntry BlobKey
    blobKey (SimpleEntry -> FileType
    seType SimpleEntry
    se), BlobId
    blobId))
              -- parse the cabal file and ensure it has the right name

              BuildFile
    buildFile <- RawPackageLocationImmutable -> Tree -> RIO env BuildFile
    forall (m :: * -> *).
    MonadThrow m =>
    RawPackageLocationImmutable -> Tree -> m BuildFile
    findCabalOrHpackFile RawPackageLocationImmutable
    rpli (Tree -> RIO env BuildFile) -> Tree -> RIO env BuildFile
    forall a b. (a -> b) -> a -> b
    $ CachedTree -> Tree
    unCachedTree CachedTree
    tree
              (SafeFilePath
    buildFilePath, BlobKey
    buildFileBlobKey, TreeEntry
    buildFileEntry) <- case BuildFile
    buildFile of
                BFCabal SafeFilePath
    fpath te :: TreeEntry
    te@(TreeEntry BlobKey
    key FileType
    _) -> (SafeFilePath, BlobKey, TreeEntry)
    -> RIO env (SafeFilePath, BlobKey, TreeEntry)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SafeFilePath
    fpath, BlobKey
    key, TreeEntry
    te)
                BFHpack te :: TreeEntry
    te@(TreeEntry BlobKey
    key FileType
    _) -> (SafeFilePath, BlobKey, TreeEntry)
    -> RIO env (SafeFilePath, BlobKey, TreeEntry)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SafeFilePath
    hpackSafeFilePath, BlobKey
    key, TreeEntry
    te)
              Maybe ByteString
    mbs <- ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe ByteString)
     -> RIO env (Maybe ByteString))
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    buildFileBlobKey
              ByteString
    bs <- case Maybe ByteString
    mbs of
                Maybe ByteString
    Nothing -> PantryException -> RIO env ByteString
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ByteString)
    -> PantryException -> RIO env ByteString
    forall a b. (a -> b) -> a -> b
    $
                  RawPackageLocationImmutable
    -> SafeFilePath -> BlobKey -> PantryException
    TreeReferencesMissingBlob RawPackageLocationImmutable
    rpli SafeFilePath
    buildFilePath BlobKey
    buildFileBlobKey
                Just ByteString
    bs -> ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs
              ByteString
    cabalBs <- case BuildFile
    buildFile of
                BFCabal SafeFilePath
    _ TreeEntry
    _ -> ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs
                BFHpack TreeEntry
    _ -> (PackageName, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd ((PackageName, ByteString) -> ByteString)
    -> RIO env (PackageName, ByteString) -> RIO env ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> Tree -> RIO env (PackageName, ByteString)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Tree -> RIO env (PackageName, ByteString)
    hpackToCabal RawPackageLocationImmutable
    rpli (CachedTree -> Tree
    unCachedTree CachedTree
    tree)
              ([PWarning]
    _warnings, GenericPackageDescription
    gpd) <- Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> RIO env ([PWarning], GenericPackageDescription)
    forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD (RawPackageLocationImmutable
    -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. a -> Either a b
    Left RawPackageLocationImmutable
    rpli) ByteString
    cabalBs
              let ident :: PackageIdentifier
    ident@(PackageIdentifier PackageName
    name Version
    _) = PackageDescription -> PackageIdentifier
    package (PackageDescription -> PackageIdentifier)
    -> PackageDescription -> PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ GenericPackageDescription -> PackageDescription
    packageDescription GenericPackageDescription
    gpd
              case BuildFile
    buildFile of
                BFCabal SafeFilePath
    _ TreeEntry
    _ ->
                  Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SafeFilePath
    buildFilePath SafeFilePath -> SafeFilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= PackageName -> SafeFilePath
    cabalFileName PackageName
    name) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                    PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> SafeFilePath -> PackageName -> PantryException
    WrongCabalFileName RawPackageLocationImmutable
    rpli SafeFilePath
    buildFilePath PackageName
    name
                BuildFile
    _ -> () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
              -- It's good! Store the tree, let's bounce

              (TreeId
    tid, TreeKey
    treeKey') <- ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> RIO env (TreeId, TreeKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
     -> RIO env (TreeId, TreeKey))
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> RIO env (TreeId, TreeKey)
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    storeTree RawPackageLocationImmutable
    rpli PackageIdentifier
    ident CachedTree
    tree BuildFile
    buildFile
              PackageCabal
    packageCabal <- case BuildFile
    buildFile of
                BFCabal SafeFilePath
    _ TreeEntry
    _ -> PackageCabal -> RIO env PackageCabal
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageCabal -> RIO env PackageCabal)
    -> PackageCabal -> RIO env PackageCabal
    forall a b. (a -> b) -> a -> b
    $ TreeEntry -> PackageCabal
    PCCabalFile TreeEntry
    buildFileEntry
                BFHpack TreeEntry
    _ -> do
                  BlobKey
    cabalKey <- ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey)
    -> ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey
    forall a b. (a -> b) -> a -> b
    $ do
                    Key HPack
    hpackId <- RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack RawPackageLocationImmutable
    rpli TreeId
    tid
                    Key HPack -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key HPack -> ReaderT SqlBackend (RIO env) BlobKey
    loadCabalBlobKey Key HPack
    hpackId
                  Version
    hpackSoftwareVersion <- RIO env Version
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RIO env Version
    hpackVersion
                  let cabalTreeEntry :: TreeEntry
    cabalTreeEntry = BlobKey -> FileType -> TreeEntry
    TreeEntry BlobKey
    cabalKey (TreeEntry -> FileType
    teType TreeEntry
    buildFileEntry)
                  PackageCabal -> RIO env PackageCabal
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                    (PackageCabal -> RIO env PackageCabal)
    -> PackageCabal -> RIO env PackageCabal
    forall a b. (a -> b) -> a -> b
    $ PHpack -> PackageCabal
    PCHpack
                    (PHpack -> PackageCabal) -> PHpack -> PackageCabal
    forall a b. (a -> b) -> a -> b
    $ PHpack
                        { phOriginal :: TreeEntry
    phOriginal = TreeEntry
    buildFileEntry
                        , phGenerated :: TreeEntry
    phGenerated = TreeEntry
    cabalTreeEntry
                        , phVersion :: Version
    phVersion = Version
    hpackSoftwareVersion
                        }
              (Package, CachedTree) -> RIO env (Package, CachedTree)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package
                { packageTreeKey :: TreeKey
    packageTreeKey = TreeKey
    treeKey'
                , packageTree :: Tree
    packageTree = CachedTree -> Tree
    unCachedTree CachedTree
    tree
                , packageCabalEntry :: PackageCabal
    packageCabalEntry = PackageCabal
    packageCabal
                , packageIdent :: PackageIdentifier
    packageIdent = PackageIdentifier
    ident
                }, CachedTree
    tree)

    -- | Find all of the files in the Map with the given directory as a prefix.

    -- Directory is given without trailing slash. Returns the suffix after stripping

    -- the given prefix.

    findWithPrefix :: FilePath -> Map FilePath MetaEntry -> [(FilePath, MetaEntry)]
    findWithPrefix :: FilePath -> Map FilePath MetaEntry -> [(FilePath, MetaEntry)]
    findWithPrefix FilePath
    dir = ((FilePath, MetaEntry) -> Maybe (FilePath, MetaEntry))
    -> [(FilePath, MetaEntry)] -> [(FilePath, MetaEntry)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (FilePath, MetaEntry) -> Maybe (FilePath, MetaEntry)
    forall {t}. (FilePath, t) -> Maybe (FilePath, t)
    go ([(FilePath, MetaEntry)] -> [(FilePath, MetaEntry)])
    -> (Map FilePath MetaEntry -> [(FilePath, MetaEntry)])
    -> Map FilePath MetaEntry
    -> [(FilePath, MetaEntry)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map FilePath MetaEntry -> [(FilePath, MetaEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList
     where
      prefix :: FilePath
    prefix = FilePath
    dir FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "/"
      go :: (FilePath, t) -> Maybe (FilePath, t)
    go (FilePath
    x, t
    y) = (, t
    y) (FilePath -> (FilePath, t))
    -> Maybe FilePath -> Maybe (FilePath, t)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripPrefix FilePath
    prefix FilePath
    x

    findCabalOrHpackFile ::
         MonadThrow m
      => RawPackageLocationImmutable -- ^ for exceptions

      -> Tree
      -> m BuildFile
    findCabalOrHpackFile :: forall (m :: * -> *).
    MonadThrow m =>
    RawPackageLocationImmutable -> Tree -> m BuildFile
    findCabalOrHpackFile RawPackageLocationImmutable
    loc (TreeMap Map SafeFilePath TreeEntry
    m) = do
      let isCabalFile :: (SafeFilePath, b) -> Bool
    isCabalFile (SafeFilePath
    sfp, b
    _) =
            let txt :: Text
    txt = SafeFilePath -> Text
    unSafeFilePath SafeFilePath
    sfp
             in Bool -> Bool
    not (Text
    "/" Text -> Text -> Bool
    `T.isInfixOf` Text
    txt) Bool -> Bool -> Bool
    && (Text
    ".cabal" Text -> Text -> Bool
    `T.isSuffixOf` Text
    txt)
          isHpackFile :: (SafeFilePath, b) -> Bool
    isHpackFile (SafeFilePath
    sfp, b
    _) =
            let txt :: Text
    txt = SafeFilePath -> Text
    unSafeFilePath SafeFilePath
    sfp
             in FilePath -> Text
    T.pack FilePath
    Hpack.packageConfig Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    txt
          isBFCabal :: BuildFile -> Bool
    isBFCabal (BFCabal SafeFilePath
    _ TreeEntry
    _) = Bool
    True
          isBFCabal BuildFile
    _ = Bool
    False
          sfpBuildFile :: BuildFile -> SafeFilePath
    sfpBuildFile (BFCabal SafeFilePath
    sfp TreeEntry
    _) = SafeFilePath
    sfp
          sfpBuildFile (BFHpack TreeEntry
    _) = SafeFilePath
    hpackSafeFilePath
          toBuildFile :: (SafeFilePath, TreeEntry) -> Maybe BuildFile
    toBuildFile xs :: (SafeFilePath, TreeEntry)
    xs@(SafeFilePath
    sfp, TreeEntry
    te) = let cbFile :: Maybe BuildFile
    cbFile = if (SafeFilePath, TreeEntry) -> Bool
    forall {b}. (SafeFilePath, b) -> Bool
    isCabalFile (SafeFilePath, TreeEntry)
    xs
                                                    then BuildFile -> Maybe BuildFile
    forall a. a -> Maybe a
    Just (BuildFile -> Maybe BuildFile) -> BuildFile -> Maybe BuildFile
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath -> TreeEntry -> BuildFile
    BFCabal SafeFilePath
    sfp TreeEntry
    te
                                                    else Maybe BuildFile
    forall a. Maybe a
    Nothing
                                         hpFile :: Maybe BuildFile
    hpFile = if (SafeFilePath, TreeEntry) -> Bool
    forall {b}. (SafeFilePath, b) -> Bool
    isHpackFile (SafeFilePath, TreeEntry)
    xs
                                                    then BuildFile -> Maybe BuildFile
    forall a. a -> Maybe a
    Just (BuildFile -> Maybe BuildFile) -> BuildFile -> Maybe BuildFile
    forall a b. (a -> b) -> a -> b
    $ TreeEntry -> BuildFile
    BFHpack TreeEntry
    te
                                                    else Maybe BuildFile
    forall a. Maybe a
    Nothing
                                     in  Maybe BuildFile
    cbFile Maybe BuildFile -> Maybe BuildFile -> Maybe BuildFile
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe BuildFile
    hpFile
      case ((SafeFilePath, TreeEntry) -> Maybe BuildFile)
    -> [(SafeFilePath, TreeEntry)] -> [BuildFile]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (SafeFilePath, TreeEntry) -> Maybe BuildFile
    toBuildFile ([(SafeFilePath, TreeEntry)] -> [BuildFile])
    -> [(SafeFilePath, TreeEntry)] -> [BuildFile]
    forall a b. (a -> b) -> a -> b
    $ Map SafeFilePath TreeEntry -> [(SafeFilePath, TreeEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map SafeFilePath TreeEntry
    m of
        [] -> PantryException -> m BuildFile
    forall e a. Exception e => e -> m a
    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
    throwM (PantryException -> m BuildFile) -> PantryException -> m BuildFile
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable -> PantryException
    TreeWithoutCabalFile RawPackageLocationImmutable
    loc
        [BuildFile
    bfile] -> BuildFile -> m BuildFile
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BuildFile
    bfile
        [BuildFile]
    xs -> case (BuildFile -> Bool) -> [BuildFile] -> [BuildFile]
    forall a. (a -> Bool) -> [a] -> [a]
    filter BuildFile -> Bool
    isBFCabal [BuildFile]
    xs of
                [] -> PantryException -> m BuildFile
    forall e a. Exception e => e -> m a
    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
    throwM (PantryException -> m BuildFile) -> PantryException -> m BuildFile
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable -> PantryException
    TreeWithoutCabalFile RawPackageLocationImmutable
    loc
                [BuildFile
    bfile] -> BuildFile -> m BuildFile
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BuildFile
    bfile
                [BuildFile]
    xs' -> PantryException -> m BuildFile
    forall e a. Exception e => e -> m a
    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
    throwM (PantryException -> m BuildFile) -> PantryException -> m BuildFile
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable -> [SafeFilePath] -> PantryException
    TreeWithMultipleCabalFiles RawPackageLocationImmutable
    loc ([SafeFilePath] -> PantryException)
    -> [SafeFilePath] -> PantryException
    forall a b. (a -> b) -> a -> b
    $ (BuildFile -> SafeFilePath) -> [BuildFile] -> [SafeFilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map BuildFile -> SafeFilePath
    sfpBuildFile [BuildFile]
    xs'

    -- | If all files have a shared prefix, strip it off

    stripCommonPrefix :: [(FilePath, a)] -> [(FilePath, a)]
    stripCommonPrefix :: forall a. [(FilePath, a)] -> [(FilePath, a)]
    stripCommonPrefix [] = []
    stripCommonPrefix pairs :: [(FilePath, a)]
    pairs@((FilePath
    firstFP, a
    _):[(FilePath, a)]
    _) = [(FilePath, a)] -> Maybe [(FilePath, a)] -> [(FilePath, a)]
    forall a. a -> Maybe a -> a
    fromMaybe [(FilePath, a)]
    pairs (Maybe [(FilePath, a)] -> [(FilePath, a)])
    -> Maybe [(FilePath, a)] -> [(FilePath, a)]
    forall a b. (a -> b) -> a -> b
    $ do
      let firstDir :: FilePath
    firstDir = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') FilePath
    firstFP
      Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    firstDir
      let strip :: (FilePath, t) -> Maybe (FilePath, t)
    strip (FilePath
    fp, t
    a) = (, t
    a) (FilePath -> (FilePath, t))
    -> Maybe FilePath -> Maybe (FilePath, t)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripPrefix (FilePath
    firstDir FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "/") FilePath
    fp
      [(FilePath, a)] -> [(FilePath, a)]
    forall a. [(FilePath, a)] -> [(FilePath, a)]
    stripCommonPrefix ([(FilePath, a)] -> [(FilePath, a)])
    -> Maybe [(FilePath, a)] -> Maybe [(FilePath, a)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((FilePath, a) -> Maybe (FilePath, a))
    -> [(FilePath, a)] -> Maybe [(FilePath, a)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (FilePath, a) -> Maybe (FilePath, a)
    forall {t}. (FilePath, t) -> Maybe (FilePath, t)
    strip [(FilePath, a)]
    pairs

    -- | Take us down to the specified subdirectory

    takeSubdir ::
         Text -- ^ subdir

      -> [(FilePath, a)] -- ^ files after stripping common prefix

      -> [(Text, a)]
    takeSubdir :: forall a. Text -> [(FilePath, a)] -> [(Text, a)]
    takeSubdir Text
    subdir = ((FilePath, a) -> Maybe (Text, a))
    -> [(FilePath, a)] -> [(Text, a)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (((FilePath, a) -> Maybe (Text, a))
     -> [(FilePath, a)] -> [(Text, a)])
    -> ((FilePath, a) -> Maybe (Text, a))
    -> [(FilePath, a)]
    -> [(Text, a)]
    forall a b. (a -> b) -> a -> b
    $ \(FilePath
    fp, a
    a) -> do
      [Text]
    stripped <- [Text] -> [Text] -> Maybe [Text]
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripPrefix [Text]
    subdirs ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    splitDirs (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    fp
      (Text, a) -> Maybe (Text, a)
    forall a. a -> Maybe a
    Just (Text -> [Text] -> Text
    T.intercalate Text
    "/" [Text]
    stripped, a
    a)
      where
        splitDirs :: Text -> [Text]
    splitDirs = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    List.dropWhile (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    ".") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "/"
        subdirs :: [Text]
    subdirs = Text -> [Text]
    splitDirs Text
    subdir