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

    module Pantry.Hackage
      ( updateHackageIndex
      , forceUpdateHackageIndex
      , DidUpdateOccur (..)
      , RequireHackageIndex (..)
      , hackageIndexTarballL
      , getHackageTarball
      , getHackageTarballKey
      , getHackageCabalFile
      , getHackagePackageVersions
      , getHackagePackageVersionRevisions
      , getHackageTypoCorrections
      , UsePreferredVersions (..)
      , HackageTarballResult(..)
      ) where

    import           Conduit
                       ( ZipSink (..), (.|), getZipSink, runConduit, sinkLazy
                       , sinkList, sourceHandle, takeC, takeCE
                       )
    import           Data.Aeson
                       ( FromJSON (..), Value (..),  (.:), eitherDecode'
                       , withObject
                       )
    import           Data.Conduit.Tar
                       ( FileInfo (..), FileType (..), untar )
    import qualified Data.List.NonEmpty as NE
    import           Data.Text.Metrics (damerauLevenshtein)
    import           Data.Text.Unsafe ( unsafeTail )
    import           Data.Time ( getCurrentTime )
    import           Database.Persist.Sql ( SqlBackend )
    import           Distribution.PackageDescription ( GenericPackageDescription )
    import qualified Distribution.PackageDescription as Cabal
    import qualified Distribution.Text
    import           Distribution.Types.Version (versionNumbers)
    import           Distribution.Types.VersionRange (withinRange)
    import qualified Hackage.Security.Client as HS
    import qualified Hackage.Security.Client.Repository.Cache as HS
    import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HS
    import qualified Hackage.Security.Client.Repository.Remote as HS
    import qualified Hackage.Security.Util.Path as HS
    import qualified Hackage.Security.Util.Pretty as HS
    import           Network.URI ( parseURI )
    import           Pantry.Archive ( getArchive )
    import           Pantry.Casa ( casaLookupKey )
    import qualified Pantry.SHA256 as SHA256
    import           Pantry.Storage
                       ( CachedTree (..), TreeId, BlobId, clearHackageRevisions
                       , countHackageCabals, getBlobKey, loadBlobById, loadBlobBySHA
                       , loadHackagePackageVersion, loadHackagePackageVersions
                       , loadHackageTarballInfo, loadHackageTree, loadHackageTreeKey
                       , loadLatestCacheUpdate, loadPreferredVersion
                       , sinkHackagePackageNames, storeBlob, storeCacheUpdate
                       , storeHackageRevision, storeHackageTarballInfo
                       , storeHackageTree, storePreferredVersion, storeTree
                       , unCachedTree, withStorage
                       )
    import           Pantry.Tree ( rawParseGPD )
    import           Pantry.Types
                       ( ArchiveLocation (..), BlobKey (..), BuildFile (..)
                       , CabalFileInfo (..), FileSize (..), FuzzyResults (..)
                       , HackageSecurityConfig (..), HasPantryConfig (..)
                       , Mismatch (..), Package (..), PackageCabal (..)
                       , PackageIdentifier (..), PackageIdentifierRevision (..)
                       , PackageIndexConfig (..), PackageName, PantryConfig (..)
                       , PantryException (..), RawArchive (..)
                       , RawPackageLocationImmutable (..), RawPackageMetadata (..)
                       , Revision, SHA256, Storage (..), TreeEntry (..), TreeKey
                       , Version, cabalFileName, packageNameString, parsePackageName
                       , unSafeFilePath
                       )
    import           Path
                       ( Abs, Dir, File, Path, Rel, (</>), parseRelDir, parseRelFile
                       , toFilePath
                       )
    import           RIO
    import qualified RIO.ByteString as B
    import qualified RIO.ByteString.Lazy as BL
    import qualified RIO.Map as Map
    import           RIO.Process ( HasProcessContext )
    import qualified RIO.Text as T
    #if !MIN_VERSION_rio(0,1,16)
    -- Now provided by RIO from the rio package. Resolvers before lts-15.16

    -- (GHC 8.8.3) had rio < 0.1.16.

    import           System.IO ( SeekMode (..) )
    #endif

    hackageRelDir :: Path Rel Dir
    hackageRelDir :: Path Rel Dir
    hackageRelDir = (SomeException -> Path Rel Dir)
    -> (Path Rel Dir -> Path Rel Dir)
    -> Either SomeException (Path Rel Dir)
    -> Path Rel Dir
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> Path Rel Dir
    forall e a. Exception e => e -> a
    impureThrow Path Rel Dir -> Path Rel Dir
    forall a. a -> a
    id (Either SomeException (Path Rel Dir) -> Path Rel Dir)
    -> Either SomeException (Path Rel Dir) -> Path Rel Dir
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Either SomeException (Path Rel Dir)
    forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
    parseRelDir FilePath
    "hackage"

    hackageDirL :: HasPantryConfig env => SimpleGetter env (Path Abs Dir)
    hackageDirL :: forall env. HasPantryConfig env => SimpleGetter env (Path Abs Dir)
    hackageDirL = (PantryConfig -> Const r PantryConfig) -> env -> Const r env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const r PantryConfig) -> env -> Const r env)
    -> ((Path Abs Dir -> Const r (Path Abs Dir))
        -> PantryConfig -> Const r PantryConfig)
    -> (Path Abs Dir -> Const r (Path Abs Dir))
    -> env
    -> Const r env
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> Path Abs Dir)
    -> SimpleGetter PantryConfig (Path Abs Dir)
    forall s a. (s -> a) -> SimpleGetter s a
    to ((Path Abs Dir -> Path Rel Dir -> Path Abs Dir
    forall b t. Path b Dir -> Path Rel t -> Path b t
    </> Path Rel Dir
    hackageRelDir) (Path Abs Dir -> Path Abs Dir)
    -> (PantryConfig -> Path Abs Dir) -> PantryConfig -> Path Abs Dir
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PantryConfig -> Path Abs Dir
    pcRootDir)

    -- | The name of the tar file that is part of the local cache of the package

    -- index is determined by this package's use of 'HS.cabalCacheLayout' as the

    -- layout of the local cache.

    indexRelFile :: Path Rel File
    indexRelFile :: Path Rel File
    indexRelFile = (SomeException -> Path Rel File)
    -> (Path Rel File -> Path Rel File)
    -> Either SomeException (Path Rel File)
    -> Path Rel File
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> Path Rel File
    forall e a. Exception e => e -> a
    impureThrow Path Rel File -> Path Rel File
    forall a. a -> a
    id (Either SomeException (Path Rel File) -> Path Rel File)
    -> Either SomeException (Path Rel File) -> Path Rel File
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Either SomeException (Path Rel File)
    forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
    parseRelFile FilePath
    indexTar
     where
      indexTar' :: CachePath
    indexTar' = CacheLayout -> CachePath
    HS.cacheLayoutIndexTar CacheLayout
    HS.cabalCacheLayout
      indexTar :: FilePath
    indexTar = Path Unrooted -> FilePath
    HS.toUnrootedFilePath (Path Unrooted -> FilePath) -> Path Unrooted -> FilePath
    forall a b. (a -> b) -> a -> b
    $ CachePath -> Path Unrooted
    forall root. Path root -> Path Unrooted
    HS.unrootPath CachePath
    indexTar'

    -- | Where does pantry download its 01-index.tar file from Hackage?

    --

    -- @since 0.1.0.0

    hackageIndexTarballL :: HasPantryConfig env => SimpleGetter env (Path Abs File)
    hackageIndexTarballL :: forall env. HasPantryConfig env => SimpleGetter env (Path Abs File)
    hackageIndexTarballL = Getting r env (Path Abs Dir)
    forall env. HasPantryConfig env => SimpleGetter env (Path Abs Dir)
    SimpleGetter env (Path Abs Dir)
    hackageDirLGetting r env (Path Abs Dir)
    -> ((Path Abs File -> Const r (Path Abs File))
        -> Path Abs Dir -> Const r (Path Abs Dir))
    -> (Path Abs File -> Const r (Path Abs File))
    -> env
    -> Const r env
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Path Abs Dir -> Path Abs File)
    -> SimpleGetter (Path Abs Dir) (Path Abs File)
    forall s a. (s -> a) -> SimpleGetter s a
    to (Path Abs Dir -> Path Rel File -> Path Abs File
    forall b t. Path b Dir -> Path Rel t -> Path b t
    </> Path Rel File
    indexRelFile)

    -- | Did an update occur when running 'updateHackageIndex'?

    --

    -- @since 0.1.0.0

    data DidUpdateOccur = UpdateOccurred | NoUpdateOccurred

    -- | Information returned by `getHackageTarball`

    --

    -- @since 0.1.0.0

    data HackageTarballResult = HackageTarballResult
      { HackageTarballResult -> Package
    htrPackage :: !Package
        -- ^ Package that was loaded from Hackage tarball

      , HackageTarballResult -> Maybe (GenericPackageDescription, TreeId)
    htrFreshPackageInfo :: !(Maybe (GenericPackageDescription, TreeId))
        -- ^ This information is only available whenever package was just loaded

        -- into pantry.

      }

    -- | Download the most recent 01-index.tar file from Hackage and update the

    -- database tables.

    --

    -- This function will only perform an update once per 'PantryConfig' for user

    -- sanity. See the return value to find out if it happened.

    --

    -- @since 0.1.0.0

    updateHackageIndex ::
         (HasPantryConfig env, HasLogFunc env)
      => Maybe Utf8Builder -- ^ reason for updating, if any

      -> RIO env DidUpdateOccur
    updateHackageIndex :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndex = Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndexInternal Bool
    False

    -- | Same as `updateHackageIndex`, but force the database update even if hackage

    -- security tells that there is no change.  This can be useful in order to make

    -- sure the database is in sync with the locally downloaded tarball

    --

    -- @since 0.1.0.0

    forceUpdateHackageIndex ::
         (HasPantryConfig env, HasLogFunc env)
      => Maybe Utf8Builder
      -> RIO env DidUpdateOccur
    forceUpdateHackageIndex :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Maybe Utf8Builder -> RIO env DidUpdateOccur
    forceUpdateHackageIndex = Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndexInternal Bool
    True

    updateHackageIndexInternal ::
         (HasPantryConfig env, HasLogFunc env)
      => Bool -- ^ Force the database update.

      -> Maybe Utf8Builder -- ^ reason for updating, if any

      -> RIO env DidUpdateOccur
    updateHackageIndexInternal :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndexInternal Bool
    forceUpdate Maybe Utf8Builder
    mreason = do
      storage <- Getting Storage env Storage -> RIO env Storage
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting Storage env Storage -> RIO env Storage)
    -> Getting Storage env Storage -> RIO env Storage
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const Storage PantryConfig)
    -> env -> Const Storage env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const Storage PantryConfig)
     -> env -> Const Storage env)
    -> ((Storage -> Const Storage Storage)
        -> PantryConfig -> Const Storage PantryConfig)
    -> Getting Storage env Storage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> Storage) -> SimpleGetter PantryConfig Storage
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig -> Storage
    pcStorage
      gateUpdate $ withWriteLock_ storage $ do
        for_ mreason logInfo
        pc <- view pantryConfigL
        let PackageIndexConfig url (HackageSecurityConfig keyIds threshold ignoreExpiry) = pcPackageIndex pc
        root <- view hackageDirL
        tarball <- view hackageIndexTarballL
        baseURI <-
          case parseURI $ T.unpack url of
            Maybe URI
    Nothing ->
              FilePath -> RIO env URI
    forall (m :: * -> *) a.
    (MonadIO m, HasCallStack) =>
    FilePath -> m a
    throwString (FilePath -> RIO env URI) -> FilePath -> RIO env URI
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Invalid Hackage Security base URL: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Text -> FilePath
    T.unpack Text
    url
            Just URI
    x -> URI -> RIO env URI
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure URI
    x
        run <- askRunInIO
        let logTUF = RIO env () -> IO ()
    run (RIO env () -> IO ())
    -> (LogMessage -> RIO env ()) -> LogMessage -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo (Utf8Builder -> RIO env ())
    -> (LogMessage -> Utf8Builder) -> LogMessage -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (FilePath -> Utf8Builder)
    -> (LogMessage -> FilePath) -> LogMessage -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogMessage -> FilePath
    forall a. Pretty a => a -> FilePath
    HS.pretty
            withRepo = HttpLib
    -> [URI]
    -> RepoOpts
    -> Cache
    -> RepoLayout
    -> IndexLayout
    -> (LogMessage -> IO ())
    -> (Repository RemoteTemp -> IO a)
    -> IO a
    forall a.
    HttpLib
    -> [URI]
    -> RepoOpts
    -> Cache
    -> RepoLayout
    -> IndexLayout
    -> (LogMessage -> IO ())
    -> (Repository RemoteTemp -> IO a)
    -> IO a
    HS.withRepository
              HttpLib
    HS.httpLib
              [URI
    baseURI]
              RepoOpts
    HS.defaultRepoOpts
              HS.Cache
                { cacheRoot :: Path Absolute
    HS.cacheRoot = FilePath -> Path Absolute
    HS.fromAbsoluteFilePath (FilePath -> Path Absolute) -> FilePath -> Path Absolute
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs Dir
    root
                , cacheLayout :: CacheLayout
    HS.cacheLayout = CacheLayout
    HS.cabalCacheLayout
                }
              RepoLayout
    HS.hackageRepoLayout
              IndexLayout
    HS.hackageIndexLayout
              LogMessage -> IO ()
    logTUF
        didUpdate <- liftIO $ withRepo $ \Repository RemoteTemp
    repo -> ((Throws VerificationError, Throws SomeRemoteError,
      Throws InvalidPackageException) =>
     IO HasUpdates)
    -> IO HasUpdates
    forall a.
    ((Throws VerificationError, Throws SomeRemoteError,
      Throws InvalidPackageException) =>
     IO a)
    -> IO a
    HS.uncheckClientErrors (((Throws VerificationError, Throws SomeRemoteError,
       Throws InvalidPackageException) =>
      IO HasUpdates)
     -> IO HasUpdates)
    -> ((Throws VerificationError, Throws SomeRemoteError,
         Throws InvalidPackageException) =>
        IO HasUpdates)
    -> IO HasUpdates
    forall a b. (a -> b) -> a -> b
    $ do
          needBootstrap <- Repository RemoteTemp -> IO Bool
    forall (down :: * -> *). Repository down -> IO Bool
    HS.requiresBootstrap Repository RemoteTemp
    repo
          when needBootstrap $ do
            HS.bootstrap
              repo
              (map (HS.KeyId . T.unpack) keyIds)
              (HS.KeyThreshold $ fromIntegral threshold)
          maybeNow <- if ignoreExpiry
                        then pure Nothing
                        else Just <$> getCurrentTime
          HS.checkForUpdates repo maybeNow

        case didUpdate of
          HasUpdates
    _ | Bool
    forceUpdate -> do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "Forced package update is initialized"
                Path Abs File -> RIO env ()
    forall {env}.
    (HasPantryConfig env, HasLogFunc env) =>
    Path Abs File -> RIO env ()
    updateCache Path Abs File
    tarball
          HasUpdates
    HS.NoUpdates -> do
            x <- Path Abs File -> RIO env Bool
    forall {env} {b} {t}.
    (HasPantryConfig env, HasLogFunc env) =>
    Path b t -> RIO env Bool
    needsCacheUpdate Path Abs File
    tarball
            if x
              then do
                logInfo "No package index update available, but didn't update cache last time, running now"
                updateCache tarball
              else logInfo "No package index update available and cache up to date"
          HasUpdates
    HS.HasUpdates -> do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "Updated package index downloaded"
            Path Abs File -> RIO env ()
    forall {env}.
    (HasPantryConfig env, HasLogFunc env) =>
    Path Abs File -> RIO env ()
    updateCache Path Abs File
    tarball
        logStickyDone "Package index cache populated"
     where
      -- The size of the new index tarball, ignoring the required (by the tar spec)

      -- 1024 null bytes at the end, which will be mutated in the future by other

      -- updates.

      getTarballSize :: MonadIO m => Handle -> m Word
      getTarballSize :: forall (m :: * -> *). MonadIO m => Handle -> m Word
    getTarballSize Handle
    h = Integer -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word) -> (Integer -> Integer) -> Integer -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max Integer
    0 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    subtract Integer
    1024 (Integer -> Word) -> m Integer -> m Word
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> m Integer
    forall (m :: * -> *). MonadIO m => Handle -> m Integer
    hFileSize Handle
    h

      -- Check if the size of the tarball on the disk matches the value in

      -- CacheUpdate. If not, we need to perform a cache update, even if we didn't

      -- download any new information. This can be caused by canceling an

      -- updateCache call.

      needsCacheUpdate :: Path b t -> RIO env Bool
    needsCacheUpdate Path b t
    tarball = do
        mres <- ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    -> RIO env (Maybe (FileSize, SHA256))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    forall env. ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate
        case mres of
          Maybe (FileSize, SHA256)
    Nothing -> Bool -> RIO env Bool
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
          Just (FileSize Word
    cachedSize, SHA256
    _sha256) -> do
            actualSize <- FilePath -> IOMode -> (Handle -> RIO env Word) -> RIO env Word
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> IOMode -> (Handle -> m a) -> m a
    withBinaryFile (Path b t -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path b t
    tarball) IOMode
    ReadMode Handle -> RIO env Word
    forall (m :: * -> *). MonadIO m => Handle -> m Word
    getTarballSize
            pure $ cachedSize /= actualSize

      -- This is the one action in the Pantry codebase known to hold a write lock on

      -- the database for an extended period of time. To avoid failures due to

      -- SQLite locks failing, we take our own lock outside of SQLite for this

      -- action.

      --

      -- See https://github.com/commercialhaskell/stack/issues/4471

      updateCache :: Path Abs File -> RIO env ()
    updateCache Path Abs File
    tarball = 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
    $ do
        -- Alright, here's the story. In theory, we only ever append to a tarball.

        -- Therefore, we can store the last place we populated our cache from, and

        -- fast forward to that point. But there are two issues with that:

        --

        -- 1. Hackage may rebase, in which case we need to recalculate everything

        -- from the beginning. Unfortunately, hackage-security doesn't let us know

        -- when that happens.

        --

        -- 2. Some paranoia about files on the filesystem getting modified out from

        -- under us.

        --

        -- Therefore, we store both the last read-to index, _and_ the SHA256 of all

        -- of the contents until that point. When updating the cache, we calculate

        -- the new SHA256 of the whole file, and the SHA256 of the previous read-to

        -- point. If the old hashes match, we can do an efficient fast forward.

        -- Otherwise, we clear the old cache and repopulate.

        minfo <- ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    forall env. ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate
        (offset, newHash, newSize) <- lift $ withBinaryFile (toFilePath tarball) ReadMode $ \Handle
    h -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "Calculating hashes to check for hackage-security rebases or filesystem changes"

          newSize <- Handle -> RIO env Word
    forall (m :: * -> *). MonadIO m => Handle -> m Word
    getTarballSize Handle
    h
          let sinkSHA256 a
    len = Index ByteString -> ConduitT ByteString ByteString m ()
    forall (m :: * -> *) seq.
    (Monad m, IsSequence seq) =>
    Index seq -> ConduitT seq seq m ()
    takeCE (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    len) ConduitT ByteString ByteString m ()
    -> ConduitT ByteString c m SHA256 -> ConduitT ByteString c m 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 c m SHA256
    forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
    SHA256.sinkHash

          case minfo of
            Maybe (FileSize, SHA256)
    Nothing -> do
              Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "No old cache found, populating cache from scratch"
              newHash <- ConduitT () Void (RIO env) SHA256 -> RIO env SHA256
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (RIO env) SHA256 -> RIO env SHA256)
    -> ConduitT () Void (RIO env) SHA256 -> RIO env SHA256
    forall a b. (a -> b) -> a -> b
    $ 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
    .| Word -> ConduitT ByteString Void (RIO env) SHA256
    forall {m :: * -> *} {a} {c}.
    (Monad m, Integral a) =>
    a -> ConduitT ByteString c m SHA256
    sinkSHA256 Word
    newSize
              pure (0, newHash, newSize)
            Just (FileSize Word
    oldSize, SHA256
    oldHash) -> do
              -- oldSize and oldHash come from the database, and tell

              -- us what we cached already. Compare against

              -- oldHashCheck, which assuming the tarball has not been

              -- rebased will be the same as oldHash. At the same

              -- time, calculate newHash, which is the hash of the new

              -- content as well.

              (oldHashCheck, newHash) <- ConduitT () Void (RIO env) (SHA256, SHA256)
    -> RIO env (SHA256, SHA256)
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (RIO env) (SHA256, SHA256)
     -> RIO env (SHA256, SHA256))
    -> ConduitT () Void (RIO env) (SHA256, SHA256)
    -> RIO env (SHA256, SHA256)
    forall a b. (a -> b) -> a -> b
    $ 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, SHA256)
    -> ConduitT () Void (RIO env) (SHA256, SHA256)
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ZipSink ByteString (RIO env) (SHA256, SHA256)
    -> ConduitT ByteString Void (RIO env) (SHA256, SHA256)
    forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
    getZipSink ((,)
                (SHA256 -> SHA256 -> (SHA256, SHA256))
    -> ZipSink ByteString (RIO env) SHA256
    -> ZipSink ByteString (RIO env) (SHA256 -> (SHA256, SHA256))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConduitT ByteString Void (RIO env) SHA256
    -> ZipSink ByteString (RIO env) SHA256
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink (Word -> ConduitT ByteString Void (RIO env) SHA256
    forall {m :: * -> *} {a} {c}.
    (Monad m, Integral a) =>
    a -> ConduitT ByteString c m SHA256
    sinkSHA256 Word
    oldSize)
                ZipSink ByteString (RIO env) (SHA256 -> (SHA256, SHA256))
    -> ZipSink ByteString (RIO env) SHA256
    -> ZipSink ByteString (RIO env) (SHA256, SHA256)
    forall a b.
    ZipSink ByteString (RIO env) (a -> b)
    -> ZipSink ByteString (RIO env) a -> ZipSink ByteString (RIO env) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ConduitT ByteString Void (RIO env) SHA256
    -> ZipSink ByteString (RIO env) SHA256
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink (Word -> ConduitT ByteString Void (RIO env) SHA256
    forall {m :: * -> *} {a} {c}.
    (Monad m, Integral a) =>
    a -> ConduitT ByteString c m SHA256
    sinkSHA256 Word
    newSize)
                                                                               )
              offset <-
                if oldHash == oldHashCheck
                  then oldSize <$ logInfo "Updating preexisting cache, should be quick"
                  else 0 <$ do
                    logWarn $ mconcat [
                      "Package index change detected, that's pretty unusual: "
                      , "\n    Old size: " <> display oldSize
                      , "\n    Old hash (orig) : " <> display oldHash
                      , "\n    New hash (check): " <> display oldHashCheck
                      , "\n    Forcing a recache"
                      ]
              pure (offset, newHash, newSize)

        lift $ logInfo $
             "Populating cache from file size "
          <> display newSize
          <> ", hash "
          <> display newHash
        when (offset == 0) clearHackageRevisions
        populateCache tarball (fromIntegral offset) `onException`
          lift (logStickyDone "Failed populating package index cache")
        storeCacheUpdate (FileSize newSize) newHash
      gateUpdate :: m b -> m DidUpdateOccur
    gateUpdate m b
    inner = do
        pc <- Getting PantryConfig s PantryConfig -> m PantryConfig
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting PantryConfig s PantryConfig
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' s PantryConfig
    pantryConfigL
        join $ modifyMVar (pcUpdateRef pc) $ \Bool
    toUpdate -> (Bool, m DidUpdateOccur) -> m (Bool, m DidUpdateOccur)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Bool, m DidUpdateOccur) -> m (Bool, m DidUpdateOccur))
    -> (Bool, m DidUpdateOccur) -> m (Bool, m DidUpdateOccur)
    forall a b. (a -> b) -> a -> b
    $
          if Bool
    toUpdate
            then (Bool
    False, DidUpdateOccur
    UpdateOccurred DidUpdateOccur -> m b -> m DidUpdateOccur
    forall a b. a -> m b -> m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ m b
    inner)
            else (Bool
    False, DidUpdateOccur -> m DidUpdateOccur
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DidUpdateOccur
    NoUpdateOccurred)

    -- | Populate the SQLite tables with Hackage index information.

    populateCache ::
         (HasPantryConfig env, HasLogFunc env)
      => Path Abs File -- ^ tarball

      -> Integer -- ^ where to start processing from

      -> ReaderT SqlBackend (RIO env) ()
    populateCache :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Path Abs File -> Integer -> ReaderT SqlBackend (RIO env) ()
    populateCache Path Abs File
    fp Integer
    offset = FilePath
    -> IOMode
    -> (Handle -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> IOMode -> (Handle -> m a) -> m a
    withBinaryFile (Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    fp) IOMode
    ReadMode ((Handle -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> (Handle -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
      RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env () -> ReaderT SqlBackend (RIO env) ())
    -> RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "Populating package index cache ..."
      counter <- Int -> ReaderT SqlBackend (RIO env) (IORef Int)
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef (Int
    0 :: Int)
      hSeek h AbsoluteSeek offset
      runConduit $ sourceHandle h .| untar (perFile counter)
     where
      perFile :: IORef a
    -> FileInfo
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    perFile IORef a
    counter FileInfo
    fi
        | FileType
    FTNormal <- FileInfo -> FileType
    fileType FileInfo
    fi
        , Right Text
    path <- ByteString -> Either UnicodeException Text
    decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> ByteString -> Either UnicodeException Text
    forall a b. (a -> b) -> a -> b
    $ FileInfo -> ByteString
    filePath FileInfo
    fi
        , Just (PackageName
    name, Version
    version, Text
    filename) <- Text -> Maybe (PackageName, Version, Text)
    forall {a} {b}. (Parsec a, Parsec b) => Text -> Maybe (a, b, Text)
    parseNameVersionSuffix Text
    path =
            if
              | Text
    filename Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "package.json" ->
                  ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    forall (m :: * -> *) lazy strict o.
    (Monad m, LazySequence lazy strict) =>
    ConduitT strict o m lazy
    sinkLazy ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    -> (ByteString
        -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a b.
    ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    -> (a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) b)
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString o m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT SqlBackend (RIO env) ()
     -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> (ByteString -> ReaderT SqlBackend (RIO env) ())
    -> ByteString
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    forall {env}.
    HasLogFunc env =>
    PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    addJSON PackageName
    name Version
    version
              | Text
    filename Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeFilePath -> Text
    unSafeFilePath (PackageName -> SafeFilePath
    cabalFileName PackageName
    name) -> do
                  ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    forall (m :: * -> *) lazy strict o.
    (Monad m, LazySequence lazy strict) =>
    ConduitT strict o m lazy
    sinkLazy ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    -> (ByteString
        -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a b.
    ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    -> (a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) b)
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString o m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT SqlBackend (RIO env) ()
     -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> (ByteString -> ReaderT SqlBackend (RIO env) ())
    -> ByteString
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    forall {env}.
    PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    addCabal PackageName
    name Version
    version) (ByteString
     -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> (ByteString -> ByteString)
    -> ByteString
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.toStrict
                  count <- IORef a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef a
    counter
                  let count' = a
    count a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
                  writeIORef counter count'
                  when (count' `mod` 400 == 0) $
                    lift $ lift $
                    logSticky $ "Processed " <> display count' <> " cabal files"
              | Bool
    otherwise -> () -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a.
    a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        | FileType
    FTNormal <- FileInfo -> FileType
    fileType FileInfo
    fi
        , Right Text
    path <- ByteString -> Either UnicodeException Text
    decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> ByteString -> Either UnicodeException Text
    forall a b. (a -> b) -> a -> b
    $ FileInfo -> ByteString
    filePath FileInfo
    fi
        , (Text
    nameT, Text
    "/preferred-versions") <- (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') Text
    path
        , Just PackageName
    name <- FilePath -> Maybe PackageName
    parsePackageName (FilePath -> Maybe PackageName) -> FilePath -> Maybe PackageName
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    nameT = do
            lbs <- ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    forall (m :: * -> *) lazy strict o.
    (Monad m, LazySequence lazy strict) =>
    ConduitT strict o m lazy
    sinkLazy
            case decodeUtf8' $ BL.toStrict lbs of
              Left UnicodeException
    _ -> () -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a.
    a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure () -- maybe warning

              Right Text
    p -> ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString o m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT SqlBackend (RIO env) ()
     -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a b. (a -> b) -> a -> b
    $ PackageName -> Text -> ReaderT SqlBackend (RIO env) ()
    forall env. PackageName -> Text -> ReaderT SqlBackend (RIO env) ()
    storePreferredVersion PackageName
    name Text
    p
        | Bool
    otherwise = () -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a.
    a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

      addJSON :: PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    addJSON PackageName
    name Version
    version ByteString
    lbs =
        case ByteString -> Either FilePath PackageDownload
    forall a. FromJSON a => ByteString -> Either FilePath a
    eitherDecode' ByteString
    lbs of
          Left FilePath
    e -> RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env () -> ReaderT SqlBackend (RIO env) ())
    -> RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logError (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
            Utf8Builder
    "Error: [S-563]\n"
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "Error processing Hackage security metadata for "
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (PackageName -> FilePath
    forall a. Pretty a => a -> FilePath
    Distribution.Text.display PackageName
    name) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "-"
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Version -> FilePath
    forall a. Pretty a => a -> FilePath
    Distribution.Text.display Version
    version) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ": "
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString FilePath
    e
          Right (PackageDownload SHA256
    sha Word
    size) ->
            PackageName
    -> Version -> SHA256 -> FileSize -> ReaderT SqlBackend (RIO env) ()
    forall env.
    PackageName
    -> Version -> SHA256 -> FileSize -> ReaderT SqlBackend (RIO env) ()
    storeHackageTarballInfo PackageName
    name Version
    version SHA256
    sha (FileSize -> ReaderT SqlBackend (RIO env) ())
    -> FileSize -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ Word -> FileSize
    FileSize Word
    size

      addCabal :: PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    addCabal PackageName
    name Version
    version ByteString
    bs = do
        (blobTableId, _blobKey) <- ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    storeBlob ByteString
    bs

        storeHackageRevision name version blobTableId

      breakSlash :: Text -> Maybe (Text, Text)
    breakSlash Text
    x
        | Text -> Bool
    T.null Text
    z = Maybe (Text, Text)
    forall a. Maybe a
    Nothing
        | Bool
    otherwise = (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    y, Text -> Text
    unsafeTail Text
    z)
       where
        (Text
    y, Text
    z) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') Text
    x

      parseNameVersionSuffix :: Text -> Maybe (a, b, Text)
    parseNameVersionSuffix Text
    t1 = do
        (name, t2) <- Text -> Maybe (Text, Text)
    breakSlash Text
    t1
        (version, filename) <- breakSlash t2

        name' <- Distribution.Text.simpleParse $ T.unpack name
        version' <- Distribution.Text.simpleParse $ T.unpack version

        Just (name', version', filename)

    -- | Package download info from Hackage

    data PackageDownload = PackageDownload !SHA256 !Word

    instance FromJSON PackageDownload where
      parseJSON :: Value -> Parser PackageDownload
    parseJSON = FilePath
    -> (Object -> Parser PackageDownload)
    -> Value
    -> Parser PackageDownload
    forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
    withObject FilePath
    "PackageDownload" ((Object -> Parser PackageDownload)
     -> Value -> Parser PackageDownload)
    -> (Object -> Parser PackageDownload)
    -> Value
    -> Parser PackageDownload
    forall a b. (a -> b) -> a -> b
    $ \Object
    o1 -> do
        o2 <- Object
    o1 Object -> Key -> Parser Object
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "signed"
        Object o3 <- o2 .: "targets"
        Object o4:_ <- pure $ toList o3
        len <- o4 .: "length"
        hashes <- o4 .: "hashes"
        sha256' <- hashes .: "sha256"
        sha256 <-
          case SHA256.fromHexText sha256' of
            Left SHA256Exception
    e -> FilePath -> Parser SHA256
    forall a. FilePath -> Parser a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Parser SHA256) -> FilePath -> Parser SHA256
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Invalid sha256: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ SHA256Exception -> FilePath
    forall a. Show a => a -> FilePath
    show SHA256Exception
    e
            Right SHA256
    x -> SHA256 -> Parser SHA256
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SHA256
    x
        pure $ PackageDownload sha256 len

    getHackageCabalFile ::
         (HasPantryConfig env, HasLogFunc env)
      => PackageIdentifierRevision
      -> RIO env ByteString
    getHackageCabalFile :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision PackageName
    _ Version
    _ CabalFileInfo
    cfi) = do
      bid <- PackageIdentifierRevision -> RIO env BlobId
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo PackageIdentifierRevision
    pir
      bs <- withStorage $ loadBlobById bid
      case cfi of
        CFIHash SHA256
    sha Maybe FileSize
    msize -> do
          let sizeMismatch :: Bool
    sizeMismatch =
                case Maybe FileSize
    msize of
                  Maybe FileSize
    Nothing -> Bool
    False
                  Just FileSize
    size -> Word -> FileSize
    FileSize (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    bs)) FileSize -> FileSize -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FileSize
    size
              shaMismatch :: Bool
    shaMismatch = SHA256
    sha SHA256 -> SHA256 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString -> SHA256
    SHA256.hashBytes ByteString
    bs
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    sizeMismatch Bool -> Bool -> Bool
    || Bool
    shaMismatch)
            (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> RIO env ()
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> RIO env ()) -> FilePath -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "getHackageCabalFile: size or SHA mismatch for " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (PackageIdentifierRevision, ByteString) -> FilePath
    forall a. Show a => a -> FilePath
    show (PackageIdentifierRevision
    pir, ByteString
    bs)
        CabalFileInfo
    _ -> () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      pure bs

    resolveCabalFileInfo ::
         (HasPantryConfig env, HasLogFunc env)
      => PackageIdentifierRevision
      -> RIO env BlobId
    resolveCabalFileInfo :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision PackageName
    name Version
    ver CabalFileInfo
    cfi) = do
      mres <- RIO env (Maybe BlobId)
    inner
      case mres of
        Just BlobId
    res -> BlobId -> RIO env BlobId
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BlobId
    res
        Maybe BlobId
    Nothing -> do
          updated <- Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndex (Maybe Utf8Builder -> RIO env DidUpdateOccur)
    -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> Maybe Utf8Builder
    forall a. a -> Maybe a
    Just
            (Utf8Builder -> Maybe Utf8Builder)
    -> Utf8Builder -> Maybe Utf8Builder
    forall a b. (a -> b) -> a -> b
    $  Utf8Builder
    "Cabal file info not found for "
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> PackageIdentifierRevision -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display PackageIdentifierRevision
    pir
            Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ", updating"
          mres' <-
            case updated of
              DidUpdateOccur
    UpdateOccurred -> RIO env (Maybe BlobId)
    inner
              DidUpdateOccur
    NoUpdateOccurred -> Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
          case mres' of
            Maybe BlobId
    Nothing -> PackageName -> Version -> RIO env FuzzyResults
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageName -> Version -> RIO env FuzzyResults
    fuzzyLookupCandidates PackageName
    name Version
    ver RIO env FuzzyResults
    -> (FuzzyResults -> RIO env BlobId) -> RIO env BlobId
    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
    >>= PantryException -> RIO env BlobId
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env BlobId)
    -> (FuzzyResults -> PantryException)
    -> FuzzyResults
    -> RIO env BlobId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageIdentifierRevision -> FuzzyResults -> PantryException
    UnknownHackagePackage PackageIdentifierRevision
    pir
            Just BlobId
    res -> BlobId -> RIO env BlobId
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BlobId
    res
     where
      inner :: RIO env (Maybe BlobId)
    inner =
        case CabalFileInfo
    cfi of
          CFIHash SHA256
    sha Maybe FileSize
    msize -> PackageIdentifierRevision
    -> SHA256 -> Maybe FileSize -> RIO env (Maybe BlobId)
    forall a env.
    (Display a, HasPantryConfig env, HasLogFunc env) =>
    a -> SHA256 -> Maybe FileSize -> RIO env (Maybe BlobId)
    loadOrDownloadBlobBySHA PackageIdentifierRevision
    pir SHA256
    sha Maybe FileSize
    msize
          CFIRevision Revision
    rev ->
            ((BlobId, BlobKey) -> BlobId)
    -> Maybe (BlobId, BlobKey) -> Maybe BlobId
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (BlobId, BlobKey) -> BlobId
    forall a b. (a, b) -> a
    fst (Maybe (BlobId, BlobKey) -> Maybe BlobId)
    -> (Map Revision (BlobId, BlobKey) -> Maybe (BlobId, BlobKey))
    -> Map Revision (BlobId, BlobKey)
    -> Maybe BlobId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Revision
    -> Map Revision (BlobId, BlobKey) -> Maybe (BlobId, BlobKey)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Revision
    rev (Map Revision (BlobId, BlobKey) -> Maybe BlobId)
    -> RIO env (Map Revision (BlobId, BlobKey))
    -> RIO env (Maybe BlobId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    -> RIO env (Map Revision (BlobId, BlobKey))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    loadHackagePackageVersion PackageName
    name Version
    ver)
          CabalFileInfo
    CFILatest ->
            (((BlobId, BlobKey), Map Revision (BlobId, BlobKey)) -> BlobId)
    -> Maybe ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
    -> Maybe BlobId
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((BlobId, BlobKey) -> BlobId
    forall a b. (a, b) -> a
    fst ((BlobId, BlobKey) -> BlobId)
    -> (((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
        -> (BlobId, BlobKey))
    -> ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
    -> BlobId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
    -> (BlobId, BlobKey)
    forall a b. (a, b) -> a
    fst) (Maybe ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
     -> Maybe BlobId)
    -> (Map Revision (BlobId, BlobKey)
        -> Maybe ((BlobId, BlobKey), Map Revision (BlobId, BlobKey)))
    -> Map Revision (BlobId, BlobKey)
    -> Maybe BlobId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Revision (BlobId, BlobKey)
    -> Maybe ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
    forall k a. Map k a -> Maybe (a, Map k a)
    Map.maxView (Map Revision (BlobId, BlobKey) -> Maybe BlobId)
    -> RIO env (Map Revision (BlobId, BlobKey))
    -> RIO env (Maybe BlobId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    -> RIO env (Map Revision (BlobId, BlobKey))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    loadHackagePackageVersion PackageName
    name Version
    ver)

    -- | Load or download a blob by its SHA.

    loadOrDownloadBlobBySHA ::
         (Display a, HasPantryConfig env, HasLogFunc env)
      => a
      -> SHA256
      -> Maybe FileSize
      -> RIO env (Maybe BlobId)
    loadOrDownloadBlobBySHA :: forall a env.
    (Display a, HasPantryConfig env, HasLogFunc env) =>
    a -> SHA256 -> Maybe FileSize -> RIO env (Maybe BlobId)
    loadOrDownloadBlobBySHA a
    label SHA256
    sha256 Maybe FileSize
    msize = do
      mresult <- RIO env (Maybe BlobId)
    byDB
      case mresult of
        Maybe BlobId
    Nothing -> do
          case Maybe FileSize
    msize of
            Maybe FileSize
    Nothing -> do
              Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
            Just FileSize
    size -> do
              mblob <- BlobKey -> RIO env (Maybe ByteString)
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    BlobKey -> RIO env (Maybe ByteString)
    casaLookupKey (SHA256 -> FileSize -> BlobKey
    BlobKey SHA256
    sha256 FileSize
    size)
              case mblob of
                Maybe ByteString
    Nothing -> do
                  Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
                Just {} -> do
                  result <- RIO env (Maybe BlobId)
    byDB
                  case result of
                    Just BlobId
    blobId -> do
                      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder
    "Pulled blob from Casa for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    label)
                      Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BlobId -> Maybe BlobId
    forall a. a -> Maybe a
    Just BlobId
    blobId)
                    Maybe BlobId
    Nothing -> do
                      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                        (Utf8Builder
    "Bug? Blob pulled from Casa not in database for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                         a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    label)
                      Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
        Just BlobId
    blobId -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder
    "Got blob from Pantry database for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    label)
          Maybe BlobId -> RIO env (Maybe BlobId)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BlobId -> Maybe BlobId
    forall a. a -> Maybe a
    Just BlobId
    blobId)
     where
      byDB :: RIO env (Maybe BlobId)
    byDB = ReaderT SqlBackend (RIO env) (Maybe BlobId)
    -> RIO env (Maybe BlobId)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe BlobId)
     -> RIO env (Maybe BlobId))
    -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    -> RIO env (Maybe BlobId)
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    forall env. SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    loadBlobBySHA SHA256
    sha256

    -- | Given package identifier and package caches, return list of packages with

    -- the same name and the same two first version number components found in the

    -- caches.

    fuzzyLookupCandidates ::
         (HasPantryConfig env, HasLogFunc env)
      => PackageName
      -> Version
      -> RIO env FuzzyResults
    fuzzyLookupCandidates :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageName -> Version -> RIO env FuzzyResults
    fuzzyLookupCandidates PackageName
    name Version
    ver0 = do
      m <- RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions RequireHackageIndex
    YesRequireHackageIndex UsePreferredVersions
    UsePreferredVersions PackageName
    name
      if Map.null m
        then FRNameNotFound <$> getHackageTypoCorrections name
        else
          case Map.lookup ver0 m of
            Maybe (Map Revision BlobKey)
    Nothing -> do
              let withVers :: NonEmpty (Version, Map k BlobKey) -> f FuzzyResults
    withVers NonEmpty (Version, Map k BlobKey)
    vers = FuzzyResults -> f FuzzyResults
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FuzzyResults -> f FuzzyResults) -> FuzzyResults -> f FuzzyResults
    forall a b. (a -> b) -> a -> b
    $ NonEmpty PackageIdentifierRevision -> FuzzyResults
    FRVersionNotFound (NonEmpty PackageIdentifierRevision -> FuzzyResults)
    -> NonEmpty PackageIdentifierRevision -> FuzzyResults
    forall a b. (a -> b) -> a -> b
    $ (((Version, Map k BlobKey) -> PackageIdentifierRevision)
     -> NonEmpty (Version, Map k BlobKey)
     -> NonEmpty PackageIdentifierRevision)
    -> NonEmpty (Version, Map k BlobKey)
    -> ((Version, Map k BlobKey) -> PackageIdentifierRevision)
    -> NonEmpty PackageIdentifierRevision
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Version, Map k BlobKey) -> PackageIdentifierRevision)
    -> NonEmpty (Version, Map k BlobKey)
    -> NonEmpty PackageIdentifierRevision
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    NE.map NonEmpty (Version, Map k BlobKey)
    vers (((Version, Map k BlobKey) -> PackageIdentifierRevision)
     -> NonEmpty PackageIdentifierRevision)
    -> ((Version, Map k BlobKey) -> PackageIdentifierRevision)
    -> NonEmpty PackageIdentifierRevision
    forall a b. (a -> b) -> a -> b
    $ \(Version
    ver, Map k BlobKey
    revs) ->
                    case Map k BlobKey -> Maybe (BlobKey, Map k BlobKey)
    forall k a. Map k a -> Maybe (a, Map k a)
    Map.maxView Map k BlobKey
    revs of
                      Maybe (BlobKey, Map k BlobKey)
    Nothing -> FilePath -> PackageIdentifierRevision
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "fuzzyLookupCandidates: no revisions"
                      Just (BlobKey SHA256
    sha FileSize
    size, Map k BlobKey
    _) ->
                        PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    ver (SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size))
              case [(Version, Map Revision BlobKey)]
    -> Maybe (NonEmpty (Version, Map Revision BlobKey))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([(Version, Map Revision BlobKey)]
     -> Maybe (NonEmpty (Version, Map Revision BlobKey)))
    -> [(Version, Map Revision BlobKey)]
    -> Maybe (NonEmpty (Version, Map Revision BlobKey))
    forall a b. (a -> b) -> a -> b
    $ ((Version, Map Revision BlobKey) -> Bool)
    -> [(Version, Map Revision BlobKey)]
    -> [(Version, Map Revision BlobKey)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Version -> Bool
    sameMajor (Version -> Bool)
    -> ((Version, Map Revision BlobKey) -> Version)
    -> (Version, Map Revision BlobKey)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Version, Map Revision BlobKey) -> Version
    forall a b. (a, b) -> a
    fst) ([(Version, Map Revision BlobKey)]
     -> [(Version, Map Revision BlobKey)])
    -> [(Version, Map Revision BlobKey)]
    -> [(Version, Map Revision BlobKey)]
    forall a b. (a -> b) -> a -> b
    $ Map Version (Map Revision BlobKey)
    -> [(Version, Map Revision BlobKey)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Version (Map Revision BlobKey)
    m of
                Just NonEmpty (Version, Map Revision BlobKey)
    vers -> NonEmpty (Version, Map Revision BlobKey) -> RIO env FuzzyResults
    forall {f :: * -> *} {k}.
    Applicative f =>
    NonEmpty (Version, Map k BlobKey) -> f FuzzyResults
    withVers NonEmpty (Version, Map Revision BlobKey)
    vers
                Maybe (NonEmpty (Version, Map Revision BlobKey))
    Nothing ->
                  case [(Version, Map Revision BlobKey)]
    -> Maybe (NonEmpty (Version, Map Revision BlobKey))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([(Version, Map Revision BlobKey)]
     -> Maybe (NonEmpty (Version, Map Revision BlobKey)))
    -> [(Version, Map Revision BlobKey)]
    -> Maybe (NonEmpty (Version, Map Revision BlobKey))
    forall a b. (a -> b) -> a -> b
    $ Map Version (Map Revision BlobKey)
    -> [(Version, Map Revision BlobKey)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Version (Map Revision BlobKey)
    m of
                    Maybe (NonEmpty (Version, Map Revision BlobKey))
    Nothing -> FilePath -> RIO env FuzzyResults
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "fuzzyLookupCandidates: no versions"
                    Just NonEmpty (Version, Map Revision BlobKey)
    vers -> NonEmpty (Version, Map Revision BlobKey) -> RIO env FuzzyResults
    forall {f :: * -> *} {k}.
    Applicative f =>
    NonEmpty (Version, Map k BlobKey) -> f FuzzyResults
    withVers NonEmpty (Version, Map Revision BlobKey)
    vers
            Just Map Revision BlobKey
    revisions ->
              let pirs :: [PackageIdentifierRevision]
    pirs = (BlobKey -> PackageIdentifierRevision)
    -> [BlobKey] -> [PackageIdentifierRevision]
    forall a b. (a -> b) -> [a] -> [b]
    map
                    (\(BlobKey SHA256
    sha FileSize
    size) ->
                      PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    ver0 (SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size)))
                    (Map Revision BlobKey -> [BlobKey]
    forall k a. Map k a -> [a]
    Map.elems Map Revision BlobKey
    revisions)
               in case [PackageIdentifierRevision]
    -> Maybe (NonEmpty PackageIdentifierRevision)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [PackageIdentifierRevision]
    pirs of
                    Maybe (NonEmpty PackageIdentifierRevision)
    Nothing -> FilePath -> RIO env FuzzyResults
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "fuzzyLookupCandidates: no revisions"
                    Just NonEmpty PackageIdentifierRevision
    pirs' -> FuzzyResults -> RIO env FuzzyResults
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FuzzyResults -> RIO env FuzzyResults)
    -> FuzzyResults -> RIO env FuzzyResults
    forall a b. (a -> b) -> a -> b
    $ NonEmpty PackageIdentifierRevision -> FuzzyResults
    FRRevisionNotFound NonEmpty PackageIdentifierRevision
    pirs'
     where
      sameMajor :: Version -> Bool
    sameMajor Version
    v = Version -> [Int]
    toMajorVersion Version
    v [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version -> [Int]
    toMajorVersion Version
    ver0

    toMajorVersion :: Version -> [Int]
    toMajorVersion :: Version -> [Int]
    toMajorVersion Version
    v =
      case Version -> [Int]
    versionNumbers Version
    v of
        []    -> [Int
    0, Int
    0]
        [Int
    a]   -> [Int
    a, Int
    0]
        Int
    a:Int
    b:[Int]
    _ -> [Int
    a, Int
    b]

    -- | Try to come up with typo corrections for given package identifier using

    -- Hackage package names. This can provide more user-friendly information in

    -- error messages.

    --

    -- @since 0.1.0.0

    getHackageTypoCorrections ::
         (HasPantryConfig env, HasLogFunc env)
      => PackageName
      -> RIO env [PackageName]
    getHackageTypoCorrections :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageName -> RIO env [PackageName]
    getHackageTypoCorrections PackageName
    name1 =
      ReaderT SqlBackend (RIO env) [PackageName] -> RIO env [PackageName]
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) [PackageName]
     -> RIO env [PackageName])
    -> ReaderT SqlBackend (RIO env) [PackageName]
    -> RIO env [PackageName]
    forall a b. (a -> b) -> a -> b
    $ (PackageName -> Bool)
    -> ConduitT
         PackageName Void (ReaderT SqlBackend (RIO env)) [PackageName]
    -> ReaderT SqlBackend (RIO env) [PackageName]
    forall env a.
    (PackageName -> Bool)
    -> ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    -> ReaderT SqlBackend (RIO env) a
    sinkHackagePackageNames
        (\PackageName
    name2 -> PackageName
    name1 PackageName -> PackageName -> Int
    `distance` PackageName
    name2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    4)
        (Int
    -> ConduitT
         PackageName PackageName (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
    takeC Int
    10 ConduitT PackageName PackageName (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT
         PackageName Void (ReaderT SqlBackend (RIO env)) [PackageName]
    -> ConduitT
         PackageName Void (ReaderT SqlBackend (RIO env)) [PackageName]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT
      PackageName Void (ReaderT SqlBackend (RIO env)) [PackageName]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    sinkList)
     where
      distance :: PackageName -> PackageName -> Int
    distance = Text -> Text -> Int
    damerauLevenshtein (Text -> Text -> Int)
    -> (PackageName -> Text) -> PackageName -> PackageName -> Int
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (FilePath -> Text
    T.pack (FilePath -> Text)
    -> (PackageName -> FilePath) -> PackageName -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName -> FilePath
    packageNameString)

    -- | Should we pay attention to Hackage's preferred versions?

    --

    -- @since 0.1.0.0

    data UsePreferredVersions
      = UsePreferredVersions
      | IgnorePreferredVersions
      deriving Int -> UsePreferredVersions -> FilePath -> FilePath
    [UsePreferredVersions] -> FilePath -> FilePath
    UsePreferredVersions -> FilePath
    (Int -> UsePreferredVersions -> FilePath -> FilePath)
    -> (UsePreferredVersions -> FilePath)
    -> ([UsePreferredVersions] -> FilePath -> FilePath)
    -> Show UsePreferredVersions
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> UsePreferredVersions -> FilePath -> FilePath
    showsPrec :: Int -> UsePreferredVersions -> FilePath -> FilePath
    $cshow :: UsePreferredVersions -> FilePath
    show :: UsePreferredVersions -> FilePath
    $cshowList :: [UsePreferredVersions] -> FilePath -> FilePath
    showList :: [UsePreferredVersions] -> FilePath -> FilePath
    Show

    -- | Require that the Hackage index is populated.

    --

    -- @since 0.1.0.0

    data RequireHackageIndex
      = YesRequireHackageIndex
        -- ^ If there is nothing in the Hackage index, then perform an update

      | NoRequireHackageIndex
        -- ^ Do not perform an update

      deriving Int -> RequireHackageIndex -> FilePath -> FilePath
    [RequireHackageIndex] -> FilePath -> FilePath
    RequireHackageIndex -> FilePath
    (Int -> RequireHackageIndex -> FilePath -> FilePath)
    -> (RequireHackageIndex -> FilePath)
    -> ([RequireHackageIndex] -> FilePath -> FilePath)
    -> Show RequireHackageIndex
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> RequireHackageIndex -> FilePath -> FilePath
    showsPrec :: Int -> RequireHackageIndex -> FilePath -> FilePath
    $cshow :: RequireHackageIndex -> FilePath
    show :: RequireHackageIndex -> FilePath
    $cshowList :: [RequireHackageIndex] -> FilePath -> FilePath
    showList :: [RequireHackageIndex] -> FilePath -> FilePath
    Show

    initializeIndex ::
         (HasPantryConfig env, HasLogFunc env)
      => RequireHackageIndex
      -> RIO env ()
    initializeIndex :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex -> RIO env ()
    initializeIndex RequireHackageIndex
    NoRequireHackageIndex = () -> RIO env ()
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    initializeIndex RequireHackageIndex
    YesRequireHackageIndex = do
      cabalCount <- ReaderT SqlBackend (RIO env) Int -> RIO env Int
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage ReaderT SqlBackend (RIO env) Int
    forall env. ReaderT SqlBackend (RIO env) Int
    countHackageCabals
      when (cabalCount == 0) $ void $
        updateHackageIndex $ Just "No information from Hackage index, updating"

    -- | Returns the versions of the package available on Hackage.

    --

    -- @since 0.1.0.0

    getHackagePackageVersions ::
         (HasPantryConfig env, HasLogFunc env)
      => RequireHackageIndex
      -> UsePreferredVersions
      -> PackageName -- ^ package name

      -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions RequireHackageIndex
    req UsePreferredVersions
    usePreferred PackageName
    name = do
      RequireHackageIndex -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex -> RIO env ()
    initializeIndex RequireHackageIndex
    req
      ReaderT SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    -> RIO env (Map Version (Map Revision BlobKey))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
     -> RIO env (Map Version (Map Revision BlobKey)))
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    -> RIO env (Map Version (Map Revision BlobKey))
    forall a b. (a -> b) -> a -> b
    $ do
        mpreferred <-
          case UsePreferredVersions
    usePreferred of
            UsePreferredVersions
    UsePreferredVersions -> PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    loadPreferredVersion PackageName
    name
            UsePreferredVersions
    IgnorePreferredVersions -> Maybe Text -> ReaderT SqlBackend (RIO env) (Maybe Text)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Text
    forall a. Maybe a
    Nothing
        let predicate :: Version -> Map Revision BlobKey -> Bool
            predicate = (Version -> Map Revision BlobKey -> Bool)
    -> Maybe (Version -> Map Revision BlobKey -> Bool)
    -> Version
    -> Map Revision BlobKey
    -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe (\Version
    _ Map Revision BlobKey
    _ -> Bool
    True) (Maybe (Version -> Map Revision BlobKey -> Bool)
     -> Version -> Map Revision BlobKey -> Bool)
    -> Maybe (Version -> Map Revision BlobKey -> Bool)
    -> Version
    -> Map Revision BlobKey
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
              preferredT1 <- Maybe Text
    mpreferred
              preferredT2 <- T.stripPrefix (T.pack $ packageNameString name) preferredT1
              vr <- Distribution.Text.simpleParse $ T.unpack preferredT2
              Just $ \Version
    v Map Revision BlobKey
    _ -> Version -> VersionRange -> Bool
    withinRange Version
    v VersionRange
    vr
        Map.filterWithKey predicate <$> loadHackagePackageVersions name

    -- | Returns the versions of the package available on Hackage.

    --

    -- @since 0.1.0.0

    getHackagePackageVersionRevisions ::
         (HasPantryConfig env, HasLogFunc env)
      => RequireHackageIndex
      -> PackageName -- ^ package name

      -> Version -- ^ package version

      -> RIO env (Map Revision BlobKey)
    getHackagePackageVersionRevisions :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> PackageName -> Version -> RIO env (Map Revision BlobKey)
    getHackagePackageVersionRevisions RequireHackageIndex
    req PackageName
    name Version
    version = do
      RequireHackageIndex -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex -> RIO env ()
    initializeIndex RequireHackageIndex
    req
      ReaderT SqlBackend (RIO env) (Map Revision BlobKey)
    -> RIO env (Map Revision BlobKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Map Revision BlobKey)
     -> RIO env (Map Revision BlobKey))
    -> ReaderT SqlBackend (RIO env) (Map Revision BlobKey)
    -> RIO env (Map Revision BlobKey)
    forall a b. (a -> b) -> a -> b
    $
        ((BlobId, BlobKey) -> BlobKey)
    -> Map Revision (BlobId, BlobKey) -> Map Revision BlobKey
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (BlobId, BlobKey) -> BlobKey
    forall a b. (a, b) -> b
    snd (Map Revision (BlobId, BlobKey) -> Map Revision BlobKey)
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    -> ReaderT SqlBackend (RIO env) (Map Revision BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, BlobKey))
    loadHackagePackageVersion PackageName
    name Version
    version

    withCachedTree ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> PackageName
      -> Version
      -> BlobId -- ^ cabal file contents

      -> RIO env HackageTarballResult
      -> RIO env HackageTarballResult
    withCachedTree :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> BlobId
    -> RIO env HackageTarballResult
    -> RIO env HackageTarballResult
    withCachedTree RawPackageLocationImmutable
    rpli PackageName
    name Version
    ver BlobId
    bid RIO env HackageTarballResult
    inner = do
      mres <- ReaderT SqlBackend (RIO env) (Maybe Package)
    -> RIO env (Maybe Package)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe Package)
     -> RIO env (Maybe Package))
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    -> RIO env (Maybe Package)
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> BlobId
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> BlobId
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    loadHackageTree RawPackageLocationImmutable
    rpli PackageName
    name Version
    ver BlobId
    bid
      case mres of
        Just Package
    package -> HackageTarballResult -> RIO env HackageTarballResult
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HackageTarballResult -> RIO env HackageTarballResult)
    -> HackageTarballResult -> RIO env HackageTarballResult
    forall a b. (a -> b) -> a -> b
    $ Package
    -> Maybe (GenericPackageDescription, TreeId)
    -> HackageTarballResult
    HackageTarballResult Package
    package Maybe (GenericPackageDescription, TreeId)
    forall a. Maybe a
    Nothing
        Maybe Package
    Nothing -> do
          htr <- RIO env HackageTarballResult
    inner
          withStorage $
            storeHackageTree name ver bid $ packageTreeKey $ htrPackage htr
          pure htr

    getHackageTarballKey ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageIdentifierRevision
      -> RIO env TreeKey
    getHackageTarballKey :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision PackageName
    name Version
    ver (CFIHash SHA256
    sha Maybe FileSize
    _msize)) = do
      mres <- ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    -> RIO env (Maybe TreeKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe TreeKey)
     -> RIO env (Maybe TreeKey))
    -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    -> RIO env (Maybe TreeKey)
    forall a b. (a -> b) -> a -> b
    $ PackageName
    -> Version
    -> SHA256
    -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall env.
    PackageName
    -> Version
    -> SHA256
    -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    loadHackageTreeKey PackageName
    name Version
    ver SHA256
    sha
      case mres of
        Maybe TreeKey
    Nothing -> Package -> TreeKey
    packageTreeKey (Package -> TreeKey)
    -> (HackageTarballResult -> Package)
    -> HackageTarballResult
    -> TreeKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HackageTarballResult -> Package
    htrPackage (HackageTarballResult -> TreeKey)
    -> RIO env HackageTarballResult -> RIO env TreeKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball PackageIdentifierRevision
    pir Maybe TreeKey
    forall a. Maybe a
    Nothing
        Just TreeKey
    key -> TreeKey -> RIO env TreeKey
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TreeKey
    key
    getHackageTarballKey PackageIdentifierRevision
    pir =
      Package -> TreeKey
    packageTreeKey (Package -> TreeKey)
    -> (HackageTarballResult -> Package)
    -> HackageTarballResult
    -> TreeKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HackageTarballResult -> Package
    htrPackage (HackageTarballResult -> TreeKey)
    -> RIO env HackageTarballResult -> RIO env TreeKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball PackageIdentifierRevision
    pir Maybe TreeKey
    forall a. Maybe a
    Nothing

    getHackageTarball ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageIdentifierRevision
      -> Maybe TreeKey
      -> RIO env HackageTarballResult
    getHackageTarball :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball PackageIdentifierRevision
    pir Maybe TreeKey
    mtreeKey = do
      let PackageIdentifierRevision PackageName
    name Version
    ver CabalFileInfo
    _cfi = PackageIdentifierRevision
    pir
      cabalFile <- PackageIdentifierRevision -> RIO env BlobId
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo PackageIdentifierRevision
    pir
      let rpli = PackageIdentifierRevision
    -> Maybe TreeKey -> RawPackageLocationImmutable
    RPLIHackage PackageIdentifierRevision
    pir Maybe TreeKey
    mtreeKey
      withCachedTree rpli name ver cabalFile $ do
        cabalFileKey <- withStorage $ getBlobKey cabalFile
        mpair <- withStorage $ loadHackageTarballInfo name ver
        (sha, size) <-
          case mpair of
            Just (SHA256, FileSize)
    pair -> (SHA256, FileSize) -> RIO env (SHA256, FileSize)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256, FileSize)
    pair
            Maybe (SHA256, FileSize)
    Nothing -> do
              let exc :: PantryException
    exc = PackageIdentifier -> PantryException
    NoHackageCryptographicHash (PackageIdentifier -> PantryException)
    -> PackageIdentifier -> PantryException
    forall a b. (a -> b) -> a -> b
    $ PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    ver
              updated <- Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndex (Maybe Utf8Builder -> RIO env DidUpdateOccur)
    -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> Maybe Utf8Builder
    forall a. a -> Maybe a
    Just (Utf8Builder -> Maybe Utf8Builder)
    -> Utf8Builder -> Maybe Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ PantryException -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display PantryException
    exc Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ", updating"
              mpair2 <-
                case updated of
                  DidUpdateOccur
    UpdateOccurred -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    -> RIO env (Maybe (SHA256, FileSize))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
     -> RIO env (Maybe (SHA256, FileSize)))
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    -> RIO env (Maybe (SHA256, FileSize))
    forall a b. (a -> b) -> a -> b
    $ PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    loadHackageTarballInfo PackageName
    name Version
    ver
                  DidUpdateOccur
    NoUpdateOccurred -> Maybe (SHA256, FileSize) -> RIO env (Maybe (SHA256, FileSize))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (SHA256, FileSize)
    forall a. Maybe a
    Nothing
              case mpair2 of
                Maybe (SHA256, FileSize)
    Nothing -> PantryException -> RIO env (SHA256, FileSize)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc
                Just (SHA256, FileSize)
    pair2 -> (SHA256, FileSize) -> RIO env (SHA256, FileSize)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256, FileSize)
    pair2
        pc <- view pantryConfigL
        let urlPrefix = PackageIndexConfig -> Text
    picDownloadPrefix (PackageIndexConfig -> Text) -> PackageIndexConfig -> Text
    forall a b. (a -> b) -> a -> b
    $ PantryConfig -> PackageIndexConfig
    pcPackageIndex PantryConfig
    pc
            url =
              [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat
                [ Text
    urlPrefix
                , Text
    "package/"
                , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ PackageName -> FilePath
    forall a. Pretty a => a -> FilePath
    Distribution.Text.display PackageName
    name
                , Text
    "-"
                , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ Version -> FilePath
    forall a. Pretty a => a -> FilePath
    Distribution.Text.display Version
    ver
                , Text
    ".tar.gz"
                ]
        (_, _, package, cachedTree) <-
          getArchive
            rpli
            RawArchive
              { raLocation = ALUrl url
              , raHash = Just sha
              , raSize = Just size
              , raSubdir = T.empty -- no subdirs on Hackage

              }
            RawPackageMetadata
              { rpmName = Just name
              , rpmVersion = Just ver
              , rpmTreeKey = Nothing -- with a revision cabal file will differ

                                     -- giving a different tree

              }
        case cachedTree of
          CachedTreeMap Map SafeFilePath (TreeEntry, BlobId)
    m -> do
            let ft :: FileType
    ft =
                  case Package -> PackageCabal
    packageCabalEntry Package
    package of
                    PCCabalFile (TreeEntry BlobKey
    _ FileType
    ft') -> FileType
    ft'
                    PackageCabal
    _ -> FilePath -> FileType
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Impossible: Hackage does not support hpack"
                cabalEntry :: TreeEntry
    cabalEntry = BlobKey -> FileType -> TreeEntry
    TreeEntry BlobKey
    cabalFileKey FileType
    ft
            (cabalBS, cabalBlobId) <-
              ReaderT SqlBackend (RIO env) (ByteString, BlobId)
    -> RIO env (ByteString, BlobId)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (ByteString, BlobId)
     -> RIO env (ByteString, BlobId))
    -> ReaderT SqlBackend (RIO env) (ByteString, BlobId)
    -> RIO env (ByteString, BlobId)
    forall a b. (a -> b) -> a -> b
    $ do
                let BlobKey SHA256
    sha' FileSize
    _ = BlobKey
    cabalFileKey
                mcabalBS <- SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    forall env. SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    loadBlobBySHA SHA256
    sha'
                case mcabalBS of
                  Maybe BlobId
    Nothing ->
                    FilePath -> ReaderT SqlBackend (RIO env) (ByteString, BlobId)
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ReaderT SqlBackend (RIO env) (ByteString, BlobId))
    -> FilePath -> ReaderT SqlBackend (RIO env) (ByteString, BlobId)
    forall a b. (a -> b) -> a -> b
    $
                    FilePath
    "Invariant violated, cabal file key: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ BlobKey -> FilePath
    forall a. Show a => a -> FilePath
    show BlobKey
    cabalFileKey
                  Just BlobId
    bid -> (, BlobId
    bid) (ByteString -> (ByteString, BlobId))
    -> ReaderT SqlBackend (RIO env) ByteString
    -> ReaderT SqlBackend (RIO env) (ByteString, BlobId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlobId -> ReaderT SqlBackend (RIO env) ByteString
    forall env. BlobId -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById BlobId
    bid
            let tree' = Map SafeFilePath (TreeEntry, BlobId) -> CachedTree
    CachedTreeMap (Map SafeFilePath (TreeEntry, BlobId) -> CachedTree)
    -> Map SafeFilePath (TreeEntry, BlobId) -> CachedTree
    forall a b. (a -> b) -> a -> b
    $
                          SafeFilePath
    -> (TreeEntry, BlobId)
    -> Map SafeFilePath (TreeEntry, BlobId)
    -> Map SafeFilePath (TreeEntry, BlobId)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (PackageName -> SafeFilePath
    cabalFileName PackageName
    name) (TreeEntry
    cabalEntry, BlobId
    cabalBlobId) Map SafeFilePath (TreeEntry, BlobId)
    m
                ident = PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    ver
            (_warnings, gpd) <- rawParseGPD (Left rpli) cabalBS
            let gpdIdent = PackageDescription -> PackageIdentifier
    Cabal.package (PackageDescription -> PackageIdentifier)
    -> PackageDescription -> PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ GenericPackageDescription -> PackageDescription
    Cabal.packageDescription GenericPackageDescription
    gpd
            when (ident /= gpdIdent) $
              throwIO $
              MismatchedCabalFileForHackage
                pir
                Mismatch {mismatchExpected = ident, mismatchActual = gpdIdent}
            (tid, treeKey') <-
              withStorage $
              storeTree rpli ident tree' (BFCabal (cabalFileName name) cabalEntry)
            pure
              HackageTarballResult
                { htrPackage =
                    Package
                      { packageTreeKey = treeKey'
                      , packageTree = unCachedTree tree'
                      , packageIdent = ident
                      , packageCabalEntry = PCCabalFile cabalEntry
                      }
                , htrFreshPackageInfo = Just (gpd, tid)
                }