    {-# 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)

    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
    "00-index.tar"

    -- | 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
    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
      RIO env () -> RIO env DidUpdateOccur
    forall {m :: * -> *} {s} {b}.
    (MonadReader s m, HasPantryConfig s, MonadUnliftIO m) =>
    m b -> m DidUpdateOccur
    gateUpdate (RIO env () -> RIO env DidUpdateOccur)
    -> RIO env () -> RIO env DidUpdateOccur
    forall a b. (a -> b) -> a -> b
    $ Storage -> forall env a. HasLogFunc env => RIO env a -> RIO env a
    withWriteLock_ Storage
    storage (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe Utf8Builder -> (Utf8Builder -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe Utf8Builder
    mreason Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo
        PantryConfig
    pc <- Getting PantryConfig env PantryConfig -> RIO env PantryConfig
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting PantryConfig env PantryConfig
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL
        let PackageIndexConfig Text
    url (HackageSecurityConfig [Text]
    keyIds Int
    threshold Bool
    ignoreExpiry) = PantryConfig -> PackageIndexConfig
    pcPackageIndex PantryConfig
    pc
        Path Abs Dir
    root <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (Path Abs Dir) env (Path Abs Dir)
    forall env. HasPantryConfig env => SimpleGetter env (Path Abs Dir)
    SimpleGetter env (Path Abs Dir)
    hackageDirL
        Path Abs File
    tarball <- Getting (Path Abs File) env (Path Abs File)
    -> RIO env (Path Abs File)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (Path Abs File) env (Path Abs File)
    forall env. HasPantryConfig env => SimpleGetter env (Path Abs File)
    SimpleGetter env (Path Abs File)
    hackageIndexTarballL
        URI
    baseURI <-
          case FilePath -> Maybe URI
    parseURI (FilePath -> Maybe URI) -> FilePath -> Maybe URI
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    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
        RIO env () -> IO ()
    run <- RIO env (RIO env () -> IO ())
    forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
    askRunInIO
        let logTUF :: LogMessage -> IO ()
    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 :: (Repository RemoteTemp -> IO a) -> IO a
    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
        HasUpdates
    didUpdate <- IO HasUpdates -> RIO env HasUpdates
    forall a. IO a -> RIO env a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO HasUpdates -> RIO env HasUpdates)
    -> IO HasUpdates -> RIO env HasUpdates
    forall a b. (a -> b) -> a -> b
    $ (Repository RemoteTemp -> IO HasUpdates) -> IO HasUpdates
    forall {a}. (Repository RemoteTemp -> IO a) -> IO a
    withRepo ((Repository RemoteTemp -> IO HasUpdates) -> IO HasUpdates)
    -> (Repository RemoteTemp -> IO HasUpdates) -> IO HasUpdates
    forall a b. (a -> b) -> a -> b
    $ \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
          Bool
    needBootstrap <- Repository RemoteTemp -> IO Bool
    forall (down :: * -> *). Repository down -> IO Bool
    HS.requiresBootstrap Repository RemoteTemp
    repo
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    needBootstrap (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Repository RemoteTemp -> [KeyId] -> KeyThreshold -> IO ()
    forall (down :: * -> *).
    (Throws SomeRemoteError, Throws VerificationError) =>
    Repository down -> [KeyId] -> KeyThreshold -> IO ()
    HS.bootstrap
              Repository RemoteTemp
    repo
              ((Text -> KeyId) -> [Text] -> [KeyId]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> KeyId
    HS.KeyId (FilePath -> KeyId) -> (Text -> FilePath) -> Text -> KeyId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> FilePath
    T.unpack) [Text]
    keyIds)
              (Int54 -> KeyThreshold
    HS.KeyThreshold (Int54 -> KeyThreshold) -> Int54 -> KeyThreshold
    forall a b. (a -> b) -> a -> b
    $ Int -> Int54
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    threshold)
          Maybe UTCTime
    maybeNow <- if Bool
    ignoreExpiry
                        then Maybe UTCTime -> IO (Maybe UTCTime)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe UTCTime
    forall a. Maybe a
    Nothing
                        else UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO UTCTime
    getCurrentTime
          Repository RemoteTemp -> Maybe UTCTime -> IO HasUpdates
    forall (down :: * -> *).
    (Throws VerificationError, Throws SomeRemoteError) =>
    Repository down -> Maybe UTCTime -> IO HasUpdates
    HS.checkForUpdates Repository RemoteTemp
    repo Maybe UTCTime
    maybeNow

        case HasUpdates
    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
            Bool
    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 Bool
    x
              then do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "No package index update available, but didn't update cache last time, running now"
                Path Abs File -> RIO env ()
    forall {env}.
    (HasPantryConfig env, HasLogFunc env) =>
    Path Abs File -> RIO env ()
    updateCache Path Abs File
    tarball
              else Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "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
        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
    Utf8Builder -> m ()
    logStickyDone Utf8Builder
    "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
        Maybe (FileSize, SHA256)
    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 Maybe (FileSize, SHA256)
    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
            Word
    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
            Bool -> RIO env Bool
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool -> RIO env Bool) -> Bool -> RIO env Bool
    forall a b. (a -> b) -> a -> b
    $ Word
    cachedSize Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word
    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.

        Maybe (FileSize, SHA256)
    minfo <- ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    forall env. ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate
        (Word
    offset, SHA256
    newHash, Word
    newSize) <- RIO env (Word, SHA256, Word)
    -> ReaderT SqlBackend (RIO env) (Word, SHA256, Word)
    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 (Word, SHA256, Word)
     -> ReaderT SqlBackend (RIO env) (Word, SHA256, Word))
    -> RIO env (Word, SHA256, Word)
    -> ReaderT SqlBackend (RIO env) (Word, SHA256, Word)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> IOMode
    -> (Handle -> RIO env (Word, SHA256, Word))
    -> RIO env (Word, SHA256, Word)
    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
    tarball) IOMode
    ReadMode ((Handle -> RIO env (Word, SHA256, Word))
     -> RIO env (Word, SHA256, Word))
    -> (Handle -> RIO env (Word, SHA256, Word))
    -> RIO env (Word, SHA256, Word)
    forall a b. (a -> b) -> a -> b
    $ \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"

          Word
    newSize <- Handle -> RIO env Word
    forall (m :: * -> *). MonadIO m => Handle -> m Word
    getTarballSize Handle
    h
          let sinkSHA256 :: a -> ConduitT ByteString c m SHA256
    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 Maybe (FileSize, SHA256)
    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"
              SHA256
    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
              (Word, SHA256, Word) -> RIO env (Word, SHA256, Word)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word
    0, SHA256
    newHash, Word
    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.

              (SHA256
    oldHashCheck, SHA256
    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)
                                                                               )
              Word
    offset <-
                if SHA256
    oldHash SHA256 -> SHA256 -> Bool
    forall a. Eq a => a -> a -> Bool
    == SHA256
    oldHashCheck
                  then Word
    oldSize Word -> RIO env () -> RIO env Word
    forall a b. a -> RIO env b -> RIO env a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo Utf8Builder
    "Updating preexisting cache, should be quick"
                  else Word
    0 Word -> RIO env () -> RIO env Word
    forall a b. a -> RIO env b -> RIO env a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ do
                    Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ [Utf8Builder] -> Utf8Builder
    forall a. Monoid a => [a] -> a
    mconcat [
                      Utf8Builder
    "Package index change detected, that's pretty unusual: "
                      , Utf8Builder
    "\n    Old size: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Word -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Word
    oldSize
                      , Utf8Builder
    "\n    Old hash (orig) : " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SHA256 -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SHA256
    oldHash
                      , Utf8Builder
    "\n    New hash (check): " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SHA256 -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SHA256
    oldHashCheck
                      , Utf8Builder
    "\n    Forcing a recache"
                      ]
              (Word, SHA256, Word) -> RIO env (Word, SHA256, Word)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word
    offset, SHA256
    newHash, Word
    newSize)

        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 -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
             Utf8Builder
    "Populating cache from file size "
          Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Word -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Word
    newSize
          Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ", hash "
          Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SHA256 -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SHA256
    newHash
        Bool
    -> ReaderT SqlBackend (RIO env) ()
    -> ReaderT SqlBackend (RIO env) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word
    offset Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    0) ReaderT SqlBackend (RIO env) ()
    forall env. ReaderT SqlBackend (RIO env) ()
    clearHackageRevisions
        Path Abs File -> Integer -> ReaderT SqlBackend (RIO env) ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Path Abs File -> Integer -> ReaderT SqlBackend (RIO env) ()
    populateCache Path Abs File
    tarball (Word -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    offset) ReaderT SqlBackend (RIO env) ()
    -> ReaderT SqlBackend (RIO env) ()
    -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
    `onException`
          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 (Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
    Utf8Builder -> m ()
    logStickyDone Utf8Builder
    "Failed populating package index cache")
        FileSize -> SHA256 -> ReaderT SqlBackend (RIO env) ()
    forall env. FileSize -> SHA256 -> ReaderT SqlBackend (RIO env) ()
    storeCacheUpdate (Word -> FileSize
    FileSize Word
    newSize) SHA256
    newHash
      gateUpdate :: m b -> m DidUpdateOccur
    gateUpdate m b
    inner = do
        PantryConfig
    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
        m (m DidUpdateOccur) -> m DidUpdateOccur
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (m (m DidUpdateOccur) -> m DidUpdateOccur)
    -> m (m DidUpdateOccur) -> m DidUpdateOccur
    forall a b. (a -> b) -> a -> b
    $ MVar Bool
    -> (Bool -> m (Bool, m DidUpdateOccur)) -> m (m DidUpdateOccur)
    forall (m :: * -> *) a b.
    MonadUnliftIO m =>
    MVar a -> (a -> m (a, b)) -> m b
    modifyMVar (PantryConfig -> MVar Bool
    pcUpdateRef PantryConfig
    pc) ((Bool -> m (Bool, m DidUpdateOccur)) -> m (m DidUpdateOccur))
    -> (Bool -> m (Bool, m DidUpdateOccur)) -> m (m DidUpdateOccur)
    forall a b. (a -> b) -> a -> b
    $ \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 ..."
      IORef Int
    counter <- Int -> ReaderT SqlBackend (RIO env) (IORef Int)
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef (Int
    0 :: Int)
      Handle -> SeekMode -> Integer -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *).
    MonadIO m =>
    Handle -> SeekMode -> Integer -> m ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek Integer
    offset
      ConduitT () Void (ReaderT SqlBackend (RIO env)) ()
    -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (ReaderT SqlBackend (RIO env)) ()
     -> ReaderT SqlBackend (RIO env) ())
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) ()
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> ConduitT () ByteString (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) i.
    MonadIO m =>
    Handle -> ConduitT i ByteString m ()
    sourceHandle Handle
    h ConduitT () ByteString (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT ByteString Void (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| (FileInfo
     -> ConduitT ByteString Void (ReaderT SqlBackend (RIO env)) ())
    -> ConduitT ByteString Void (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) o.
    MonadThrow m =>
    (FileInfo -> ConduitM ByteString o m ())
    -> ConduitM ByteString o m ()
    untar (IORef Int
    -> FileInfo
    -> ConduitT ByteString Void (ReaderT SqlBackend (RIO env)) ()
    forall {a} {env} {o}.
    (Integral a, HasLogFunc env, Display a) =>
    IORef a
    -> FileInfo
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    perFile IORef Int
    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
                  a
    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
    count a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
                  IORef a
    -> a -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
    writeIORef IORef a
    counter a
    count'
                  Bool
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    count' a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod` a
    400 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0) (ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
     -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ())
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a b. (a -> b) -> a -> 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)) ())
    -> ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall a b. (a -> b) -> a -> b
    $ 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, HasCallStack, MonadReader env m, HasLogFunc env) =>
    Utf8Builder -> m ()
    logSticky (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder
    "Processed " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    count' Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " 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
            ByteString
    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 ByteString -> Either UnicodeException Text
    decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> ByteString -> Either UnicodeException Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BL.toStrict ByteString
    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
        (BlobId
    blobTableId, BlobKey
    _blobKey) <- ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    storeBlob ByteString
    bs

        PackageName -> Version -> BlobId -> ReaderT SqlBackend (RIO env) ()
    forall env.
    PackageName -> Version -> BlobId -> ReaderT SqlBackend (RIO env) ()
    storeHackageRevision PackageName
    name Version
    version BlobId
    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
        (Text
    name, Text
    t2) <- Text -> Maybe (Text, Text)
    breakSlash Text
    t1
        (Text
    version, Text
    filename) <- Text -> Maybe (Text, Text)
    breakSlash Text
    t2

        a
    name' <- FilePath -> Maybe a
    forall a. Parsec a => FilePath -> Maybe a
    Distribution.Text.simpleParse (FilePath -> Maybe a) -> FilePath -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    name
        b
    version' <- FilePath -> Maybe b
    forall a. Parsec a => FilePath -> Maybe a
    Distribution.Text.simpleParse (FilePath -> Maybe b) -> FilePath -> Maybe b
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    version

        (a, b, Text) -> Maybe (a, b, Text)
    forall a. a -> Maybe a
    Just (a
    name', b
    version', Text
    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
        Object
    o2 <- Object
    o1 Object -> Key -> Parser Object
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "signed"
        Object Object
    o3 <- Object
    o2 Object -> Key -> Parser Value
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "targets"
        Object Object
    o4:[Value]
    _ <- [Value] -> Parser [Value]
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Value] -> Parser [Value]) -> [Value] -> Parser [Value]
    forall a b. (a -> b) -> a -> b
    $ Object -> [Value]
    forall a. KeyMap a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Object
    o3
        Word
    len <- Object
    o4 Object -> Key -> Parser Word
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "length"
        Object
    hashes <- Object
    o4 Object -> Key -> Parser Object
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "hashes"
        Text
    sha256' <- Object
    hashes Object -> Key -> Parser Text
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "sha256"
        SHA256
    sha256 <-
          case Text -> Either SHA256Exception SHA256
    SHA256.fromHexText Text
    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
        PackageDownload -> Parser PackageDownload
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageDownload -> Parser PackageDownload)
    -> PackageDownload -> Parser PackageDownload
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> Word -> PackageDownload
    PackageDownload SHA256
    sha256 Word
    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
      BlobId
    bid <- PackageIdentifierRevision -> RIO env BlobId
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo PackageIdentifierRevision
    pir
      ByteString
    bs <- ReaderT SqlBackend (RIO env) ByteString -> RIO env ByteString
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) ByteString -> RIO env ByteString)
    -> ReaderT SqlBackend (RIO env) ByteString -> RIO env ByteString
    forall a b. (a -> b) -> a -> b
    $ BlobId -> ReaderT SqlBackend (RIO env) ByteString
    forall env. BlobId -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById BlobId
    bid
      case CabalFileInfo
    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 ()
      ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    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
      Maybe BlobId
    mres <- RIO env (Maybe BlobId)
    inner
      case Maybe BlobId
    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
          DidUpdateOccur
    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"
          Maybe BlobId
    mres' <-
            case DidUpdateOccur
    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 Maybe BlobId
    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
      Maybe BlobId
    mresult <- RIO env (Maybe BlobId)
    byDB
      case Maybe BlobId
    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
              Maybe ByteString
    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 Maybe ByteString
    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
                  Maybe BlobId
    result <- RIO env (Maybe BlobId)
    byDB
                  case Maybe BlobId
    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
      Map Version (Map Revision BlobKey)
    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 Version (Map Revision BlobKey) -> Bool
    forall k a. Map k a -> Bool
    Map.null Map Version (Map Revision BlobKey)
    m
        then [PackageName] -> FuzzyResults
    FRNameNotFound ([PackageName] -> FuzzyResults)
    -> RIO env [PackageName] -> RIO env FuzzyResults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageName -> RIO env [PackageName]
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageName -> RIO env [PackageName]
    getHackageTypoCorrections PackageName
    name
        else
          case Version
    -> Map Version (Map Revision BlobKey)
    -> Maybe (Map Revision BlobKey)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Version
    ver0 Map Version (Map Revision BlobKey)
    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
      Int
    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
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    cabalCount Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ RIO env DidUpdateOccur -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env DidUpdateOccur -> RIO env ())
    -> RIO env DidUpdateOccur -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
        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
    "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
        Maybe Text
    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
    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
              Text
    preferredT1 <- Maybe Text
    mpreferred
              Text
    preferredT2 <- Text -> Text -> Maybe Text
    T.stripPrefix (FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ PackageName -> FilePath
    packageNameString PackageName
    name) Text
    preferredT1
              VersionRange
    vr <- FilePath -> Maybe VersionRange
    forall a. Parsec a => FilePath -> Maybe a
    Distribution.Text.simpleParse (FilePath -> Maybe VersionRange) -> FilePath -> Maybe VersionRange
    forall a b. (a -> b) -> a -> b
    $ Text -> FilePath
    T.unpack Text
    preferredT2
              (Version -> Map Revision BlobKey -> Bool)
    -> Maybe (Version -> Map Revision BlobKey -> Bool)
    forall a. a -> Maybe a
    Just ((Version -> Map Revision BlobKey -> Bool)
     -> Maybe (Version -> Map Revision BlobKey -> Bool))
    -> (Version -> Map Revision BlobKey -> Bool)
    -> Maybe (Version -> Map Revision BlobKey -> Bool)
    forall a b. (a -> b) -> a -> b
    $ \Version
    v Map Revision BlobKey
    _ -> Version -> VersionRange -> Bool
    withinRange Version
    v VersionRange
    vr
        (Version -> Map Revision BlobKey -> Bool)
    -> Map Version (Map Revision BlobKey)
    -> Map Version (Map Revision BlobKey)
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey Version -> Map Revision BlobKey -> Bool
    predicate (Map Version (Map Revision BlobKey)
     -> Map Version (Map Revision BlobKey))
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageName
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    forall env.
    PackageName
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    loadHackagePackageVersions PackageName
    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
      Maybe Package
    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 Maybe Package
    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
          HackageTarballResult
    htr <- RIO env HackageTarballResult
    inner
          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
    $
            PackageName
    -> Version -> BlobId -> TreeKey -> ReaderT SqlBackend (RIO env) ()
    forall env.
    PackageName
    -> Version -> BlobId -> TreeKey -> ReaderT SqlBackend (RIO env) ()
    storeHackageTree PackageName
    name Version
    ver BlobId
    bid (TreeKey -> ReaderT SqlBackend (RIO env) ())
    -> TreeKey -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ Package -> TreeKey
    packageTreeKey (Package -> TreeKey) -> Package -> TreeKey
    forall a b. (a -> b) -> a -> b
    $ HackageTarballResult -> Package
    htrPackage HackageTarballResult
    htr
          HackageTarballResult -> RIO env HackageTarballResult
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HackageTarballResult
    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
      Maybe TreeKey
    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 Maybe TreeKey
    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
      BlobId
    cabalFile <- PackageIdentifierRevision -> RIO env BlobId
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo PackageIdentifierRevision
    pir
      let rpli :: RawPackageLocationImmutable
    rpli = PackageIdentifierRevision
    -> Maybe TreeKey -> RawPackageLocationImmutable
    RPLIHackage PackageIdentifierRevision
    pir Maybe TreeKey
    mtreeKey
      RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> BlobId
    -> RIO env HackageTarballResult
    -> RIO env HackageTarballResult
    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
    cabalFile (RIO env HackageTarballResult -> RIO env HackageTarballResult)
    -> RIO env HackageTarballResult -> RIO env HackageTarballResult
    forall a b. (a -> b) -> a -> b
    $ do
        BlobKey
    cabalFileKey <- ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey)
    -> ReaderT SqlBackend (RIO env) BlobKey -> RIO env BlobKey
    forall a b. (a -> b) -> a -> b
    $ BlobId -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. BlobId -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey BlobId
    cabalFile
        Maybe (SHA256, FileSize)
    mpair <- 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
        (SHA256
    sha, FileSize
    size) <-
          case Maybe (SHA256, FileSize)
    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
              DidUpdateOccur
    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"
              Maybe (SHA256, FileSize)
    mpair2 <-
                case DidUpdateOccur
    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 Maybe (SHA256, FileSize)
    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
        PantryConfig
    pc <- Getting PantryConfig env PantryConfig -> RIO env PantryConfig
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting PantryConfig env PantryConfig
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL
        let urlPrefix :: Text
    urlPrefix = PackageIndexConfig -> Text
    picDownloadPrefix (PackageIndexConfig -> Text) -> PackageIndexConfig -> Text
    forall a b. (a -> b) -> a -> b
    $ PantryConfig -> PackageIndexConfig
    pcPackageIndex PantryConfig
    pc
            url :: Text
    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"
                ]
        (SHA256
    _, FileSize
    _, Package
    package, CachedTree
    cachedTree) <-
          RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    getArchive
            RawPackageLocationImmutable
    rpli
            RawArchive
              { raLocation :: ArchiveLocation
    raLocation = Text -> ArchiveLocation
    ALUrl Text
    url
              , raHash :: Maybe SHA256
    raHash = SHA256 -> Maybe SHA256
    forall a. a -> Maybe a
    Just SHA256
    sha
              , raSize :: Maybe FileSize
    raSize = FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size
              , raSubdir :: Text
    raSubdir = Text
    T.empty -- no subdirs on Hackage

              }
            RawPackageMetadata
              { rpmName :: Maybe PackageName
    rpmName = PackageName -> Maybe PackageName
    forall a. a -> Maybe a
    Just PackageName
    name
              , rpmVersion :: Maybe Version
    rpmVersion = Version -> Maybe Version
    forall a. a -> Maybe a
    Just Version
    ver
              , rpmTreeKey :: Maybe TreeKey
    rpmTreeKey = Maybe TreeKey
    forall a. Maybe a
    Nothing -- with a revision cabal file will differ

                                     -- giving a different tree

              }
        case CachedTree
    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
            (ByteString
    cabalBS, BlobId
    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
                Maybe BlobId
    mcabalBS <- SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    forall env. SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    loadBlobBySHA SHA256
    sha'
                case Maybe BlobId
    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' :: CachedTree
    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 :: PackageIdentifier
    ident = PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    ver
            ([PWarning]
    _warnings, GenericPackageDescription
    gpd) <- Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> RIO env ([PWarning], GenericPackageDescription)
    forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD (RawPackageLocationImmutable
    -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. a -> Either a b
    Left RawPackageLocationImmutable
    rpli) ByteString
    cabalBS
            let gpdIdent :: PackageIdentifier
    gpdIdent = PackageDescription -> PackageIdentifier
    Cabal.package (PackageDescription -> PackageIdentifier)
    -> PackageDescription -> PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ GenericPackageDescription -> PackageDescription
    Cabal.packageDescription GenericPackageDescription
    gpd
            Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PackageIdentifier
    ident PackageIdentifier -> PackageIdentifier -> Bool
    forall a. Eq a => a -> a -> Bool
    /= PackageIdentifier
    gpdIdent) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
              PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
              PackageIdentifierRevision
    -> Mismatch PackageIdentifier -> PantryException
    MismatchedCabalFileForHackage
                PackageIdentifierRevision
    pir
                Mismatch {mismatchExpected :: PackageIdentifier
    mismatchExpected = PackageIdentifier
    ident, mismatchActual :: PackageIdentifier
    mismatchActual = PackageIdentifier
    gpdIdent}
            (TreeId
    tid, TreeKey
    treeKey') <-
              ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> RIO env (TreeId, TreeKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
     -> RIO env (TreeId, TreeKey))
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> RIO env (TreeId, TreeKey)
    forall a b. (a -> b) -> a -> b
    $
              RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    storeTree RawPackageLocationImmutable
    rpli PackageIdentifier
    ident CachedTree
    tree' (SafeFilePath -> TreeEntry -> BuildFile
    BFCabal (PackageName -> SafeFilePath
    cabalFileName PackageName
    name) TreeEntry
    cabalEntry)
            HackageTarballResult -> RIO env HackageTarballResult
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
              HackageTarballResult
                { htrPackage :: Package
    htrPackage =
                    Package
                      { packageTreeKey :: TreeKey
    packageTreeKey = TreeKey
    treeKey'
                      , packageTree :: Tree
    packageTree = CachedTree -> Tree
    unCachedTree CachedTree
    tree'
                      , packageIdent :: PackageIdentifier
    packageIdent = PackageIdentifier
    ident
                      , packageCabalEntry :: PackageCabal
    packageCabalEntry = TreeEntry -> PackageCabal
    PCCabalFile TreeEntry
    cabalEntry
                      }
                , htrFreshPackageInfo :: Maybe (GenericPackageDescription, TreeId)
    htrFreshPackageInfo = (GenericPackageDescription, TreeId)
    -> Maybe (GenericPackageDescription, TreeId)
    forall a. a -> Maybe a
    Just (GenericPackageDescription
    gpd, TreeId
    tid)
                }