    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module Pantry.Hackage
      ( updateHackageIndex
      , forceUpdateHackageIndex
      , DidUpdateOccur (..)
      , RequireHackageIndex (..)
      , hackageIndexTarballL
      , getHackageTarball
      , getHackageTarballKey
      , getHackageCabalFile
      , getHackagePackageVersions
      , getHackagePackageVersionRevisions
      , getHackageTypoCorrections
      , UsePreferredVersions (..)
      , HackageTarballResult(..)
      ) where

    import RIO
    import RIO.Process
    import Pantry.Casa
    import Data.Aeson
    import Conduit
    import Data.Conduit.Tar
    import qualified RIO.Text as T
    import qualified RIO.Map as Map
    import Data.Text.Unsafe (unsafeTail)
    import qualified RIO.ByteString as B
    import qualified RIO.ByteString.Lazy as BL
    import Pantry.Archive
    import Pantry.Types hiding (FileType (..))
    import Pantry.Storage hiding (TreeEntry, PackageName, Version)
    import Pantry.Tree
    import qualified Pantry.SHA256 as SHA256
    import Network.URI (parseURI)
    import Data.Time (getCurrentTime)
    import Path ((</>), Path, Abs, Rel, Dir, File, toFilePath, parseRelDir, parseRelFile)
    import qualified Distribution.Text
    import qualified Distribution.PackageDescription as Cabal
    import System.IO (SeekMode (..))
    import qualified Data.List.NonEmpty as NE
    import Data.Text.Metrics (damerauLevenshtein)
    import Distribution.PackageDescription (GenericPackageDescription)
    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.Remote as HS
    import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HS
    import qualified Hackage.Security.Util.Path as HS
    import qualified Hackage.Security.Util.Pretty as HS

    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 "hackage"

    hackageDirL :: HasPantryConfig env => SimpleGetter env (Path Abs Dir)
    hackageDirL :: SimpleGetter env (Path Abs Dir)
    hackageDirL = (PantryConfig -> Const r PantryConfig) -> env -> Const r env
    forall env. HasPantryConfig env => 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 "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 :: SimpleGetter env (Path Abs File)
    hackageIndexTarballL = Getting r env (Path Abs Dir)
    forall env. HasPantryConfig env => 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 :: 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 :: 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 :: Bool -> Maybe Utf8Builder -> RIO env DidUpdateOccur
    updateHackageIndexInternal forceUpdate :: Bool
    forceUpdate mreason :: 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
    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
    pantryConfigL
        let HackageSecurityConfig keyIds :: [Text]
    keyIds threshold :: Int
    threshold url :: Text
    url ignoreExpiry :: Bool
    ignoreExpiry = PantryConfig -> HackageSecurityConfig
    pcHackageSecurity 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)
    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)
    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
                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
    $ "Invalid Hackage Security base URL: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Text -> FilePath
    T.unpack Text
    url
                Just x :: URI
    x -> URI -> RIO env URI
    forall (m :: * -> *) a. Monad m => a -> m a
    return 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
                Cache :: Path Absolute -> CacheLayout -> Cache
    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 (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
    $ \repo :: 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 (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
          _ | Bool
    forceUpdate -> do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo "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
          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 "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 "No package index update available and cache up to date"
          HS.HasUpdates -> do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo "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 "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 :: Handle -> m Word
    getTarballSize h :: 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 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 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 tarball :: 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
            Nothing -> Bool -> RIO env Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
            Just (FileSize cachedSize :: Word
    cachedSize, _sha256 :: 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 (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 tarball :: 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
          (offset :: Word
    offset, newHash :: SHA256
    newHash, newSize :: Word
    newSize) <- RIO env (Word, SHA256, Word)
    -> ReaderT SqlBackend (RIO env) (Word, SHA256, Word)
    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
    $ \h :: Handle
    h -> do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo "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 -> ConduitM ByteString c m SHA256
    sinkSHA256 len :: 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 ()
    -> ConduitM ByteString c m SHA256 -> ConduitM ByteString c m SHA256
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| ConduitM ByteString c m SHA256
    forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
    SHA256.sinkHash

            case Maybe (FileSize, SHA256)
    minfo of
              Nothing -> do
                Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo "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) ()
    -> ConduitM ByteString Void (RIO env) SHA256
    -> ConduitT () Void (RIO env) SHA256
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| Word -> ConduitM ByteString Void (RIO env) SHA256
    forall (m :: * -> *) a c.
    (Monad m, Integral a) =>
    a -> ConduitM ByteString c m SHA256
    sinkSHA256 Word
    newSize
                (Word, SHA256, Word) -> RIO env (Word, SHA256, Word)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (0, SHA256
    newHash, Word
    newSize)
              Just (FileSize oldSize :: Word
    oldSize, oldHash :: SHA256
    oldHash) -> do
                -- oldSize and oldHash come from the database, and tell
                -- us what we cached already. Compare against
                -- oldHashCheck, which assuming the tarball has not been
                -- rebased will be the same as oldHash. At the same
                -- time, calculate newHash, which is the hash of the new
                -- content as well.
                (oldHashCheck :: SHA256
    oldHashCheck, newHash :: 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) ()
    -> ConduitM ByteString Void (RIO env) (SHA256, SHA256)
    -> ConduitT () Void (RIO env) (SHA256, SHA256)
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| ZipSink ByteString (RIO env) (SHA256, SHA256)
    -> ConduitM ByteString Void (RIO env) (SHA256, SHA256)
    forall i (m :: * -> *) r. ZipSink i m r -> Sink i 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
    <$> ConduitM ByteString Void (RIO env) SHA256
    -> ZipSink ByteString (RIO env) SHA256
    forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
    ZipSink (Word -> ConduitM ByteString Void (RIO env) SHA256
    forall (m :: * -> *) a c.
    (Monad m, Integral a) =>
    a -> ConduitM 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ConduitM ByteString Void (RIO env) SHA256
    -> ZipSink ByteString (RIO env) SHA256
    forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
    ZipSink (Word -> ConduitM ByteString Void (RIO env) SHA256
    forall (m :: * -> *) a c.
    (Monad m, Integral a) =>
    a -> ConduitM 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 (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 "Updating preexisting cache, should be quick"
                    else 0 Word -> RIO env () -> RIO env Word
    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 [
                        "Package index change detected, that's pretty unusual: "
                        , "\n    Old size: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Word -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Word
    oldSize
                        , "\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
                        , "\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
                        , "\n    Forcing a recache"
                        ]
                (Word, SHA256, Word) -> RIO env (Word, SHA256, Word)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word
    offset, SHA256
    newHash, Word
    newSize)

          RIO env () -> ReaderT SqlBackend (RIO env) ()
    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
    $ "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
    <> ", 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
    == 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 (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 "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 inner :: 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
    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
    $ \toUpdate :: Bool
    toUpdate -> (Bool, m DidUpdateOccur) -> m (Bool, m DidUpdateOccur)
    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 (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ m b
    inner)
              else (Bool
    False, DidUpdateOccur -> m DidUpdateOccur
    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 :: Path Abs File -> Integer -> ReaderT SqlBackend (RIO env) ()
    populateCache fp :: Path Abs File
    fp offset :: 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
    $ \h :: Handle
    h -> do
      RIO env () -> ReaderT SqlBackend (RIO env) ()
    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 "Populating package index cache ..."
      IORef Int
    counter <- Int -> ReaderT SqlBackend (RIO env) (IORef Int)
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef (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)) ()
    -> ConduitM ByteString Void (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| (FileInfo
     -> ConduitM ByteString Void (ReaderT SqlBackend (RIO env)) ())
    -> ConduitM ByteString Void (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) o.
    MonadThrow m =>
    (FileInfo -> ConduitM ByteString o m ())
    -> ConduitM ByteString o m ()
    untar (IORef Int
    -> FileInfo
    -> ConduitM 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 counter :: IORef a
    counter fi :: FileInfo
    fi
          | FileType
    FTNormal <- FileInfo -> FileType
    fileType FileInfo
    fi
          , Right path :: 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 (name :: PackageName
    name, version :: Version
    version, filename :: 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
    == "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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    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
                    (ByteString -> ByteString
    BL.toStrict (ByteString -> ByteString)
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    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

                    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
    + 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` 400 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 (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 (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
    $ "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
    <> " cabal files"
                | Bool
    otherwise -> () -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          | FileType
    FTNormal <- FileInfo -> FileType
    fileType FileInfo
    fi
          , Right path :: 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
          , (nameT :: Text
    nameT, "/preferred-versions") <- (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/') Text
    path
          , Just name :: 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 _ -> () -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure () -- maybe warning
                Right p :: Text
    p -> ReaderT SqlBackend (RIO env) ()
    -> ConduitT ByteString o (ReaderT SqlBackend (RIO env)) ()
    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 (f :: * -> *) a. Applicative f => a -> f a
    pure ()

        addJSON :: PackageName
    -> Version -> ByteString -> ReaderT SqlBackend (RIO env) ()
    addJSON name :: PackageName
    name version :: Version
    version lbs :: ByteString
    lbs =
          case ByteString -> Either FilePath PackageDownload
    forall a. FromJSON a => ByteString -> Either FilePath a
    eitherDecode' ByteString
    lbs of
            Left e :: FilePath
    e -> RIO env () -> ReaderT SqlBackend (RIO env) ()
    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
    $
              "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
    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
    forall a. Semigroup a => a -> a -> a
    <>
              FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString FilePath
    e
            Right (PackageDownload sha :: SHA256
    sha size :: 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 name :: PackageName
    name version :: Version
    version bs :: ByteString
    bs = do
          (blobTableId :: BlobId
    blobTableId, _blobKey :: 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 x :: 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
            (y :: Text
    y, z :: Text
    z) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/') Text
    x

        parseNameVersionSuffix :: Text -> Maybe (a, b, Text)
    parseNameVersionSuffix t1 :: Text
    t1 = do
            (name :: Text
    name, t2 :: Text
    t2) <- Text -> Maybe (Text, Text)
    breakSlash Text
    t1
            (version :: Text
    version, filename :: 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 "PackageDownload" ((Object -> Parser PackageDownload)
     -> Value -> Parser PackageDownload)
    -> (Object -> Parser PackageDownload)
    -> Value
    -> Parser PackageDownload
    forall a b. (a -> b) -> a -> b
    $ \o1 :: Object
    o1 -> do
            Object
    o2 <- Object
    o1 Object -> Text -> Parser Object
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "signed"
            Object o3 :: Object
    o3 <- Object
    o2 Object -> Text -> Parser Value
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "targets"
            Object o4 :: Object
    o4:_ <- [Value] -> Parser [Value]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Value] -> Parser [Value]) -> [Value] -> Parser [Value]
    forall a b. (a -> b) -> a -> b
    $ Object -> [Value]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Object
    o3
            Word
    len <- Object
    o4 Object -> Text -> Parser Word
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "length"
            Object
    hashes <- Object
    o4 Object -> Text -> Parser Object
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "hashes"
            Text
    sha256' <- Object
    hashes Object -> Text -> Parser Text
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "sha256"
            SHA256
    sha256 <-
              case Text -> Either SHA256Exception SHA256
    SHA256.fromHexText Text
    sha256' of
                Left e :: SHA256Exception
    e -> FilePath -> Parser SHA256
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Parser SHA256) -> FilePath -> Parser SHA256
    forall a b. (a -> b) -> a -> b
    $ "Invalid sha256: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ SHA256Exception -> FilePath
    forall a. Show a => a -> FilePath
    show SHA256Exception
    e
                Right x :: SHA256
    x -> SHA256 -> Parser SHA256
    forall (m :: * -> *) a. Monad m => a -> m a
    return SHA256
    x
            PackageDownload -> Parser PackageDownload
    forall (m :: * -> *) a. Monad m => a -> m a
    return (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 :: PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision _ _ cfi :: 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 sha :: SHA256
    sha msize :: Maybe FileSize
    msize -> do
          let sizeMismatch :: Bool
    sizeMismatch =
                case Maybe FileSize
    msize of
                  Nothing -> Bool
    False
                  Just size :: 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
    $ "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)
        _ -> () -> RIO env ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      ByteString -> RIO env ByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs

    resolveCabalFileInfo
      :: (HasPantryConfig env, HasLogFunc env)
      => PackageIdentifierRevision
      -> RIO env BlobId
    resolveCabalFileInfo :: PackageIdentifierRevision -> RIO env BlobId
    resolveCabalFileInfo pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision name :: PackageName
    name ver :: Version
    ver cfi :: CabalFileInfo
    cfi) = do
      Maybe BlobId
    mres <- RIO env (Maybe BlobId)
    inner
      case Maybe BlobId
    mres of
        Just res :: BlobId
    res -> BlobId -> RIO env BlobId
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BlobId
    res
        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
    $ "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
    <> ", updating"
          Maybe BlobId
    mres' <-
            case DidUpdateOccur
    updated of
              UpdateOccurred -> RIO env (Maybe BlobId)
    inner
              NoUpdateOccurred -> Maybe BlobId -> RIO env (Maybe BlobId)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
          case Maybe BlobId
    mres' of
            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 (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 res :: BlobId
    res -> BlobId -> RIO env BlobId
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BlobId
    res
      where
        inner :: RIO env (Maybe BlobId)
    inner =
          case CabalFileInfo
    cfi of
            CFIHash sha :: SHA256
    sha msize :: 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 rev :: Revision
    rev -> (((BlobId, BlobKey) -> BlobId)
    -> Maybe (BlobId, BlobKey) -> Maybe BlobId
    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)
            CFILatest -> ((((BlobId, BlobKey), Map Revision (BlobId, BlobKey)) -> BlobId)
    -> Maybe ((BlobId, BlobKey), Map Revision (BlobId, BlobKey))
    -> Maybe BlobId
    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 :: a -> SHA256 -> Maybe FileSize -> RIO env (Maybe BlobId)
    loadOrDownloadBlobBySHA label :: a
    label sha256 :: SHA256
    sha256 msize :: Maybe FileSize
    msize = do
      Maybe BlobId
    mresult <- RIO env (Maybe BlobId)
    byDB
      case Maybe BlobId
    mresult of
        Nothing -> do
          case Maybe FileSize
    msize of
            Nothing -> do
              Maybe BlobId -> RIO env (Maybe BlobId)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
            Just size :: 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
                Nothing -> do
                  Maybe BlobId -> RIO env (Maybe BlobId)
    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
    blobId -> do
                      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("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 (f :: * -> *) a. Applicative f => a -> f a
    pure (BlobId -> Maybe BlobId
    forall a. a -> Maybe a
    Just BlobId
    blobId)
                    Nothing -> do
                      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                        ("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 (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobId
    forall a. Maybe a
    Nothing
        Just blobId :: BlobId
    blobId -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("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 (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 :: PackageName -> Version -> RIO env FuzzyResults
    fuzzyLookupCandidates name :: PackageName
    name ver0 :: 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
            Nothing -> do
              let withVers :: NonEmpty (Version, Map k BlobKey) -> f FuzzyResults
    withVers vers :: NonEmpty (Version, Map k BlobKey)
    vers = FuzzyResults -> f FuzzyResults
    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
    $ \(ver :: Version
    ver, revs :: 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
                      Nothing -> FilePath -> PackageIdentifierRevision
    forall a. HasCallStack => FilePath -> a
    error "fuzzyLookupCandidates: no revisions"
                      Just (BlobKey sha :: SHA256
    sha size :: FileSize
    size, _) -> 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 vers :: 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
                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
                    Nothing -> FilePath -> RIO env FuzzyResults
    forall a. HasCallStack => FilePath -> a
    error "fuzzyLookupCandidates: no versions"
                    Just vers :: 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 revisions :: Map Revision BlobKey
    revisions ->
              let pirs :: [PackageIdentifierRevision]
    pirs = (BlobKey -> PackageIdentifierRevision)
    -> [BlobKey] -> [PackageIdentifierRevision]
    forall a b. (a -> b) -> [a] -> [b]
    map
                    (\(BlobKey sha :: SHA256
    sha size :: 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
                    Nothing -> FilePath -> RIO env FuzzyResults
    forall a. HasCallStack => FilePath -> a
    error "fuzzyLookupCandidates: no revisions"
                    Just pirs' :: NonEmpty PackageIdentifierRevision
    pirs' -> FuzzyResults -> RIO env FuzzyResults
    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 v :: 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 v :: Version
    v =
      case Version -> [Int]
    versionNumbers Version
    v of
        []    -> [0, 0]
        [a :: Int
    a]   -> [Int
    a, 0]
        a :: Int
    a:b :: Int
    b:_ -> [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 :: PackageName -> RIO env [PackageName]
    getHackageTypoCorrections name1 :: 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
          (\name2 :: PackageName
    name2 -> PackageName
    name1 PackageName -> PackageName -> Int
    `distance` PackageName
    name2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 4)
          (Int
    -> ConduitT
         PackageName PackageName (ReaderT SqlBackend (RIO env)) ()
    forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
    takeC 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 =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM 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
    showList :: [UsePreferredVersions] -> FilePath -> FilePath
    $cshowList :: [UsePreferredVersions] -> FilePath -> FilePath
    show :: UsePreferredVersions -> FilePath
    $cshow :: UsePreferredVersions -> FilePath
    showsPrec :: Int -> UsePreferredVersions -> FilePath -> FilePath
    $cshowsPrec :: Int -> 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
    showList :: [RequireHackageIndex] -> FilePath -> FilePath
    $cshowList :: [RequireHackageIndex] -> FilePath -> FilePath
    show :: RequireHackageIndex -> FilePath
    $cshow :: RequireHackageIndex -> FilePath
    showsPrec :: Int -> RequireHackageIndex -> FilePath -> FilePath
    $cshowsPrec :: Int -> RequireHackageIndex -> FilePath -> FilePath
    Show

    initializeIndex
      :: (HasPantryConfig env, HasLogFunc env)
      => RequireHackageIndex
      -> RIO env ()
    initializeIndex :: RequireHackageIndex -> RIO env ()
    initializeIndex NoRequireHackageIndex = () -> RIO env ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    initializeIndex 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
    == 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 -> Maybe Utf8Builder)
    -> Utf8Builder -> Maybe Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ "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 :: RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions req :: RequireHackageIndex
    req usePreferred :: UsePreferredVersions
    usePreferred name :: 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 -> PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    loadPreferredVersion PackageName
    name
            IgnorePreferredVersions -> Maybe Text -> ReaderT SqlBackend (RIO env) (Maybe Text)
    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 (\_ _ -> 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
    $ \v :: Version
    v _ -> 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 :: RequireHackageIndex
    -> PackageName -> Version -> RIO env (Map Revision BlobKey)
    getHackagePackageVersionRevisions req :: RequireHackageIndex
    req name :: PackageName
    name version :: 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 :: RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> BlobId
    -> RIO env HackageTarballResult
    -> RIO env HackageTarballResult
    withCachedTree rpli :: RawPackageLocationImmutable
    rpli name :: PackageName
    name ver :: Version
    ver bid :: BlobId
    bid inner :: 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
    package -> HackageTarballResult -> RIO env HackageTarballResult
    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
        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 (f :: * -> *) a. Applicative f => a -> f a
    pure HackageTarballResult
    htr

    getHackageTarballKey
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageIdentifierRevision
      -> RIO env TreeKey
    getHackageTarballKey :: PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey pir :: PackageIdentifierRevision
    pir@(PackageIdentifierRevision name :: PackageName
    name ver :: Version
    ver (CFIHash sha :: SHA256
    sha _msize :: 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
        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 key :: TreeKey
    key -> TreeKey -> RIO env TreeKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TreeKey
    key
    getHackageTarballKey pir :: 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 :: PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball pir :: PackageIdentifierRevision
    pir mtreeKey :: Maybe TreeKey
    mtreeKey = do
      let PackageIdentifierRevision name :: PackageName
    name ver :: Version
    ver _cfi :: 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
        (sha :: SHA256
    sha, size :: FileSize
    size) <-
          case Maybe (SHA256, FileSize)
    mpair of
            Just pair :: (SHA256, FileSize)
    pair -> (SHA256, FileSize) -> RIO env (SHA256, FileSize)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SHA256, FileSize)
    pair
            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
    <> ", updating"
              Maybe (SHA256, FileSize)
    mpair2 <-
                case DidUpdateOccur
    updated of
                  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
                  NoUpdateOccurred -> Maybe (SHA256, FileSize) -> RIO env (Maybe (SHA256, FileSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (SHA256, FileSize)
    forall a. Maybe a
    Nothing
              case Maybe (SHA256, FileSize)
    mpair2 of
                Nothing -> PantryException -> RIO env (SHA256, FileSize)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc
                Just pair2 :: (SHA256, FileSize)
    pair2 -> (SHA256, FileSize) -> RIO env (SHA256, FileSize)
    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
    pantryConfigL
        let urlPrefix :: Text
    urlPrefix = HackageSecurityConfig -> Text
    hscDownloadPrefix (HackageSecurityConfig -> Text) -> HackageSecurityConfig -> Text
    forall a b. (a -> b) -> a -> b
    $ PantryConfig -> HackageSecurityConfig
    pcHackageSecurity PantryConfig
    pc
            url :: Text
    url =
              [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat
                [ Text
    urlPrefix
                , "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
                , "-"
                , 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
                , ".tar.gz"
                ]
        Package
    package <-
          RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage
            RawPackageLocationImmutable
    rpli
            $WRawArchive :: ArchiveLocation
    -> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
    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
              }
            $WRawPackageMetadata :: Maybe PackageName
    -> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
    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 Package -> Tree
    packageTree Package
    package of
          TreeMap m :: Map SafeFilePath TreeEntry
    m -> do
            let ft :: FileType
    ft =
                  case Package -> PackageCabal
    packageCabalEntry Package
    package of
                    PCCabalFile (TreeEntry _ ft' :: FileType
    ft') -> FileType
    ft'
                    _ -> FilePath -> FileType
    forall a. HasCallStack => FilePath -> a
    error "Impossible: Hackage does not support hpack"
                cabalEntry :: TreeEntry
    cabalEntry = BlobKey -> FileType -> TreeEntry
    TreeEntry BlobKey
    cabalFileKey FileType
    ft
                tree' :: Tree
    tree' = Map SafeFilePath TreeEntry -> Tree
    TreeMap (Map SafeFilePath TreeEntry -> Tree)
    -> Map SafeFilePath TreeEntry -> Tree
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath
    -> TreeEntry
    -> Map SafeFilePath TreeEntry
    -> Map SafeFilePath TreeEntry
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (PackageName -> SafeFilePath
    cabalFileName PackageName
    name) TreeEntry
    cabalEntry Map SafeFilePath TreeEntry
    m
                ident :: PackageIdentifier
    ident = PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    ver
            ByteString
    cabalBS <-
              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
    $ do
                let BlobKey sha' :: SHA256
    sha' _ = 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
                  Nothing ->
                    FilePath -> ReaderT SqlBackend (RIO env) ByteString
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ReaderT SqlBackend (RIO env) ByteString)
    -> FilePath -> ReaderT SqlBackend (RIO env) ByteString
    forall a b. (a -> b) -> a -> b
    $
                    "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 bid :: BlobId
    bid -> BlobId -> ReaderT SqlBackend (RIO env) ByteString
    forall env. BlobId -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById BlobId
    bid
            (_warnings :: [PWarning]
    _warnings, gpd :: 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
                $WMismatch :: forall a. a -> a -> Mismatch a
    Mismatch {mismatchExpected :: PackageIdentifier
    mismatchExpected = PackageIdentifier
    ident, mismatchActual :: PackageIdentifier
    mismatchActual = PackageIdentifier
    gpdIdent}
            (tid :: TreeId
    tid, treeKey' :: 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
    -> Tree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> Tree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    storeTree RawPackageLocationImmutable
    rpli PackageIdentifier
    ident Tree
    tree' (SafeFilePath -> TreeEntry -> BuildFile
    BFCabal (PackageName -> SafeFilePath
    cabalFileName PackageName
    name) TreeEntry
    cabalEntry)
            HackageTarballResult -> RIO env HackageTarballResult
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
              $WHackageTarballResult :: Package
    -> Maybe (GenericPackageDescription, TreeId)
    -> HackageTarballResult
    HackageTarballResult
                { htrPackage :: Package
    htrPackage =
                    $WPackage :: TreeKey -> Tree -> PackageCabal -> PackageIdentifier -> Package
    Package
                      { packageTreeKey :: TreeKey
    packageTreeKey = TreeKey
    treeKey'
                      , packageTree :: Tree
    packageTree = Tree
    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)
                }