    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE StandaloneDeriving #-}
    module Pantry.Storage
      ( SqlBackend
      , initStorage
      , withStorage
      , migrateAll
      , storeBlob
      , loadBlob
      , loadBlobById
      , loadBlobBySHA
      , allBlobsSource
      , allHackageCabalRawPackageLocations
      , allBlobsCount
      , allHackageCabalCount
      , getBlobKey
      , loadURLBlob
      , storeURLBlob
      , clearHackageRevisions
      , storeHackageRevision
      , loadHackagePackageVersions
      , loadHackagePackageVersion
      , loadLatestCacheUpdate
      , storeCacheUpdate
      , storeHackageTarballInfo
      , loadHackageTarballInfo
      , getHPackBlobKeyById
      , storeTree
      , loadTree
      , storeHPack
      , loadPackageById
      , getPackageNameById
      , getPackageNameId
      , getVersionId
      , getTreeForKey
      , storeHackageTree
      , loadHackageTree
      , loadHackageTreeKey
      , storeArchiveCache
      , loadArchiveCache
      , storeRepoCache
      , loadRepoCache
      , storePreferredVersion
      , loadPreferredVersion
      , sinkHackagePackageNames
      , loadCabalBlobKey
      , hpackToCabal
      , countHackageCabals
      , getSnapshotCacheByHash
      , getSnapshotCacheId
      , storeSnapshotModuleCache
      , loadExposedModulePackages
      , PackageNameId
      , PackageName
      , VersionId
      , ModuleNameId
      , Version
      , Unique(..)
      , EntityField(..)
        -- avoid warnings
      , BlobId
      , Key(unBlobKey)
      , HackageCabalId
      , HackageCabal(..)
      , HackageTarballId
      , CacheUpdateId
      , FilePathId
      , Tree(..)
      , TreeId
      , TreeEntry(..)
      , TreeEntryId
      , ArchiveCacheId
      , RepoCacheId
      , PreferredVersionsId
      , UrlBlobId
      , SnapshotCacheId
      , PackageExposedModuleId
      ) where

    import RIO hiding (FilePath)
    import RIO.Process
    import qualified RIO.ByteString as B
    import qualified Pantry.Types as P
    import qualified RIO.List as List
    import qualified RIO.FilePath as FilePath
    import RIO.FilePath ((</>), takeDirectory)
    import RIO.Directory (createDirectoryIfMissing, setPermissions, getPermissions, setOwnerExecutable)
    import Database.Persist
    import Database.Persist.Sqlite
    import Database.Persist.TH
    import RIO.Orphans (HasResourceMap)
    import qualified Pantry.SHA256 as SHA256
    import qualified RIO.Map as Map
    import qualified RIO.Text as T
    import RIO.Time (UTCTime, getCurrentTime)
    import Path (Path, Abs, File, Dir, toFilePath, filename, parseAbsDir, fromAbsFile, fromRelFile)
    import Path.IO (listDir, createTempDir, getTempDir, removeDirRecur)
    import Pantry.HPack (hpackVersion, hpack)
    import Conduit
    import Data.Acquire (with)
    import Pantry.Types (PackageNameP (..), VersionP (..), SHA256, FileSize (..), FileType (..), HasPantryConfig, BlobKey, Repo (..), TreeKey, SafeFilePath, Revision (..), Package (..), SnapshotCacheHash (..))
    import qualified Pantry.SQLite as SQLite

    share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
    -- Raw blobs
    Blob
        sha SHA256
        size FileSize
        contents ByteString
        UniqueBlobSha sha
    -- Previously downloaded blobs from given URLs.
    -- May change over time, so we keep a time column too.
    UrlBlob sql=url_blob
        url Text
        blob BlobId
        time UTCTime
        UniqueUrlTime url time

    -- For normalization, and avoiding storing strings in a bunch of
    -- tables.
    PackageName
        name P.PackageNameP
        UniquePackageName name
    Version
        version P.VersionP
        UniqueVersion version
    FilePath
        path P.SafeFilePath
        UniqueSfp path

    -- Secure download information for a package on Hackage. This does not
    -- contain revision information, since sdist tarballs are (blessedly)
    -- unmodified on Hackage.
    HackageTarball
        name PackageNameId
        version VersionId
        sha SHA256
        size FileSize
        UniqueHackageTarball name version

    -- An individual cabal file from Hackage, representing a specific
    -- revision.
    HackageCabal
        name PackageNameId
        version VersionId
        revision P.Revision
        cabal BlobId

        -- If available: the full tree containing the HackageTarball
        -- contents with the cabal file modified.
        tree TreeId Maybe
        UniqueHackage name version revision

    -- Any preferred-version information from Hackage
    PreferredVersions
        name PackageNameId
        preferred Text
        UniquePreferred name

    -- Last time we downloaded a 01-index.tar file from Hackage and
    -- updated the three previous tables.
    CacheUpdate
        -- When did we do the update?
        time UTCTime

        -- How big was the file when we updated, ignoring the last two
        -- all-null 512-byte blocks.
        size FileSize

        -- SHA256 of the first 'size' bytes of the file
        sha SHA256

    -- A tree containing a Haskell package. See associated TreeEntry
    -- table.
    Tree
        key BlobId

        -- If the treeCabal field is Nothing, it means the Haskell package
        -- doesn't have a corresponding cabal file for it. This may be the case
        -- for haskell package referenced by git repository with only a hpack file.
        cabal BlobId Maybe
        cabalType FileType
        name PackageNameId
        version VersionId
        UniqueTree key

    HPack
       tree TreeId

       -- hpack version used for generating this cabal file
       version VersionId

       -- Generated cabal file for the given tree and hpack version
       cabalBlob BlobId
       cabalPath FilePathId

       UniqueHPack tree version

    -- An individual file within a Tree.
    TreeEntry
        tree TreeId
        path FilePathId
        blob BlobId
        type FileType

    -- Like UrlBlob, but stores the contents as a Tree.
    ArchiveCache
        time UTCTime
        url Text
        subdir Text
        sha SHA256
        size FileSize
        tree TreeId

    -- Like ArchiveCache, but for a Repo.
    RepoCache
        time UTCTime
        url Text
        type P.RepoType
        commit Text
        subdir Text
        tree TreeId

    -- Identified by sha of all immutable packages contained in a snapshot
    -- and GHC version used
    SnapshotCache
        sha SHA256
        UniqueSnapshotCache sha

    PackageExposedModule
        snapshotCache SnapshotCacheId
        module ModuleNameId
        package PackageNameId

    ModuleName
        name P.ModuleNameP
        UniqueModule name
    |]

    initStorage
      :: HasLogFunc env
      => Path Abs File -- ^ storage file
      -> (P.Storage -> RIO env a)
      -> RIO env a
    initStorage :: Path Abs File -> (Storage -> RIO env a) -> RIO env a
    initStorage =
      Text
    -> Migration
    -> Path Abs File
    -> (Storage -> RIO env a)
    -> RIO env a
    forall env a.
    HasLogFunc env =>
    Text
    -> Migration
    -> Path Abs File
    -> (Storage -> RIO env a)
    -> RIO env a
    SQLite.initStorage "Pantry" Migration
    migrateAll

    withStorage
      :: (HasPantryConfig env, HasLogFunc env)
      => ReaderT SqlBackend (RIO env) a
      -> RIO env a
    withStorage :: ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage action :: ReaderT SqlBackend (RIO env) a
    action =
      (Storage -> ReaderT SqlBackend (RIO env) a -> RIO env a)
    -> ReaderT SqlBackend (RIO env) a -> Storage -> RIO env a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Storage -> ReaderT SqlBackend (RIO env) a -> RIO env a
    Storage
    -> forall env a.
       HasLogFunc env =>
       ReaderT SqlBackend (RIO env) a -> RIO env a
    SQLite.withStorage_ ReaderT SqlBackend (RIO env) a
    action (Storage -> RIO env a) -> RIO env Storage -> RIO env a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Getting Storage env Storage -> RIO env Storage
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view ((PantryConfig -> Const Storage PantryConfig)
    -> env -> Const Storage env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    P.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
    P.pcStorage)

    -- | This is a helper type to distinguish db queries between different rdbms backends. The important
    -- part is that the affects described in this data type should be semantically equivalent between
    -- the supported engines.
    data RdbmsActions env a = RdbmsActions
      { RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raSqlite :: !(ReaderT SqlBackend (RIO env) a)
      -- ^ A query that is specific to SQLite
      , RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raPostgres :: !(ReaderT SqlBackend (RIO env) a)
      -- ^ A query that is specific to PostgreSQL
      }

    -- | This function provides a way to create queries supported by multiple sql backends.
    rdbmsAwareQuery
      :: RdbmsActions env a
      -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery :: RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery RdbmsActions {ReaderT SqlBackend (RIO env) a
    raSqlite :: ReaderT SqlBackend (RIO env) a
    raSqlite :: forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raSqlite, ReaderT SqlBackend (RIO env) a
    raPostgres :: ReaderT SqlBackend (RIO env) a
    raPostgres :: forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raPostgres} = do
      Text
    rdbms <- SqlBackend -> Text
    connRDBMS (SqlBackend -> Text)
    -> ReaderT SqlBackend (RIO env) SqlBackend
    -> ReaderT SqlBackend (RIO env) Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT SqlBackend (RIO env) SqlBackend
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      case Text
    rdbms of
        "postgresql" -> ReaderT SqlBackend (RIO env) a
    raPostgres
        "sqlite" -> ReaderT SqlBackend (RIO env) a
    raSqlite
        _ -> String -> ReaderT SqlBackend (RIO env) a
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) a)
    -> String -> ReaderT SqlBackend (RIO env) a
    forall a b. (a -> b) -> a -> b
    $ "rdbmsAwareQuery: unsupported rdbms '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    rdbms String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "'"

    getPackageNameById
      :: PackageNameId
      -> ReaderT SqlBackend (RIO env) (Maybe P.PackageName)
    getPackageNameById :: Key PackageName -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    getPackageNameById = (Maybe PackageName -> Maybe PackageName)
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PackageNameP -> PackageName
    unPackageNameP (PackageNameP -> PackageName)
    -> (PackageName -> PackageNameP) -> PackageName -> PackageName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName -> PackageNameP
    packageNameName (PackageName -> PackageName)
    -> Maybe PackageName -> Maybe PackageName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (ReaderT SqlBackend (RIO env) (Maybe PackageName)
     -> ReaderT SqlBackend (RIO env) (Maybe PackageName))
    -> (Key PackageName
        -> ReaderT SqlBackend (RIO env) (Maybe PackageName))
    -> Key PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key PackageName -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get

    getPackageNameId
      :: P.PackageName
      -> ReaderT SqlBackend (RIO env) PackageNameId
    getPackageNameId :: PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId = (Either (Entity PackageName) (Key PackageName) -> Key PackageName)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity PackageName) (Key PackageName))
    -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity PackageName -> Key PackageName)
    -> (Key PackageName -> Key PackageName)
    -> Either (Entity PackageName) (Key PackageName)
    -> Key PackageName
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity PackageName -> Key PackageName
    forall record. Entity record -> Key record
    entityKey Key PackageName -> Key PackageName
    forall a. a -> a
    id) (ReaderT
       SqlBackend
       (RIO env)
       (Either (Entity PackageName) (Key PackageName))
     -> ReaderT SqlBackend (RIO env) (Key PackageName))
    -> (PackageName
        -> ReaderT
             SqlBackend
             (RIO env)
             (Either (Entity PackageName) (Key PackageName)))
    -> PackageName
    -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity PackageName) (Key PackageName))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy (PackageName
     -> ReaderT
          SqlBackend
          (RIO env)
          (Either (Entity PackageName) (Key PackageName)))
    -> (PackageName -> PackageName)
    -> PackageName
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity PackageName) (Key PackageName))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageNameP -> PackageName
    PackageName (PackageNameP -> PackageName)
    -> (PackageName -> PackageNameP) -> PackageName -> PackageName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName -> PackageNameP
    PackageNameP

    getVersionId
      :: P.Version
      -> ReaderT SqlBackend (RIO env) VersionId
    getVersionId :: Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId = (Either (Entity Version) (Key Version) -> Key Version)
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    -> ReaderT SqlBackend (RIO env) (Key Version)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity Version -> Key Version)
    -> (Key Version -> Key Version)
    -> Either (Entity Version) (Key Version)
    -> Key Version
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity Version -> Key Version
    forall record. Entity record -> Key record
    entityKey Key Version -> Key Version
    forall a. a -> a
    id) (ReaderT
       SqlBackend (RIO env) (Either (Entity Version) (Key Version))
     -> ReaderT SqlBackend (RIO env) (Key Version))
    -> (Version
        -> ReaderT
             SqlBackend (RIO env) (Either (Entity Version) (Key Version)))
    -> Version
    -> ReaderT SqlBackend (RIO env) (Key Version)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Version
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy (Version
     -> ReaderT
          SqlBackend (RIO env) (Either (Entity Version) (Key Version)))
    -> (Version -> Version)
    -> Version
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VersionP -> Version
    Version (VersionP -> Version)
    -> (Version -> VersionP) -> Version -> Version
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Version -> VersionP
    VersionP

    storeBlob
      :: ByteString
      -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
    storeBlob :: ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob bs :: ByteString
    bs = do
      let sha :: SHA256
    sha = ByteString -> SHA256
    SHA256.hashBytes ByteString
    bs
          size :: FileSize
    size = Word -> FileSize
    FileSize (Word -> FileSize) -> Word -> FileSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word) -> Int -> Word
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    bs
      [Key Blob]
    keys <- [Filter Blob]
    -> [SelectOpt Blob] -> ReaderT SqlBackend (RIO env) [Key Blob]
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistQueryRead backend,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m [Key record]
    selectKeysList [EntityField Blob SHA256
    forall typ. (typ ~ SHA256) => EntityField Blob typ
    BlobSha EntityField Blob SHA256 -> SHA256 -> Filter Blob
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. SHA256
    sha] []
      Key Blob
    key <-
        case [Key Blob]
    keys of
          [] ->
            RdbmsActions env (Key Blob)
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery
              $WRdbmsActions :: forall env a.
    ReaderT SqlBackend (RIO env) a
    -> ReaderT SqlBackend (RIO env) a -> RdbmsActions env a
    RdbmsActions
                { raSqlite :: ReaderT SqlBackend (RIO env) (Key Blob)
    raSqlite =
                    Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m (Key record)
    insert $WBlob :: SHA256 -> FileSize -> ByteString -> Blob
    Blob {blobSha :: SHA256
    blobSha = SHA256
    sha, blobSize :: FileSize
    blobSize = FileSize
    size, blobContents :: ByteString
    blobContents = ByteString
    bs}
                , raPostgres :: ReaderT SqlBackend (RIO env) (Key Blob)
    raPostgres =
                    do Text -> [PersistValue] -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) backend.
    (MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m ()
    rawExecute
                         "INSERT INTO blob(sha, size, contents) VALUES (?, ?, ?) ON CONFLICT DO NOTHING"
                         [ SHA256 -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SHA256
    sha
                         , FileSize -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue FileSize
    size
                         , ByteString -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue ByteString
    bs
                         ]
                       Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [Single (Key Blob)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
                         "SELECT blob.id FROM blob WHERE blob.sha = ?"
                         [SHA256 -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SHA256
    sha] ReaderT SqlBackend (RIO env) [Single (Key Blob)]
    -> ([Single (Key Blob)] -> ReaderT SqlBackend (RIO env) (Key Blob))
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                         [Single key :: Key Blob
    key] -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    key
                         _ ->
                           String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. HasCallStack => String -> a
    error
                             "soreBlob: there was a critical problem storing a blob."
                }
          key :: Key Blob
    key:rest :: [Key Blob]
    rest -> Bool
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. HasCallStack => Bool -> a -> a
    assert ([Key Blob] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Key Blob]
    rest) (Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    key)
      (Key Blob, BlobKey)
    -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Key Blob
    key, SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size)

    loadBlob ::
         HasLogFunc env
      => BlobKey
      -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob :: BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob (P.BlobKey sha :: SHA256
    sha size :: FileSize
    size) = do
      Maybe (Entity Blob)
    ment <- Unique Blob -> ReaderT SqlBackend (RIO env) (Maybe (Entity Blob))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Unique Blob -> ReaderT SqlBackend (RIO env) (Maybe (Entity Blob)))
    -> Unique Blob
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Blob))
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> Unique Blob
    UniqueBlobSha SHA256
    sha
      case Maybe (Entity Blob)
    ment of
        Nothing -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ByteString
    forall a. Maybe a
    Nothing
        Just (Entity _ bt :: Blob
    bt)
          | Blob -> FileSize
    blobSize Blob
    bt FileSize -> FileSize -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileSize
    size -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe ByteString
     -> ReaderT SqlBackend (RIO env) (Maybe ByteString))
    -> Maybe ByteString
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Blob -> ByteString
    blobContents Blob
    bt
          | Bool
    otherwise ->
              Maybe ByteString
    forall a. Maybe a
    Nothing Maybe ByteString
    -> ReaderT SqlBackend (RIO env) ()
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ 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, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                 "Mismatched blob size detected for SHA " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SHA256 -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SHA256
    sha Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 ". Expected size: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FileSize -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display FileSize
    size Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 ". Actual size: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FileSize -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (Blob -> FileSize
    blobSize Blob
    bt))

    loadBlobBySHA :: SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    loadBlobBySHA :: SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    loadBlobBySHA sha :: SHA256
    sha = [Key Blob] -> Maybe (Key Blob)
    forall a. [a] -> Maybe a
    listToMaybe ([Key Blob] -> Maybe (Key Blob))
    -> ReaderT SqlBackend (RIO env) [Key Blob]
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Filter Blob]
    -> [SelectOpt Blob] -> ReaderT SqlBackend (RIO env) [Key Blob]
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistQueryRead backend,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m [Key record]
    selectKeysList [EntityField Blob SHA256
    forall typ. (typ ~ SHA256) => EntityField Blob typ
    BlobSha EntityField Blob SHA256 -> SHA256 -> Filter Blob
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. SHA256
    sha] []

    loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById :: Key Blob -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById bid :: Key Blob
    bid = do
      Maybe Blob
    mbt <- Key Blob -> ReaderT SqlBackend (RIO env) (Maybe Blob)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get Key Blob
    bid
      case Maybe Blob
    mbt of
        Nothing -> String -> ReaderT SqlBackend (RIO env) ByteString
    forall a. HasCallStack => String -> a
    error "loadBlobById: ID doesn't exist in database"
        Just bt :: Blob
    bt -> ByteString -> ReaderT SqlBackend (RIO env) ByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> ReaderT SqlBackend (RIO env) ByteString)
    -> ByteString -> ReaderT SqlBackend (RIO env) ByteString
    forall a b. (a -> b) -> a -> b
    $ Blob -> ByteString
    blobContents Blob
    bt

    allBlobsSource ::
         HasResourceMap env
      => Maybe BlobId
      -- ^ For some x, yield blob whose id>x.
      -> ConduitT () (BlobId, ByteString) (ReaderT SqlBackend (RIO env)) ()
    allBlobsSource :: Maybe (Key Blob)
    -> ConduitT
         () (Key Blob, ByteString) (ReaderT SqlBackend (RIO env)) ()
    allBlobsSource mblobId :: Maybe (Key Blob)
    mblobId =
      [Filter Blob]
    -> [SelectOpt Blob]
    -> ConduitM () (Entity Blob) (ReaderT SqlBackend (RIO env)) ()
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadResource m,
     PersistRecordBackend record backend, MonadReader backend m) =>
    [Filter record]
    -> [SelectOpt record] -> ConduitM () (Entity record) m ()
    selectSource [EntityField Blob (Key Blob)
    forall typ. (typ ~ Key Blob) => EntityField Blob typ
    BlobId EntityField Blob (Key Blob) -> Key Blob -> Filter Blob
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    >. Key Blob
    blobId | Just blobId :: Key Blob
    blobId <- [Maybe (Key Blob)
    mblobId]] [EntityField Blob (Key Blob) -> SelectOpt Blob
    forall record typ. EntityField record typ -> SelectOpt record
    Asc EntityField Blob (Key Blob)
    forall typ. (typ ~ Key Blob) => EntityField Blob typ
    BlobId] ConduitM () (Entity Blob) (ReaderT SqlBackend (RIO env)) ()
    -> ConduitM
         (Entity Blob)
         (Key Blob, ByteString)
         (ReaderT SqlBackend (RIO env))
         ()
    -> ConduitT
         () (Key Blob, ByteString) (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
    .|
      (Entity Blob -> (Key Blob, ByteString))
    -> ConduitM
         (Entity Blob)
         (Key Blob, ByteString)
         (ReaderT SqlBackend (RIO env))
         ()
    forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
    mapC ((Entity Blob -> Key Blob
    forall record. Entity record -> Key record
    entityKey (Entity Blob -> Key Blob)
    -> (Entity Blob -> ByteString)
    -> Entity Blob
    -> (Key Blob, ByteString)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Blob -> ByteString
    blobContents (Blob -> ByteString)
    -> (Entity Blob -> Blob) -> Entity Blob -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entity Blob -> Blob
    forall record. Entity record -> record
    entityVal))

    -- | Pull all hackage cabal entries from the database as
    -- 'RawPackageLocationImmutable'. We do a manual join rather than
    -- dropping to raw SQL, and Esqueleto would add more deps.
    allHackageCabalRawPackageLocations ::
         HasResourceMap env
      => Maybe HackageCabalId
      -- ^ For some x, yield cabals whose id>x.
      -> ReaderT SqlBackend (RIO env) (Map.Map HackageCabalId P.RawPackageLocationImmutable)
    allHackageCabalRawPackageLocations :: Maybe (Key HackageCabal)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Map (Key HackageCabal) RawPackageLocationImmutable)
    allHackageCabalRawPackageLocations mhackageId :: Maybe (Key HackageCabal)
    mhackageId = do
      Map (Key HackageCabal) HackageCabal
    hackageCabals :: Map HackageCabalId HackageCabal <-
        [Filter HackageCabal]
    -> [SelectOpt HackageCabal]
    -> ReaderT
         SqlBackend (RIO env) (Map (Key HackageCabal) HackageCabal)
    forall backend (m :: * -> *) a.
    (PersistQueryRead backend, MonadIO m, PersistEntity a,
     PersistEntityBackend a ~ BaseBackend backend) =>
    [Filter a] -> [SelectOpt a] -> ReaderT backend m (Map (Key a) a)
    selectTuples
          [EntityField HackageCabal (Key HackageCabal)
    forall typ.
    (typ ~ Key HackageCabal) =>
    EntityField HackageCabal typ
    HackageCabalId EntityField HackageCabal (Key HackageCabal)
    -> Key HackageCabal -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    >. Key HackageCabal
    hackageId | Just hackageId :: Key HackageCabal
    hackageId <- [Maybe (Key HackageCabal)
    mhackageId]]
          []
      Map (Key PackageName) PackageName
    packageNames :: Map PackageNameId PackageName <- [Filter PackageName]
    -> [SelectOpt PackageName]
    -> ReaderT SqlBackend (RIO env) (Map (Key PackageName) PackageName)
    forall backend (m :: * -> *) a.
    (PersistQueryRead backend, MonadIO m, PersistEntity a,
     PersistEntityBackend a ~ BaseBackend backend) =>
    [Filter a] -> [SelectOpt a] -> ReaderT backend m (Map (Key a) a)
    selectTuples [] []
      Map (Key Version) Version
    versions :: Map VersionId Version <- [Filter Version]
    -> [SelectOpt Version]
    -> ReaderT SqlBackend (RIO env) (Map (Key Version) Version)
    forall backend (m :: * -> *) a.
    (PersistQueryRead backend, MonadIO m, PersistEntity a,
     PersistEntityBackend a ~ BaseBackend backend) =>
    [Filter a] -> [SelectOpt a] -> ReaderT backend m (Map (Key a) a)
    selectTuples [] []
      Map (Key HackageCabal) HackageCabal
    -> (HackageCabal
        -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Map (Key HackageCabal) RawPackageLocationImmutable)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for
        Map (Key HackageCabal) HackageCabal
    hackageCabals
        (\hackageCabal :: HackageCabal
    hackageCabal ->
           case Key PackageName
    -> Map (Key PackageName) PackageName -> Maybe PackageName
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (HackageCabal -> Key PackageName
    hackageCabalName HackageCabal
    hackageCabal) Map (Key PackageName) PackageName
    packageNames of
             Nothing -> String -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable
    forall a. HasCallStack => String -> a
    error "no such package name"
             Just packageName :: PackageName
    packageName ->
               let P.PackageNameP packageName' :: PackageName
    packageName' = PackageName -> PackageNameP
    packageNameName PackageName
    packageName
                in case Key Version -> Map (Key Version) Version -> Maybe Version
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (HackageCabal -> Key Version
    hackageCabalVersion HackageCabal
    hackageCabal) Map (Key Version) Version
    versions of
                     Nothing -> String -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable
    forall a. HasCallStack => String -> a
    error "no such version"
                     Just version :: Version
    version ->
                       let P.VersionP version' :: Version
    version' = Version -> VersionP
    versionVersion Version
    version
                        in do Maybe (Entity Tree)
    mtree <-
                                case HackageCabal -> Maybe (Key Tree)
    hackageCabalTree HackageCabal
    hackageCabal of
                                  Just key :: Key Tree
    key -> [Filter Tree]
    -> [SelectOpt Tree]
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
    selectFirst [EntityField Tree (Key Tree)
    forall typ. (typ ~ Key Tree) => EntityField Tree typ
    TreeId EntityField Tree (Key Tree) -> Key Tree -> Filter Tree
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Tree
    key] []
                                  Nothing -> Maybe (Entity Tree)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Entity Tree)
    forall a. Maybe a
    Nothing
                              Maybe BlobKey
    mblobKey <-
                                ReaderT SqlBackend (RIO env) (Maybe BlobKey)
    -> (Key Blob -> ReaderT SqlBackend (RIO env) (Maybe BlobKey))
    -> Maybe (Key Blob)
    -> ReaderT SqlBackend (RIO env) (Maybe BlobKey)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                                  (Maybe BlobKey -> ReaderT SqlBackend (RIO env) (Maybe BlobKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe BlobKey
    forall a. Maybe a
    Nothing)
                                  ((BlobKey -> Maybe BlobKey)
    -> ReaderT SqlBackend (RIO env) BlobKey
    -> ReaderT SqlBackend (RIO env) (Maybe BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BlobKey -> Maybe BlobKey
    forall a. a -> Maybe a
    Just (ReaderT SqlBackend (RIO env) BlobKey
     -> ReaderT SqlBackend (RIO env) (Maybe BlobKey))
    -> (Key Blob -> ReaderT SqlBackend (RIO env) BlobKey)
    -> Key Blob
    -> ReaderT SqlBackend (RIO env) (Maybe BlobKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey)
                                  ((Entity Tree -> Key Blob)
    -> Maybe (Entity Tree) -> Maybe (Key Blob)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Tree -> Key Blob
    treeKey (Tree -> Key Blob)
    -> (Entity Tree -> Tree) -> Entity Tree -> Key Blob
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entity Tree -> Tree
    forall record. Entity record -> record
    entityVal) Maybe (Entity Tree)
    mtree)
                              RawPackageLocationImmutable
    -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                                (PackageIdentifierRevision
    -> Maybe TreeKey -> RawPackageLocationImmutable
    P.RPLIHackage
                                   (PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    P.PackageIdentifierRevision
                                      PackageName
    packageName'
                                      Version
    version'
                                      (Revision -> CabalFileInfo
    P.CFIRevision
                                         (HackageCabal -> Revision
    hackageCabalRevision HackageCabal
    hackageCabal)))
                                   ((BlobKey -> TreeKey) -> Maybe BlobKey -> Maybe TreeKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BlobKey -> TreeKey
    P.TreeKey Maybe BlobKey
    mblobKey)))
      where
        selectTuples :: [Filter a] -> [SelectOpt a] -> ReaderT backend m (Map (Key a) a)
    selectTuples pred :: [Filter a]
    pred sort :: [SelectOpt a]
    sort =
          ([Entity a] -> Map (Key a) a)
    -> ReaderT backend m [Entity a]
    -> ReaderT backend m (Map (Key a) a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([(Key a, a)] -> Map (Key a) a
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Key a, a)] -> Map (Key a) a)
    -> ([Entity a] -> [(Key a, a)]) -> [Entity a] -> Map (Key a) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Entity a -> (Key a, a)) -> [Entity a] -> [(Key a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map Entity a -> (Key a, a)
    forall b. Entity b -> (Key b, b)
    tuple) ([Filter a] -> [SelectOpt a] -> ReaderT backend m [Entity a]
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistQueryRead backend,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m [Entity record]
    selectList [Filter a]
    pred [SelectOpt a]
    sort)
        tuple :: Entity b -> (Key b, b)
    tuple (Entity k :: Key b
    k v :: b
    v) = (Key b
    k, b
    v)

    allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int
    allBlobsCount :: Maybe (Key Blob) -> ReaderT SqlBackend (RIO env) Int
    allBlobsCount mblobId :: Maybe (Key Blob)
    mblobId = [Filter Blob] -> ReaderT SqlBackend (RIO env) Int
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m Int
    count [EntityField Blob (Key Blob)
    forall typ. (typ ~ Key Blob) => EntityField Blob typ
    BlobId EntityField Blob (Key Blob) -> Key Blob -> Filter Blob
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    >. Key Blob
    blobId | Just blobId :: Key Blob
    blobId <- [Maybe (Key Blob)
    mblobId]]

    allHackageCabalCount :: Maybe HackageCabalId -> ReaderT SqlBackend (RIO env) Int
    allHackageCabalCount :: Maybe (Key HackageCabal) -> ReaderT SqlBackend (RIO env) Int
    allHackageCabalCount mhackageCabalId :: Maybe (Key HackageCabal)
    mhackageCabalId =
      [Filter HackageCabal] -> ReaderT SqlBackend (RIO env) Int
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m Int
    count
        [ EntityField HackageCabal (Key HackageCabal)
    forall typ.
    (typ ~ Key HackageCabal) =>
    EntityField HackageCabal typ
    HackageCabalId EntityField HackageCabal (Key HackageCabal)
    -> Key HackageCabal -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    >. Key HackageCabal
    hackageCabalId
        | Just hackageCabalId :: Key HackageCabal
    hackageCabalId <- [Maybe (Key HackageCabal)
    mhackageCabalId]
        ]

    getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey :: Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey bid :: Key Blob
    bid = do
      [(Single SHA256, Single FileSize)]
    res <- Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [(Single SHA256, Single FileSize)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql "SELECT sha, size FROM blob WHERE id=?" [Key Blob -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key Blob
    bid]
      case [(Single SHA256, Single FileSize)]
    res of
        [] -> String -> ReaderT SqlBackend (RIO env) BlobKey
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) BlobKey)
    -> String -> ReaderT SqlBackend (RIO env) BlobKey
    forall a b. (a -> b) -> a -> b
    $ "getBlobKey failed due to missing ID: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key Blob -> String
    forall a. Show a => a -> String
    show Key Blob
    bid
        [(Single sha :: SHA256
    sha, Single size :: FileSize
    size)] -> BlobKey -> ReaderT SqlBackend (RIO env) BlobKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BlobKey -> ReaderT SqlBackend (RIO env) BlobKey)
    -> BlobKey -> ReaderT SqlBackend (RIO env) BlobKey
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size
        _ -> String -> ReaderT SqlBackend (RIO env) BlobKey
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) BlobKey)
    -> String -> ReaderT SqlBackend (RIO env) BlobKey
    forall a b. (a -> b) -> a -> b
    $ "getBlobKey failed due to non-unique ID: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Key Blob, [(Single SHA256, Single FileSize)]) -> String
    forall a. Show a => a -> String
    show (Key Blob
    bid, [(Single SHA256, Single FileSize)]
    res)

    getBlobId :: BlobKey -> ReaderT SqlBackend (RIO env) (Maybe BlobId)
    getBlobId :: BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    getBlobId (P.BlobKey sha :: SHA256
    sha size :: FileSize
    size) = do
      [Single (Key Blob)]
    res <- Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [Single (Key Blob)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql "SELECT id FROM blob WHERE sha=? AND size=?"
               [SHA256 -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SHA256
    sha, FileSize -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue FileSize
    size]
      Maybe (Key Blob) -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Key Blob)
     -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob)))
    -> Maybe (Key Blob)
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall a b. (a -> b) -> a -> b
    $ [Key Blob] -> Maybe (Key Blob)
    forall a. [a] -> Maybe a
    listToMaybe ([Key Blob] -> Maybe (Key Blob)) -> [Key Blob] -> Maybe (Key Blob)
    forall a b. (a -> b) -> a -> b
    $ (Single (Key Blob) -> Key Blob)
    -> [Single (Key Blob)] -> [Key Blob]
    forall a b. (a -> b) -> [a] -> [b]
    map Single (Key Blob) -> Key Blob
    forall a. Single a -> a
    unSingle [Single (Key Blob)]
    res

    loadURLBlob :: Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadURLBlob :: Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadURLBlob url :: Text
    url = do
      [Single ByteString]
    ment <- Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [Single ByteString]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT blob.contents\n\
        \FROM blob, url_blob\n\
        \WHERE url=?\
        \  AND url_blob.blob=blob.id\n\
        \ ORDER BY url_blob.time DESC"
        [Text -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Text
    url]
      case [Single ByteString]
    ment of
        [] -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ByteString
    forall a. Maybe a
    Nothing
        (Single bs :: ByteString
    bs) : _ -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe ByteString
     -> ReaderT SqlBackend (RIO env) (Maybe ByteString))
    -> Maybe ByteString
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    bs

    storeURLBlob :: Text -> ByteString -> ReaderT SqlBackend (RIO env) ()
    storeURLBlob :: Text -> ByteString -> ReaderT SqlBackend (RIO env) ()
    storeURLBlob url :: Text
    url blob :: ByteString
    blob = do
      (blobId :: Key Blob
    blobId, _) <- ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob ByteString
    blob
      UTCTime
    now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      UrlBlob -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WUrlBlob :: Text -> Key Blob -> UTCTime -> UrlBlob
    UrlBlob
            { urlBlobUrl :: Text
    urlBlobUrl = Text
    url
            , urlBlobBlob :: Key Blob
    urlBlobBlob = Key Blob
    blobId
            , urlBlobTime :: UTCTime
    urlBlobTime = UTCTime
    now
            }

    clearHackageRevisions :: ReaderT SqlBackend (RIO env) ()
    clearHackageRevisions :: ReaderT SqlBackend (RIO env) ()
    clearHackageRevisions = [Filter HackageCabal] -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistQueryWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m ()
    deleteWhere ([] :: [Filter HackageCabal])

    storeHackageRevision ::
         P.PackageName -> P.Version -> BlobId -> ReaderT SqlBackend (RIO env) ()
    storeHackageRevision :: PackageName
    -> Version -> Key Blob -> ReaderT SqlBackend (RIO env) ()
    storeHackageRevision name :: PackageName
    name version :: Version
    version key :: Key Blob
    key = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      Int
    rev <- [Filter HackageCabal] -> ReaderT SqlBackend (RIO env) Int
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m Int
    count
        [ EntityField HackageCabal (Key PackageName)
    forall typ. (typ ~ Key PackageName) => EntityField HackageCabal typ
    HackageCabalName EntityField HackageCabal (Key PackageName)
    -> Key PackageName -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key PackageName
    nameid
        , EntityField HackageCabal (Key Version)
    forall typ. (typ ~ Key Version) => EntityField HackageCabal typ
    HackageCabalVersion EntityField HackageCabal (Key Version)
    -> Key Version -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Version
    versionid
        ]
      HackageCabal -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WHackageCabal :: Key PackageName
    -> Key Version
    -> Revision
    -> Key Blob
    -> Maybe (Key Tree)
    -> HackageCabal
    HackageCabal
        { hackageCabalName :: Key PackageName
    hackageCabalName = Key PackageName
    nameid
        , hackageCabalVersion :: Key Version
    hackageCabalVersion = Key Version
    versionid
        , hackageCabalRevision :: Revision
    hackageCabalRevision = Word -> Revision
    Revision (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    rev)
        , hackageCabalCabal :: Key Blob
    hackageCabalCabal = Key Blob
    key
        , hackageCabalTree :: Maybe (Key Tree)
    hackageCabalTree = Maybe (Key Tree)
    forall a. Maybe a
    Nothing
        }

    loadHackagePackageVersions
      :: P.PackageName
      -> ReaderT SqlBackend (RIO env) (Map P.Version (Map Revision BlobKey))
    loadHackagePackageVersions :: PackageName
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    loadHackagePackageVersions name :: PackageName
    name = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      -- would be better with esequeleto
      ((Map Revision BlobKey
     -> Map Revision BlobKey -> Map Revision BlobKey)
    -> [(Version, Map Revision BlobKey)]
    -> Map Version (Map Revision BlobKey)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Map Revision BlobKey
    -> Map Revision BlobKey -> Map Revision BlobKey
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union ([(Version, Map Revision BlobKey)]
     -> Map Version (Map Revision BlobKey))
    -> ([(Single Revision, Single VersionP, Single SHA256,
          Single FileSize)]
        -> [(Version, Map Revision BlobKey)])
    -> [(Single Revision, Single VersionP, Single SHA256,
         Single FileSize)]
    -> Map Version (Map Revision BlobKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Single Revision, Single VersionP, Single SHA256, Single FileSize)
     -> (Version, Map Revision BlobKey))
    -> [(Single Revision, Single VersionP, Single SHA256,
         Single FileSize)]
    -> [(Version, Map Revision BlobKey)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Single Revision, Single VersionP, Single SHA256, Single FileSize)
    -> (Version, Map Revision BlobKey)
    forall k.
    (Single k, Single VersionP, Single SHA256, Single FileSize)
    -> (Version, Map k BlobKey)
    go) ([(Single Revision, Single VersionP, Single SHA256,
       Single FileSize)]
     -> Map Version (Map Revision BlobKey))
    -> ReaderT
         SqlBackend
         (RIO env)
         [(Single Revision, Single VersionP, Single SHA256,
           Single FileSize)]
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> [PersistValue]
    -> ReaderT
         SqlBackend
         (RIO env)
         [(Single Revision, Single VersionP, Single SHA256,
           Single FileSize)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT hackage.revision, version.version, blob.sha, blob.size\n\
        \FROM hackage_cabal as hackage, version, blob\n\
        \WHERE hackage.name=?\n\
        \AND   hackage.version=version.id\n\
        \AND   hackage.cabal=blob.id"
        [Key PackageName -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key PackageName
    nameid]
      where
        go :: (Single k, Single VersionP, Single SHA256, Single FileSize)
    -> (Version, Map k BlobKey)
    go (Single revision :: k
    revision, Single (P.VersionP version :: Version
    version), Single key :: SHA256
    key, Single size :: FileSize
    size) =
          (Version
    version, k -> BlobKey -> Map k BlobKey
    forall k a. k -> a -> Map k a
    Map.singleton k
    revision (SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    key FileSize
    size))

    loadHackagePackageVersion
      :: P.PackageName
      -> P.Version
      -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, P.BlobKey))
    loadHackagePackageVersion :: PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (Key Blob, BlobKey))
    loadHackagePackageVersion name :: PackageName
    name version :: Version
    version = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      -- would be better with esequeleto
      ([(Revision, (Key Blob, BlobKey))]
    -> Map Revision (Key Blob, BlobKey)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Revision, (Key Blob, BlobKey))]
     -> Map Revision (Key Blob, BlobKey))
    -> ([(Single Revision, Single SHA256, Single FileSize,
          Single (Key Blob))]
        -> [(Revision, (Key Blob, BlobKey))])
    -> [(Single Revision, Single SHA256, Single FileSize,
         Single (Key Blob))]
    -> Map Revision (Key Blob, BlobKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Single Revision, Single SHA256, Single FileSize,
      Single (Key Blob))
     -> (Revision, (Key Blob, BlobKey)))
    -> [(Single Revision, Single SHA256, Single FileSize,
         Single (Key Blob))]
    -> [(Revision, (Key Blob, BlobKey))]
    forall a b. (a -> b) -> [a] -> [b]
    map (Single Revision, Single SHA256, Single FileSize,
     Single (Key Blob))
    -> (Revision, (Key Blob, BlobKey))
    forall a a.
    (Single a, Single SHA256, Single FileSize, Single a)
    -> (a, (a, BlobKey))
    go) ([(Single Revision, Single SHA256, Single FileSize,
       Single (Key Blob))]
     -> Map Revision (Key Blob, BlobKey))
    -> ReaderT
         SqlBackend
         (RIO env)
         [(Single Revision, Single SHA256, Single FileSize,
           Single (Key Blob))]
    -> ReaderT SqlBackend (RIO env) (Map Revision (Key Blob, BlobKey))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> [PersistValue]
    -> ReaderT
         SqlBackend
         (RIO env)
         [(Single Revision, Single SHA256, Single FileSize,
           Single (Key Blob))]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT hackage.revision, blob.sha, blob.size, blob.id\n\
        \FROM hackage_cabal as hackage, version, blob\n\
        \WHERE hackage.name=?\n\
        \AND   hackage.version=?\n\
        \AND   hackage.cabal=blob.id"
        [Key PackageName -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key PackageName
    nameid, Key Version -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key Version
    versionid]
      where
        go :: (Single a, Single SHA256, Single FileSize, Single a)
    -> (a, (a, BlobKey))
    go (Single revision :: a
    revision, Single sha :: SHA256
    sha, Single size :: FileSize
    size, Single bid :: a
    bid) =
          (a
    revision, (a
    bid, SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size))

    loadLatestCacheUpdate
      :: ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate :: ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate =
        (Entity CacheUpdate -> (FileSize, SHA256))
    -> Maybe (Entity CacheUpdate) -> Maybe (FileSize, SHA256)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Entity CacheUpdate -> (FileSize, SHA256)
    go (Maybe (Entity CacheUpdate) -> Maybe (FileSize, SHA256))
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity CacheUpdate))
    -> ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Filter CacheUpdate]
    -> [SelectOpt CacheUpdate]
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity CacheUpdate))
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
    selectFirst [] [EntityField CacheUpdate UTCTime -> SelectOpt CacheUpdate
    forall record typ. EntityField record typ -> SelectOpt record
    Desc EntityField CacheUpdate UTCTime
    forall typ. (typ ~ UTCTime) => EntityField CacheUpdate typ
    CacheUpdateTime]
      where
        go :: Entity CacheUpdate -> (FileSize, SHA256)
    go (Entity _ cu :: CacheUpdate
    cu) = (CacheUpdate -> FileSize
    cacheUpdateSize CacheUpdate
    cu, CacheUpdate -> SHA256
    cacheUpdateSha CacheUpdate
    cu)

    storeCacheUpdate :: FileSize -> SHA256 -> ReaderT SqlBackend (RIO env) ()
    storeCacheUpdate :: FileSize -> SHA256 -> ReaderT SqlBackend (RIO env) ()
    storeCacheUpdate size :: FileSize
    size sha :: SHA256
    sha = do
      UTCTime
    now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      CacheUpdate -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WCacheUpdate :: UTCTime -> FileSize -> SHA256 -> CacheUpdate
    CacheUpdate
        { cacheUpdateTime :: UTCTime
    cacheUpdateTime = UTCTime
    now
        , cacheUpdateSize :: FileSize
    cacheUpdateSize = FileSize
    size
        , cacheUpdateSha :: SHA256
    cacheUpdateSha = SHA256
    sha
        }

    storeHackageTarballInfo
      :: P.PackageName
      -> P.Version
      -> SHA256
      -> FileSize
      -> ReaderT SqlBackend (RIO env) ()
    storeHackageTarballInfo :: PackageName
    -> Version -> SHA256 -> FileSize -> ReaderT SqlBackend (RIO env) ()
    storeHackageTarballInfo name :: PackageName
    name version :: Version
    version sha :: SHA256
    sha size :: FileSize
    size = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      ReaderT
      SqlBackend
      (RIO env)
      (Either (Entity HackageTarball) (Key HackageTarball))
    -> ReaderT SqlBackend (RIO env) ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT
       SqlBackend
       (RIO env)
       (Either (Entity HackageTarball) (Key HackageTarball))
     -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity HackageTarball) (Key HackageTarball))
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ HackageTarball
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity HackageTarball) (Key HackageTarball))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy $WHackageTarball :: Key PackageName
    -> Key Version -> SHA256 -> FileSize -> HackageTarball
    HackageTarball
        { hackageTarballName :: Key PackageName
    hackageTarballName = Key PackageName
    nameid
        , hackageTarballVersion :: Key Version
    hackageTarballVersion = Key Version
    versionid
        , hackageTarballSha :: SHA256
    hackageTarballSha = SHA256
    sha
        , hackageTarballSize :: FileSize
    hackageTarballSize = FileSize
    size
        }

    loadHackageTarballInfo
      :: P.PackageName
      -> P.Version
      -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    loadHackageTarballInfo :: PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    loadHackageTarballInfo name :: PackageName
    name version :: Version
    version = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      (Entity HackageTarball -> (SHA256, FileSize))
    -> Maybe (Entity HackageTarball) -> Maybe (SHA256, FileSize)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Entity HackageTarball -> (SHA256, FileSize)
    go (Maybe (Entity HackageTarball) -> Maybe (SHA256, FileSize))
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity HackageTarball))
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Unique HackageTarball
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity HackageTarball))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Key PackageName -> Key Version -> Unique HackageTarball
    UniqueHackageTarball Key PackageName
    nameid Key Version
    versionid)
      where
        go :: Entity HackageTarball -> (SHA256, FileSize)
    go (Entity _ ht :: HackageTarball
    ht) = (HackageTarball -> SHA256
    hackageTarballSha HackageTarball
    ht, HackageTarball -> FileSize
    hackageTarballSize HackageTarball
    ht)

    storeCabalFile ::
           ByteString
        -> P.PackageName
        -> ReaderT SqlBackend (RIO env) BlobId
    storeCabalFile :: ByteString
    -> PackageName -> ReaderT SqlBackend (RIO env) (Key Blob)
    storeCabalFile cabalBS :: ByteString
    cabalBS pkgName :: PackageName
    pkgName = do
        (bid :: Key Blob
    bid, _) <- ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob ByteString
    cabalBS
        let cabalFile :: SafeFilePath
    cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    pkgName
        Either (Entity FilePath) (Key FilePath)
    _ <- FilePath
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity FilePath) (Key FilePath))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy $WFilePath :: SafeFilePath -> FilePath
    FilePath {filePathPath :: SafeFilePath
    filePathPath = SafeFilePath
    cabalFile}
        Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key Blob
    bid

    loadFilePath ::
           SafeFilePath
        -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath :: SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath path :: SafeFilePath
    path = do
        Maybe (Entity FilePath)
    fp <- Unique FilePath
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity FilePath))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Unique FilePath
     -> ReaderT SqlBackend (RIO env) (Maybe (Entity FilePath)))
    -> Unique FilePath
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity FilePath))
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath -> Unique FilePath
    UniqueSfp SafeFilePath
    path
        case Maybe (Entity FilePath)
    fp of
            Nothing ->
                String -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) (Entity FilePath))
    -> String -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall a b. (a -> b) -> a -> b
    $
                "loadFilePath: No row found for " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
                (Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath -> Text
    P.unSafeFilePath SafeFilePath
    path)
            Just record :: Entity FilePath
    record -> Entity FilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Entity FilePath
    record

    loadHPackTreeEntity :: TreeId -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    loadHPackTreeEntity :: Key Tree -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    loadHPackTreeEntity tid :: Key Tree
    tid = do
      Entity FilePath
    filepath <- SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath SafeFilePath
    P.hpackSafeFilePath
      let Key FilePath
    filePathId :: FilePathId = Entity FilePath -> Key FilePath
    forall record. Entity record -> Key record
    entityKey Entity FilePath
    filepath
      Maybe (Entity TreeEntry)
    hpackTreeEntry <-
        [Filter TreeEntry]
    -> [SelectOpt TreeEntry]
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity TreeEntry))
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
    selectFirst [EntityField TreeEntry (Key Tree)
    forall typ. (typ ~ Key Tree) => EntityField TreeEntry typ
    TreeEntryTree EntityField TreeEntry (Key Tree) -> Key Tree -> Filter TreeEntry
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Tree
    tid, EntityField TreeEntry (Key FilePath)
    forall typ. (typ ~ Key FilePath) => EntityField TreeEntry typ
    TreeEntryPath EntityField TreeEntry (Key FilePath)
    -> Key FilePath -> Filter TreeEntry
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key FilePath
    filePathId] []
      case Maybe (Entity TreeEntry)
    hpackTreeEntry of
        Nothing ->
          String -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) (Entity TreeEntry))
    -> String -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    forall a b. (a -> b) -> a -> b
    $
          "loadHPackTreeEntity: No package.yaml file found in TreeEntry for TreeId:  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
          Key Tree -> String
    forall a. Show a => a -> String
    show Key Tree
    tid
        Just record :: Entity TreeEntry
    record -> Entity TreeEntry -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Entity TreeEntry
    record

    storeHPack ::
           (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => P.RawPackageLocationImmutable
        -> TreeId
        -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack :: RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack rpli :: RawPackageLocationImmutable
    rpli tid :: Key Tree
    tid = do
        Key Version
    vid <- ReaderT SqlBackend (RIO env) (Key Version)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId
        Maybe (Entity HPack)
    hpackRecord <- Unique HPack -> ReaderT SqlBackend (RIO env) (Maybe (Entity HPack))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Key Tree -> Key Version -> Unique HPack
    UniqueHPack Key Tree
    tid Key Version
    vid)
        case Maybe (Entity HPack)
    hpackRecord of
          Nothing -> RawPackageLocationImmutable
    -> Key Tree
    -> Key Version
    -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree
    -> Key Version
    -> ReaderT SqlBackend (RIO env) (Key HPack)
    generateHPack RawPackageLocationImmutable
    rpli Key Tree
    tid Key Version
    vid
          Just record :: Entity HPack
    record -> Key HPack -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Key HPack -> ReaderT SqlBackend (RIO env) (Key HPack))
    -> Key HPack -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall a b. (a -> b) -> a -> b
    $ Entity HPack -> Key HPack
    forall record. Entity record -> Key record
    entityKey Entity HPack
    record

    loadCabalBlobKey :: HPackId -> ReaderT SqlBackend (RIO env) BlobKey
    loadCabalBlobKey :: Key HPack -> ReaderT SqlBackend (RIO env) BlobKey
    loadCabalBlobKey hpackId :: Key HPack
    hpackId = do
      HPack
    hpackRecord <- Key HPack -> ReaderT SqlBackend (RIO env) HPack
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, PersistRecordBackend record backend,
     MonadIO m) =>
    Key record -> ReaderT backend m record
    getJust Key HPack
    hpackId
      Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey (Key Blob -> ReaderT SqlBackend (RIO env) BlobKey)
    -> Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall a b. (a -> b) -> a -> b
    $ HPack -> Key Blob
    hPackCabalBlob HPack
    hpackRecord

    generateHPack ::
           (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => P.RawPackageLocationImmutable -- ^ for exceptions
        -> TreeId
        -> VersionId
        -> ReaderT SqlBackend (RIO env) (Key HPack)
    generateHPack :: RawPackageLocationImmutable
    -> Key Tree
    -> Key Version
    -> ReaderT SqlBackend (RIO env) (Key HPack)
    generateHPack rpli :: RawPackageLocationImmutable
    rpli tid :: Key Tree
    tid vid :: Key Version
    vid = do
        Tree
    tree <- Key Tree -> ReaderT SqlBackend (RIO env) Tree
    forall env. Key Tree -> ReaderT SqlBackend (RIO env) Tree
    getTree Key Tree
    tid
        (pkgName :: PackageName
    pkgName, cabalBS :: ByteString
    cabalBS) <- RawPackageLocationImmutable
    -> Tree -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Tree -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    hpackToCabalS RawPackageLocationImmutable
    rpli Tree
    tree
        Key Blob
    bid <- ByteString
    -> PackageName -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall env.
    ByteString
    -> PackageName -> ReaderT SqlBackend (RIO env) (Key Blob)
    storeCabalFile ByteString
    cabalBS PackageName
    pkgName
        let cabalFile :: SafeFilePath
    cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    pkgName
        Either (Entity FilePath) (Key FilePath)
    fid <- FilePath
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity FilePath) (Key FilePath))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy $WFilePath :: SafeFilePath -> FilePath
    FilePath {filePathPath :: SafeFilePath
    filePathPath = SafeFilePath
    cabalFile}
        let hpackRecord :: HPack
    hpackRecord =
                $WHPack :: Key Tree -> Key Version -> Key Blob -> Key FilePath -> HPack
    HPack
                    { hPackTree :: Key Tree
    hPackTree = Key Tree
    tid
                    , hPackVersion :: Key Version
    hPackVersion = Key Version
    vid
                    , hPackCabalBlob :: Key Blob
    hPackCabalBlob = Key Blob
    bid
                    , hPackCabalPath :: Key FilePath
    hPackCabalPath = (Entity FilePath -> Key FilePath)
    -> (Key FilePath -> Key FilePath)
    -> Either (Entity FilePath) (Key FilePath)
    -> Key FilePath
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity FilePath -> Key FilePath
    forall record. Entity record -> Key record
    entityKey Key FilePath -> Key FilePath
    forall a. a -> a
    id Either (Entity FilePath) (Key FilePath)
    fid
                    }
        (Entity HPack -> Key HPack)
    -> (Key HPack -> Key HPack)
    -> Either (Entity HPack) (Key HPack)
    -> Key HPack
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity HPack -> Key HPack
    forall record. Entity record -> Key record
    entityKey Key HPack -> Key HPack
    forall a. a -> a
    id (Either (Entity HPack) (Key HPack) -> Key HPack)
    -> ReaderT SqlBackend (RIO env) (Either (Entity HPack) (Key HPack))
    -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HPack
    -> ReaderT SqlBackend (RIO env) (Either (Entity HPack) (Key HPack))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy HPack
    hpackRecord

    hpackVersionId ::
           (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => ReaderT SqlBackend (RIO env) VersionId
    hpackVersionId :: ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId = do
        Version
    hpackSoftwareVersion <- RIO env Version -> ReaderT SqlBackend (RIO env) Version
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift RIO env Version
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RIO env Version
    hpackVersion
        (Either (Entity Version) (Key Version) -> Key Version)
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    -> ReaderT SqlBackend (RIO env) (Key Version)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity Version -> Key Version)
    -> (Key Version -> Key Version)
    -> Either (Entity Version) (Key Version)
    -> Key Version
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity Version -> Key Version
    forall record. Entity record -> Key record
    entityKey Key Version -> Key Version
    forall a. a -> a
    id) (ReaderT
       SqlBackend (RIO env) (Either (Entity Version) (Key Version))
     -> ReaderT SqlBackend (RIO env) (Key Version))
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    -> ReaderT SqlBackend (RIO env) (Key Version)
    forall a b. (a -> b) -> a -> b
    $
          Version
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy (Version
     -> ReaderT
          SqlBackend (RIO env) (Either (Entity Version) (Key Version)))
    -> Version
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity Version) (Key Version))
    forall a b. (a -> b) -> a -> b
    $
          $WVersion :: VersionP -> Version
    Version {versionVersion :: VersionP
    versionVersion = Version -> VersionP
    P.VersionP Version
    hpackSoftwareVersion}

    getFilePathId :: SafeFilePath -> ReaderT SqlBackend (RIO env) FilePathId
    getFilePathId :: SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    getFilePathId sfp :: SafeFilePath
    sfp =
      [Filter FilePath]
    -> [SelectOpt FilePath]
    -> ReaderT SqlBackend (RIO env) [Key FilePath]
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistQueryRead backend,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m [Key record]
    selectKeysList [EntityField FilePath SafeFilePath
    forall typ. (typ ~ SafeFilePath) => EntityField FilePath typ
    FilePathPath EntityField FilePath SafeFilePath
    -> SafeFilePath -> Filter FilePath
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. SafeFilePath
    sfp] [] ReaderT SqlBackend (RIO env) [Key FilePath]
    -> ([Key FilePath] -> ReaderT SqlBackend (RIO env) (Key FilePath))
    -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        [fpId :: Key FilePath
    fpId] -> Key FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key FilePath
    fpId
        [] ->
          RdbmsActions env (Key FilePath)
    -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery
            $WRdbmsActions :: forall env a.
    ReaderT SqlBackend (RIO env) a
    -> ReaderT SqlBackend (RIO env) a -> RdbmsActions env a
    RdbmsActions
              { raSqlite :: ReaderT SqlBackend (RIO env) (Key FilePath)
    raSqlite = FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m (Key record)
    insert (FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath))
    -> FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath -> FilePath
    FilePath SafeFilePath
    sfp
              , raPostgres :: ReaderT SqlBackend (RIO env) (Key FilePath)
    raPostgres =
                  do Text -> [PersistValue] -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) backend.
    (MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m ()
    rawExecute
                       "INSERT INTO file_path(path) VALUES (?) ON CONFLICT DO NOTHING"
                       [SafeFilePath -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SafeFilePath
    sfp]
                     Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [Single (Key FilePath)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
                       "SELECT id FROM file_path WHERE path = ?"
                       [SafeFilePath -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SafeFilePath
    sfp] ReaderT SqlBackend (RIO env) [Single (Key FilePath)]
    -> ([Single (Key FilePath)]
        -> ReaderT SqlBackend (RIO env) (Key FilePath))
    -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                       [Single key :: Key FilePath
    key] -> Key FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key FilePath
    key
                       _ ->
                         String -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a. HasCallStack => String -> a
    error
                           "getFilePathId: there was a critical problem storing a blob."
              }
        _ ->
          String -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) (Key FilePath))
    -> String -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a b. (a -> b) -> a -> b
    $
          "getFilePathId: FilePath unique constraint key is violated for: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fp
      where
        fp :: String
    fp = Text -> String
    T.unpack (SafeFilePath -> Text
    P.unSafeFilePath SafeFilePath
    sfp)

    storeTree
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => P.RawPackageLocationImmutable -- ^ for exceptions
      -> P.PackageIdentifier
      -> P.Tree
      -> P.BuildFile
      -> ReaderT SqlBackend (RIO env) (TreeId, P.TreeKey)
    storeTree :: RawPackageLocationImmutable
    -> PackageIdentifier
    -> Tree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    storeTree rpli :: RawPackageLocationImmutable
    rpli (P.PackageIdentifier name :: PackageName
    name version :: Version
    version) tree :: Tree
    tree@(P.TreeMap m :: Map SafeFilePath TreeEntry
    m) buildFile :: BuildFile
    buildFile = do
      (bid :: Key Blob
    bid, blobKey :: BlobKey
    blobKey) <- ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob (ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey))
    -> ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall a b. (a -> b) -> a -> b
    $ Tree -> ByteString
    P.renderTree Tree
    tree
      (cabalid :: Maybe (Key Blob)
    cabalid, ftype :: FileType
    ftype) <- case BuildFile
    buildFile of
                    P.BFHpack (P.TreeEntry _ ftype :: FileType
    ftype) -> (Maybe (Key Blob), FileType)
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob), FileType)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Key Blob)
    forall a. Maybe a
    Nothing, FileType
    ftype)
                    P.BFCabal _ (P.TreeEntry (P.BlobKey btypeSha :: SHA256
    btypeSha _) ftype :: FileType
    ftype) -> do
                                   Maybe (Key Blob)
    buildTypeid <- SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    loadBlobBySHA SHA256
    btypeSha
                                   Key Blob
    buildid <-
                                       case Maybe (Key Blob)
    buildTypeid of
                                         Just buildId :: Key Blob
    buildId -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    buildId
                                         Nothing -> String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) (Key Blob))
    -> String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a b. (a -> b) -> a -> b
    $ "storeTree: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (BuildFile -> String
    forall a. Show a => a -> String
    show BuildFile
    buildFile) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " BlobKey not found: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Tree, SHA256) -> String
    forall a. Show a => a -> String
    show (Tree
    tree, SHA256
    btypeSha)
                                   (Maybe (Key Blob), FileType)
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob), FileType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Key Blob -> Maybe (Key Blob)
    forall a. a -> Maybe a
    Just Key Blob
    buildid, FileType
    ftype)
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      Either (Entity Tree) (Key Tree)
    etid <- Tree
    -> ReaderT SqlBackend (RIO env) (Either (Entity Tree) (Key Tree))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy $WTree :: Key Blob
    -> Maybe (Key Blob)
    -> FileType
    -> Key PackageName
    -> Key Version
    -> Tree
    Tree
        { treeKey :: Key Blob
    treeKey = Key Blob
    bid
        , treeCabal :: Maybe (Key Blob)
    treeCabal = Maybe (Key Blob)
    cabalid
        , treeCabalType :: FileType
    treeCabalType = FileType
    ftype
        , treeName :: Key PackageName
    treeName = Key PackageName
    nameid
        , treeVersion :: Key Version
    treeVersion = Key Version
    versionid
        }

      (tid :: Key Tree
    tid, pTreeKey :: TreeKey
    pTreeKey) <- case Either (Entity Tree) (Key Tree)
    etid of
        Left (Entity tid :: Key Tree
    tid _) -> (Key Tree, TreeKey)
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Key Tree
    tid, BlobKey -> TreeKey
    P.TreeKey BlobKey
    blobKey) -- already in database, assume it matches
        Right tid :: Key Tree
    tid -> do
          [(SafeFilePath, TreeEntry)]
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ (Map SafeFilePath TreeEntry -> [(SafeFilePath, TreeEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map SafeFilePath TreeEntry
    m) (((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \(sfp :: SafeFilePath
    sfp, P.TreeEntry blobKey' :: BlobKey
    blobKey' ft :: FileType
    ft) -> do
            Key FilePath
    sfpid <- SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    getFilePathId SafeFilePath
    sfp
            Maybe (Key Blob)
    mbid <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    getBlobId BlobKey
    blobKey'
            Key Blob
    bid' <-
              case Maybe (Key Blob)
    mbid of
                Nothing -> String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) (Key Blob))
    -> String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a b. (a -> b) -> a -> b
    $ "Cannot store tree, contains unknown blob: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ BlobKey -> String
    forall a. Show a => a -> String
    show BlobKey
    blobKey'
                Just bid' :: Key Blob
    bid' -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    bid'
            TreeEntry -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WTreeEntry :: Key Tree -> Key FilePath -> Key Blob -> FileType -> TreeEntry
    TreeEntry
              { treeEntryTree :: Key Tree
    treeEntryTree = Key Tree
    tid
              , treeEntryPath :: Key FilePath
    treeEntryPath = Key FilePath
    sfpid
              , treeEntryBlob :: Key Blob
    treeEntryBlob = Key Blob
    bid'
              , treeEntryType :: FileType
    treeEntryType = FileType
    ft
              }
          (Key Tree, TreeKey)
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Key Tree
    tid, BlobKey -> TreeKey
    P.TreeKey BlobKey
    blobKey)
      case BuildFile
    buildFile of
        P.BFHpack _ -> RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack RawPackageLocationImmutable
    rpli Key Tree
    tid ReaderT SqlBackend (RIO env) (Key HPack)
    -> ReaderT SqlBackend (RIO env) ()
    -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        P.BFCabal _ _ -> () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      (Key Tree, TreeKey)
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Key Tree
    tid, TreeKey
    pTreeKey)

    getTree :: TreeId -> ReaderT SqlBackend (RIO env) P.Tree
    getTree :: Key Tree -> ReaderT SqlBackend (RIO env) Tree
    getTree tid :: Key Tree
    tid = do
      (Maybe Tree
    mts :: Maybe Tree) <- Key Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get Key Tree
    tid
      Tree
    ts <-
          case Maybe Tree
    mts of
            Nothing ->
                String -> ReaderT SqlBackend (RIO env) Tree
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) Tree)
    -> String -> ReaderT SqlBackend (RIO env) Tree
    forall a b. (a -> b) -> a -> b
    $ "getTree: invalid foreign key " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key Tree -> String
    forall a. Show a => a -> String
    show Key Tree
    tid
            Just ts :: Tree
    ts -> Tree -> ReaderT SqlBackend (RIO env) Tree
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    ts
      Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    forall env. Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    loadTreeByEnt (Entity Tree -> ReaderT SqlBackend (RIO env) Tree)
    -> Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    forall a b. (a -> b) -> a -> b
    $ Key Tree -> Tree -> Entity Tree
    forall record. Key record -> record -> Entity record
    Entity Key Tree
    tid Tree
    ts

    loadTree :: P.TreeKey -> ReaderT SqlBackend (RIO env) (Maybe P.Tree)
    loadTree :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    loadTree key :: TreeKey
    key = do
      Maybe (Entity Tree)
    ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey TreeKey
    key
      case Maybe (Entity Tree)
    ment of
        Nothing -> Maybe Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Tree
    forall a. Maybe a
    Nothing
        Just ent :: Entity Tree
    ent -> Tree -> Maybe Tree
    forall a. a -> Maybe a
    Just (Tree -> Maybe Tree)
    -> ReaderT SqlBackend (RIO env) Tree
    -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    forall env. Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    loadTreeByEnt Entity Tree
    ent

    getTreeForKey
      :: TreeKey
      -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey (P.TreeKey key :: BlobKey
    key) = do
      Maybe (Key Blob)
    mbid <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    getBlobId BlobKey
    key
      case Maybe (Key Blob)
    mbid of
        Nothing -> Maybe (Entity Tree)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Entity Tree)
    forall a. Maybe a
    Nothing
        Just bid :: Key Blob
    bid -> Unique Tree -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Unique Tree -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> Unique Tree
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall a b. (a -> b) -> a -> b
    $ Key Blob -> Unique Tree
    UniqueTree Key Blob
    bid

    loadPackageById ::
           (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => P.RawPackageLocationImmutable -- ^ for exceptions
        -> TreeId
        -> ReaderT SqlBackend (RIO env) Package
    loadPackageById :: RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) Package
    loadPackageById rpli :: RawPackageLocationImmutable
    rpli tid :: Key Tree
    tid = do
        (Maybe Tree
    mts :: Maybe Tree) <- Key Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get Key Tree
    tid
        Tree
    ts <-
            case Maybe Tree
    mts of
                Nothing ->
                    String -> ReaderT SqlBackend (RIO env) Tree
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) Tree)
    -> String -> ReaderT SqlBackend (RIO env) Tree
    forall a b. (a -> b) -> a -> b
    $ "loadPackageById: invalid foreign key " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key Tree -> String
    forall a. Show a => a -> String
    show Key Tree
    tid
                Just ts :: Tree
    ts -> Tree -> ReaderT SqlBackend (RIO env) Tree
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    ts
        (Tree
    tree :: P.Tree) <- Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    forall env. Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    loadTreeByEnt (Entity Tree -> ReaderT SqlBackend (RIO env) Tree)
    -> Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    forall a b. (a -> b) -> a -> b
    $ Key Tree -> Tree -> Entity Tree
    forall record. Key record -> record -> Entity record
    Entity Key Tree
    tid Tree
    ts
        (BlobKey
    blobKey :: BlobKey) <- Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey (Key Blob -> ReaderT SqlBackend (RIO env) BlobKey)
    -> Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall a b. (a -> b) -> a -> b
    $ Tree -> Key Blob
    treeKey Tree
    ts
        (Maybe PackageName
    mname :: Maybe PackageName) <- Key PackageName -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get (Key PackageName
     -> ReaderT SqlBackend (RIO env) (Maybe PackageName))
    -> Key PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall a b. (a -> b) -> a -> b
    $ Tree -> Key PackageName
    treeName Tree
    ts
        PackageName
    name <-
            case Maybe PackageName
    mname of
                Nothing ->
                    String -> ReaderT SqlBackend (RIO env) PackageName
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) PackageName)
    -> String -> ReaderT SqlBackend (RIO env) PackageName
    forall a b. (a -> b) -> a -> b
    $
                    "loadPackageByid: invalid foreign key " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key PackageName -> String
    forall a. Show a => a -> String
    show (Tree -> Key PackageName
    treeName Tree
    ts)
                Just (PackageName (P.PackageNameP name :: PackageName
    name)) -> PackageName -> ReaderT SqlBackend (RIO env) PackageName
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PackageName
    name
        Maybe Version
    mversion <- Key Version -> ReaderT SqlBackend (RIO env) (Maybe Version)
    forall backend (m :: * -> *) record.
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    get (Key Version -> ReaderT SqlBackend (RIO env) (Maybe Version))
    -> Key Version -> ReaderT SqlBackend (RIO env) (Maybe Version)
    forall a b. (a -> b) -> a -> b
    $ Tree -> Key Version
    treeVersion Tree
    ts
        Version
    version <-
            case Maybe Version
    mversion of
                Nothing ->
                    String -> ReaderT SqlBackend (RIO env) Version
    forall a. HasCallStack => String -> a
    error (String -> ReaderT SqlBackend (RIO env) Version)
    -> String -> ReaderT SqlBackend (RIO env) Version
    forall a b. (a -> b) -> a -> b
    $
                    "loadPackageByid: invalid foreign key " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key Version -> String
    forall a. Show a => a -> String
    show (Tree -> Key Version
    treeVersion Tree
    ts)
                Just (Version (P.VersionP version :: Version
    version)) -> Version -> ReaderT SqlBackend (RIO env) Version
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Version
    version
        let ident :: PackageIdentifier
    ident = PackageName -> Version -> PackageIdentifier
    P.PackageIdentifier PackageName
    name Version
    version
        (packageEntry :: PackageCabal
    packageEntry, mtree :: Tree
    mtree) <-
            case Tree -> Maybe (Key Blob)
    treeCabal Tree
    ts of
                Just keyBlob :: Key Blob
    keyBlob -> do
                    BlobKey
    cabalKey <- Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey Key Blob
    keyBlob
                    (PackageCabal, Tree)
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                        ( TreeEntry -> PackageCabal
    P.PCCabalFile (TreeEntry -> PackageCabal) -> TreeEntry -> PackageCabal
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> FileType -> TreeEntry
    P.TreeEntry BlobKey
    cabalKey (Tree -> FileType
    treeCabalType Tree
    ts)
                        , Tree
    tree)
                Nothing -> do
                    Key Version
    hpackVid <- ReaderT SqlBackend (RIO env) (Key Version)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId
                    Maybe (Entity HPack)
    hpackEntity <- Unique HPack -> ReaderT SqlBackend (RIO env) (Maybe (Entity HPack))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Key Tree -> Key Version -> Unique HPack
    UniqueHPack Key Tree
    tid Key Version
    hpackVid)
                    let (P.TreeMap tmap :: Map SafeFilePath TreeEntry
    tmap) = Tree
    tree
                        cabalFile :: SafeFilePath
    cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    name
                    case Maybe (Entity HPack)
    hpackEntity of
                        Nothing
                            -- This case will happen when you either
                            -- update stack with a new hpack version or
                            -- use different hpack version via
                            -- --with-hpack option.
                         -> do
                            (Key HPack
    hpackId :: HPackId) <- RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack RawPackageLocationImmutable
    rpli Key Tree
    tid
                            HPack
    hpackRecord <- Key HPack -> ReaderT SqlBackend (RIO env) HPack
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, PersistRecordBackend record backend,
     MonadIO m) =>
    Key record -> ReaderT backend m record
    getJust Key HPack
    hpackId
                            HPack
    -> Tree
    -> Map SafeFilePath TreeEntry
    -> SafeFilePath
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    HPack
    -> Tree
    -> Map SafeFilePath TreeEntry
    -> SafeFilePath
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    getHPackCabalFile HPack
    hpackRecord Tree
    ts Map SafeFilePath TreeEntry
    tmap SafeFilePath
    cabalFile
                        Just (Entity _ item :: HPack
    item) ->
                            HPack
    -> Tree
    -> Map SafeFilePath TreeEntry
    -> SafeFilePath
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    HPack
    -> Tree
    -> Map SafeFilePath TreeEntry
    -> SafeFilePath
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    getHPackCabalFile HPack
    item Tree
    ts Map SafeFilePath TreeEntry
    tmap SafeFilePath
    cabalFile
        Package -> ReaderT SqlBackend (RIO env) Package
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            $WPackage :: TreeKey -> Tree -> PackageCabal -> PackageIdentifier -> Package
    Package
                { packageTreeKey :: TreeKey
    packageTreeKey = BlobKey -> TreeKey
    P.TreeKey BlobKey
    blobKey
                , packageTree :: Tree
    packageTree = Tree
    mtree
                , packageCabalEntry :: PackageCabal
    packageCabalEntry = PackageCabal
    packageEntry
                , packageIdent :: PackageIdentifier
    packageIdent = PackageIdentifier
    ident
                }

    getHPackBlobKey :: HPack -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKey :: HPack -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKey hpackRecord :: HPack
    hpackRecord = do
      let treeId :: Key Tree
    treeId = HPack -> Key Tree
    hPackTree HPack
    hpackRecord
      Entity TreeEntry
    hpackEntity <- Key Tree -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    forall env.
    Key Tree -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    loadHPackTreeEntity Key Tree
    treeId
      Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey (TreeEntry -> Key Blob
    treeEntryBlob (TreeEntry -> Key Blob) -> TreeEntry -> Key Blob
    forall a b. (a -> b) -> a -> b
    $ Entity TreeEntry -> TreeEntry
    forall record. Entity record -> record
    entityVal Entity TreeEntry
    hpackEntity)

    getHPackBlobKeyById :: HPackId -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKeyById :: Key HPack -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKeyById hpackId :: Key HPack
    hpackId = do
      HPack
    hpackRecord <- Key HPack -> ReaderT SqlBackend (RIO env) HPack
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, PersistRecordBackend record backend,
     MonadIO m) =>
    Key record -> ReaderT backend m record
    getJust Key HPack
    hpackId
      HPack -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. HPack -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKey HPack
    hpackRecord

    getHPackCabalFile ::
           (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => HPack
        -> Tree
        -> Map SafeFilePath P.TreeEntry
        -> SafeFilePath
        -> ReaderT SqlBackend (RIO env) (P.PackageCabal, P.Tree)
    getHPackCabalFile :: HPack
    -> Tree
    -> Map SafeFilePath TreeEntry
    -> SafeFilePath
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    getHPackCabalFile hpackRecord :: HPack
    hpackRecord ts :: Tree
    ts tmap :: Map SafeFilePath TreeEntry
    tmap cabalFile :: SafeFilePath
    cabalFile = do
        BlobKey
    cabalKey <- Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey (HPack -> Key Blob
    hPackCabalBlob HPack
    hpackRecord)
        BlobKey
    hpackKey <- HPack -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. HPack -> ReaderT SqlBackend (RIO env) BlobKey
    getHPackBlobKey HPack
    hpackRecord
        Version
    hpackSoftwareVersion <- RIO env Version -> ReaderT SqlBackend (RIO env) Version
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift RIO env Version
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RIO env Version
    hpackVersion
        let fileType :: FileType
    fileType = Tree -> FileType
    treeCabalType Tree
    ts
            cbTreeEntry :: TreeEntry
    cbTreeEntry = BlobKey -> FileType -> TreeEntry
    P.TreeEntry BlobKey
    cabalKey FileType
    fileType
            hpackTreeEntry :: TreeEntry
    hpackTreeEntry = BlobKey -> FileType -> TreeEntry
    P.TreeEntry BlobKey
    hpackKey FileType
    fileType
            tree :: Tree
    tree = Map SafeFilePath TreeEntry -> Tree
    P.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 SafeFilePath
    cabalFile TreeEntry
    cbTreeEntry Map SafeFilePath TreeEntry
    tmap
        (PackageCabal, Tree)
    -> ReaderT SqlBackend (RIO env) (PackageCabal, Tree)
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            ( PHpack -> PackageCabal
    P.PCHpack (PHpack -> PackageCabal) -> PHpack -> PackageCabal
    forall a b. (a -> b) -> a -> b
    $
              $WPHpack :: TreeEntry -> TreeEntry -> Version -> PHpack
    P.PHpack
                  { phOriginal :: TreeEntry
    P.phOriginal = TreeEntry
    hpackTreeEntry
                  , phGenerated :: TreeEntry
    P.phGenerated = TreeEntry
    cbTreeEntry
                  , phVersion :: Version
    P.phVersion = Version
    hpackSoftwareVersion
                  }
            , Tree
    tree)

    loadTreeByEnt :: Entity Tree -> ReaderT SqlBackend (RIO env) P.Tree
    loadTreeByEnt :: Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    loadTreeByEnt (Entity tid :: Key Tree
    tid _t :: Tree
    _t) = do
      [(Single SafeFilePath, Single SHA256, Single FileSize,
      Single FileType)]
    entries <- Text
    -> [PersistValue]
    -> ReaderT
         SqlBackend
         (RIO env)
         [(Single SafeFilePath, Single SHA256, Single FileSize,
           Single FileType)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT file_path.path, blob.sha, blob.size, tree_entry.type\n\
        \FROM tree_entry, blob, file_path\n\
        \WHERE tree_entry.tree=?\n\
        \AND   tree_entry.blob=blob.id\n\
        \AND   tree_entry.path=file_path.id"
        [Key Tree -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key Tree
    tid]
      Tree -> ReaderT SqlBackend (RIO env) Tree
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Tree -> ReaderT SqlBackend (RIO env) Tree)
    -> Tree -> ReaderT SqlBackend (RIO env) Tree
    forall a b. (a -> b) -> a -> b
    $ Map SafeFilePath TreeEntry -> Tree
    P.TreeMap (Map SafeFilePath TreeEntry -> Tree)
    -> Map SafeFilePath TreeEntry -> Tree
    forall a b. (a -> b) -> a -> b
    $ [(SafeFilePath, TreeEntry)] -> Map SafeFilePath TreeEntry
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(SafeFilePath, TreeEntry)] -> Map SafeFilePath TreeEntry)
    -> [(SafeFilePath, TreeEntry)] -> Map SafeFilePath TreeEntry
    forall a b. (a -> b) -> a -> b
    $ ((Single SafeFilePath, Single SHA256, Single FileSize,
      Single FileType)
     -> (SafeFilePath, TreeEntry))
    -> [(Single SafeFilePath, Single SHA256, Single FileSize,
         Single FileType)]
    -> [(SafeFilePath, TreeEntry)]
    forall a b. (a -> b) -> [a] -> [b]
    map
        (\(Single sfp :: SafeFilePath
    sfp, Single sha :: SHA256
    sha, Single size :: FileSize
    size, Single ft :: FileType
    ft) ->
             (SafeFilePath
    sfp, BlobKey -> FileType -> TreeEntry
    P.TreeEntry (SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size) FileType
    ft))
        [(Single SafeFilePath, Single SHA256, Single FileSize,
      Single FileType)]
    entries

    storeHackageTree
      :: P.PackageName
      -> P.Version
      -> BlobId
      -> P.TreeKey
      -> ReaderT SqlBackend (RIO env) ()
    storeHackageTree :: PackageName
    -> Version
    -> Key Blob
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    storeHackageTree name :: PackageName
    name version :: Version
    version cabal :: Key Blob
    cabal treeKey' :: TreeKey
    treeKey' = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    version
      Maybe (Entity Tree)
    ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey TreeKey
    treeKey'
      Maybe (Entity Tree)
    -> (Entity Tree -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe (Entity Tree)
    ment ((Entity Tree -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> (Entity Tree -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \ent :: Entity Tree
    ent -> [Filter HackageCabal]
    -> [Update HackageCabal] -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistQueryWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> [Update record] -> ReaderT backend m ()
    updateWhere
        [ EntityField HackageCabal (Key PackageName)
    forall typ. (typ ~ Key PackageName) => EntityField HackageCabal typ
    HackageCabalName EntityField HackageCabal (Key PackageName)
    -> Key PackageName -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key PackageName
    nameid
        , EntityField HackageCabal (Key Version)
    forall typ. (typ ~ Key Version) => EntityField HackageCabal typ
    HackageCabalVersion EntityField HackageCabal (Key Version)
    -> Key Version -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Version
    versionid
        , EntityField HackageCabal (Key Blob)
    forall typ. (typ ~ Key Blob) => EntityField HackageCabal typ
    HackageCabalCabal EntityField HackageCabal (Key Blob)
    -> Key Blob -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Blob
    cabal
        ]
        [EntityField HackageCabal (Maybe (Key Tree))
    forall typ.
    (typ ~ Maybe (Key Tree)) =>
    EntityField HackageCabal typ
    HackageCabalTree EntityField HackageCabal (Maybe (Key Tree))
    -> Maybe (Key Tree) -> Update HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Update v
    =. Key Tree -> Maybe (Key Tree)
    forall a. a -> Maybe a
    Just (Entity Tree -> Key Tree
    forall record. Entity record -> Key record
    entityKey Entity Tree
    ent)]

    loadHackageTreeKey
      :: P.PackageName
      -> P.Version
      -> SHA256
      -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    loadHackageTreeKey :: PackageName
    -> Version
    -> SHA256
    -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    loadHackageTreeKey name :: PackageName
    name ver :: Version
    ver sha :: SHA256
    sha = do
      [(Single SHA256, Single FileSize)]
    res <- Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [(Single SHA256, Single FileSize)]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT treeblob.sha, treeblob.size\n\
        \FROM blob as treeblob, blob as cabalblob, package_name, version, hackage_cabal, tree\n\
        \WHERE package_name.name=?\n\
        \AND   version.version=?\n\
        \AND   cabalblob.sha=?\n\
        \AND   hackage_cabal.name=package_name.id\n\
        \AND   hackage_cabal.version=version.id\n\
        \AND   hackage_cabal.cabal=cabalblob.id\n\
        \AND   hackage_cabal.tree=tree.id\n\
        \AND   tree.key=treeblob.id"
        [ PackageNameP -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue (PackageNameP -> PersistValue) -> PackageNameP -> PersistValue
    forall a b. (a -> b) -> a -> b
    $ PackageName -> PackageNameP
    P.PackageNameP PackageName
    name
        , VersionP -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue (VersionP -> PersistValue) -> VersionP -> PersistValue
    forall a b. (a -> b) -> a -> b
    $ Version -> VersionP
    P.VersionP Version
    ver
        , SHA256 -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue SHA256
    sha
        ]
      case [(Single SHA256, Single FileSize)]
    res of
        [] -> Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe TreeKey
    forall a. Maybe a
    Nothing
        (Single treesha :: SHA256
    treesha, Single size :: FileSize
    size):_ ->
          Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey))
    -> Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall a b. (a -> b) -> a -> b
    $ TreeKey -> Maybe TreeKey
    forall a. a -> Maybe a
    Just (TreeKey -> Maybe TreeKey) -> TreeKey -> Maybe TreeKey
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> TreeKey
    P.TreeKey (BlobKey -> TreeKey) -> BlobKey -> TreeKey
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    treesha FileSize
    size

    loadHackageTree
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => P.RawPackageLocationImmutable -- ^ for exceptions
      -> P.PackageName
      -> P.Version
      -> BlobId
      -> ReaderT SqlBackend (RIO env) (Maybe Package)
    loadHackageTree :: RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> Key Blob
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    loadHackageTree rpli :: RawPackageLocationImmutable
    rpli name :: PackageName
    name ver :: Version
    ver bid :: Key Blob
    bid = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Key Version
    versionid <- Version -> ReaderT SqlBackend (RIO env) (Key Version)
    forall env. Version -> ReaderT SqlBackend (RIO env) (Key Version)
    getVersionId Version
    ver
      Maybe (Entity HackageCabal)
    ment <- [Filter HackageCabal]
    -> [SelectOpt HackageCabal]
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity HackageCabal))
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
    selectFirst
        [ EntityField HackageCabal (Key PackageName)
    forall typ. (typ ~ Key PackageName) => EntityField HackageCabal typ
    HackageCabalName EntityField HackageCabal (Key PackageName)
    -> Key PackageName -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key PackageName
    nameid
        , EntityField HackageCabal (Key Version)
    forall typ. (typ ~ Key Version) => EntityField HackageCabal typ
    HackageCabalVersion EntityField HackageCabal (Key Version)
    -> Key Version -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Version
    versionid
        , EntityField HackageCabal (Key Blob)
    forall typ. (typ ~ Key Blob) => EntityField HackageCabal typ
    HackageCabalCabal EntityField HackageCabal (Key Blob)
    -> Key Blob -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key Blob
    bid
        , EntityField HackageCabal (Maybe (Key Tree))
    forall typ.
    (typ ~ Maybe (Key Tree)) =>
    EntityField HackageCabal typ
    HackageCabalTree EntityField HackageCabal (Maybe (Key Tree))
    -> Maybe (Key Tree) -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    !=. Maybe (Key Tree)
    forall a. Maybe a
    Nothing
        ]
        []
      case Maybe (Entity HackageCabal)
    ment of
        Nothing -> Maybe Package -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just (Entity _ hc :: HackageCabal
    hc) ->
          case HackageCabal -> Maybe (Key Tree)
    hackageCabalTree HackageCabal
    hc of
            Nothing -> Bool
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall a. HasCallStack => Bool -> a -> a
    assert Bool
    False (ReaderT SqlBackend (RIO env) (Maybe Package)
     -> ReaderT SqlBackend (RIO env) (Maybe Package))
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall a b. (a -> b) -> a -> b
    $ Maybe Package -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
            Just tid :: Key Tree
    tid -> Package -> Maybe Package
    forall a. a -> Maybe a
    Just (Package -> Maybe Package)
    -> ReaderT SqlBackend (RIO env) Package
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) Package
    loadPackageById RawPackageLocationImmutable
    rpli Key Tree
    tid

    storeArchiveCache
      :: Text -- ^ URL
      -> Text -- ^ subdir
      -> SHA256
      -> FileSize
      -> P.TreeKey
      -> ReaderT SqlBackend (RIO env) ()
    storeArchiveCache :: Text
    -> Text
    -> SHA256
    -> FileSize
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    storeArchiveCache url :: Text
    url subdir :: Text
    subdir sha :: SHA256
    sha size :: FileSize
    size treeKey' :: TreeKey
    treeKey' = do
      UTCTime
    now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      Maybe (Entity Tree)
    ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey TreeKey
    treeKey'
      Maybe (Entity Tree)
    -> (Entity Tree -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe (Entity Tree)
    ment ((Entity Tree -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> (Entity Tree -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \ent :: Entity Tree
    ent -> ArchiveCache -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WArchiveCache :: UTCTime
    -> Text -> Text -> SHA256 -> FileSize -> Key Tree -> ArchiveCache
    ArchiveCache
        { archiveCacheTime :: UTCTime
    archiveCacheTime = UTCTime
    now
        , archiveCacheUrl :: Text
    archiveCacheUrl = Text
    url
        , archiveCacheSubdir :: Text
    archiveCacheSubdir = Text
    subdir
        , archiveCacheSha :: SHA256
    archiveCacheSha = SHA256
    sha
        , archiveCacheSize :: FileSize
    archiveCacheSize = FileSize
    size
        , archiveCacheTree :: Key Tree
    archiveCacheTree = Entity Tree -> Key Tree
    forall record. Entity record -> Key record
    entityKey Entity Tree
    ent
        }

    loadArchiveCache
      :: Text -- ^ URL
      -> Text -- ^ subdir
      -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeId)]
    loadArchiveCache :: Text
    -> Text
    -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, Key Tree)]
    loadArchiveCache url :: Text
    url subdir :: Text
    subdir = (Entity ArchiveCache -> (SHA256, FileSize, Key Tree))
    -> [Entity ArchiveCache] -> [(SHA256, FileSize, Key Tree)]
    forall a b. (a -> b) -> [a] -> [b]
    map Entity ArchiveCache -> (SHA256, FileSize, Key Tree)
    go ([Entity ArchiveCache] -> [(SHA256, FileSize, Key Tree)])
    -> ReaderT SqlBackend (RIO env) [Entity ArchiveCache]
    -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, Key Tree)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Filter ArchiveCache]
    -> [SelectOpt ArchiveCache]
    -> ReaderT SqlBackend (RIO env) [Entity ArchiveCache]
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistQueryRead backend,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m [Entity record]
    selectList
      [ EntityField ArchiveCache Text
    forall typ. (typ ~ Text) => EntityField ArchiveCache typ
    ArchiveCacheUrl EntityField ArchiveCache Text -> Text -> Filter ArchiveCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Text
    url
      , EntityField ArchiveCache Text
    forall typ. (typ ~ Text) => EntityField ArchiveCache typ
    ArchiveCacheSubdir EntityField ArchiveCache Text -> Text -> Filter ArchiveCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Text
    subdir
      ]
      [EntityField ArchiveCache UTCTime -> SelectOpt ArchiveCache
    forall record typ. EntityField record typ -> SelectOpt record
    Desc EntityField ArchiveCache UTCTime
    forall typ. (typ ~ UTCTime) => EntityField ArchiveCache typ
    ArchiveCacheTime]
      where
        go :: Entity ArchiveCache -> (SHA256, FileSize, Key Tree)
    go (Entity _ ac :: ArchiveCache
    ac) = (ArchiveCache -> SHA256
    archiveCacheSha ArchiveCache
    ac, ArchiveCache -> FileSize
    archiveCacheSize ArchiveCache
    ac, ArchiveCache -> Key Tree
    archiveCacheTree ArchiveCache
    ac)

    storeRepoCache
      :: Repo
      -> Text -- ^ subdir
      -> TreeId
      -> ReaderT SqlBackend (RIO env) ()
    storeRepoCache :: Repo -> Text -> Key Tree -> ReaderT SqlBackend (RIO env) ()
    storeRepoCache repo :: Repo
    repo subdir :: Text
    subdir tid :: Key Tree
    tid = do
      UTCTime
    now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      RepoCache -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WRepoCache :: UTCTime
    -> Text -> RepoType -> Text -> Text -> Key Tree -> RepoCache
    RepoCache
        { repoCacheTime :: UTCTime
    repoCacheTime = UTCTime
    now
        , repoCacheUrl :: Text
    repoCacheUrl = Repo -> Text
    repoUrl Repo
    repo
        , repoCacheType :: RepoType
    repoCacheType = Repo -> RepoType
    repoType Repo
    repo
        , repoCacheCommit :: Text
    repoCacheCommit = Repo -> Text
    repoCommit Repo
    repo
        , repoCacheSubdir :: Text
    repoCacheSubdir = Text
    subdir
        , repoCacheTree :: Key Tree
    repoCacheTree = Key Tree
    tid
        }

    loadRepoCache
      :: Repo
      -> Text -- ^ subdir
      -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    loadRepoCache :: Repo -> Text -> ReaderT SqlBackend (RIO env) (Maybe (Key Tree))
    loadRepoCache repo :: Repo
    repo subdir :: Text
    subdir = (Entity RepoCache -> Key Tree)
    -> Maybe (Entity RepoCache) -> Maybe (Key Tree)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (RepoCache -> Key Tree
    repoCacheTree (RepoCache -> Key Tree)
    -> (Entity RepoCache -> RepoCache) -> Entity RepoCache -> Key Tree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entity RepoCache -> RepoCache
    forall record. Entity record -> record
    entityVal) (Maybe (Entity RepoCache) -> Maybe (Key Tree))
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity RepoCache))
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Tree))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Filter RepoCache]
    -> [SelectOpt RepoCache]
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity RepoCache))
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record]
    -> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
    selectFirst
      [ EntityField RepoCache Text
    forall typ. (typ ~ Text) => EntityField RepoCache typ
    RepoCacheUrl EntityField RepoCache Text -> Text -> Filter RepoCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Repo -> Text
    repoUrl Repo
    repo
      , EntityField RepoCache RepoType
    forall typ. (typ ~ RepoType) => EntityField RepoCache typ
    RepoCacheType EntityField RepoCache RepoType -> RepoType -> Filter RepoCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Repo -> RepoType
    repoType Repo
    repo
      , EntityField RepoCache Text
    forall typ. (typ ~ Text) => EntityField RepoCache typ
    RepoCacheCommit EntityField RepoCache Text -> Text -> Filter RepoCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Repo -> Text
    repoCommit Repo
    repo
      , EntityField RepoCache Text
    forall typ. (typ ~ Text) => EntityField RepoCache typ
    RepoCacheSubdir EntityField RepoCache Text -> Text -> Filter RepoCache
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Text
    subdir
      ]
      [EntityField RepoCache UTCTime -> SelectOpt RepoCache
    forall record typ. EntityField record typ -> SelectOpt record
    Desc EntityField RepoCache UTCTime
    forall typ. (typ ~ UTCTime) => EntityField RepoCache typ
    RepoCacheTime]

    storePreferredVersion ::
         P.PackageName -> Text -> ReaderT SqlBackend (RIO env) ()
    storePreferredVersion :: PackageName -> Text -> ReaderT SqlBackend (RIO env) ()
    storePreferredVersion name :: PackageName
    name p :: Text
    p = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      Maybe (Entity PreferredVersions)
    ment <- Unique PreferredVersions
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity PreferredVersions))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Unique PreferredVersions
     -> ReaderT SqlBackend (RIO env) (Maybe (Entity PreferredVersions)))
    -> Unique PreferredVersions
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity PreferredVersions))
    forall a b. (a -> b) -> a -> b
    $ Key PackageName -> Unique PreferredVersions
    UniquePreferred Key PackageName
    nameid
      case Maybe (Entity PreferredVersions)
    ment of
        Nothing -> PreferredVersions -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WPreferredVersions :: Key PackageName -> Text -> PreferredVersions
    PreferredVersions
          { preferredVersionsName :: Key PackageName
    preferredVersionsName = Key PackageName
    nameid
          , preferredVersionsPreferred :: Text
    preferredVersionsPreferred = Text
    p
          }
        Just (Entity pid :: Key PreferredVersions
    pid _) -> Key PreferredVersions
    -> [Update PreferredVersions] -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> [Update record] -> ReaderT backend m ()
    update Key PreferredVersions
    pid [EntityField PreferredVersions Text
    forall typ. (typ ~ Text) => EntityField PreferredVersions typ
    PreferredVersionsPreferred EntityField PreferredVersions Text
    -> Text -> Update PreferredVersions
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Update v
    =. Text
    p]

    loadPreferredVersion ::
         P.PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    loadPreferredVersion :: PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    loadPreferredVersion name :: PackageName
    name = do
      Key PackageName
    nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      (Entity PreferredVersions -> Text)
    -> Maybe (Entity PreferredVersions) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PreferredVersions -> Text
    preferredVersionsPreferred (PreferredVersions -> Text)
    -> (Entity PreferredVersions -> PreferredVersions)
    -> Entity PreferredVersions
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entity PreferredVersions -> PreferredVersions
    forall record. Entity record -> record
    entityVal) (Maybe (Entity PreferredVersions) -> Maybe Text)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity PreferredVersions))
    -> ReaderT SqlBackend (RIO env) (Maybe Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Unique PreferredVersions
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity PreferredVersions))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Key PackageName -> Unique PreferredVersions
    UniquePreferred Key PackageName
    nameid)

    sinkHackagePackageNames
      :: (P.PackageName -> Bool)
      -> ConduitT P.PackageName Void (ReaderT SqlBackend (RIO env)) a
      -> ReaderT SqlBackend (RIO env) a
    sinkHackagePackageNames :: (PackageName -> Bool)
    -> ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    -> ReaderT SqlBackend (RIO env) a
    sinkHackagePackageNames predicate :: PackageName -> Bool
    predicate sink :: ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    sink = do
      Acquire
      (ConduitM
         () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ())
    acqSrc <- [Filter PackageName]
    -> [SelectOpt PackageName]
    -> ReaderT
         SqlBackend
         (RIO env)
         (Acquire
            (ConduitM
               () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()))
    forall backend record (m1 :: * -> *) (m2 :: * -> *).
    (PersistQueryRead backend, PersistRecordBackend record backend,
     MonadIO m1, MonadIO m2) =>
    [Filter record]
    -> [SelectOpt record]
    -> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
    selectSourceRes [] []
      Acquire
      (ConduitM
         () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ())
    -> (ConduitM
          () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
        -> ReaderT SqlBackend (RIO env) a)
    -> ReaderT SqlBackend (RIO env) a
    forall (m :: * -> *) a b.
    MonadUnliftIO m =>
    Acquire a -> (a -> m b) -> m b
    with Acquire
      (ConduitM
         () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ())
    acqSrc ((ConduitM
        () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
      -> ReaderT SqlBackend (RIO env) a)
     -> ReaderT SqlBackend (RIO env) a)
    -> (ConduitM
          () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
        -> ReaderT SqlBackend (RIO env) a)
    -> ReaderT SqlBackend (RIO env) a
    forall a b. (a -> b) -> a -> b
    $ \src :: ConduitM () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
    src -> ConduitT () Void (ReaderT SqlBackend (RIO env)) a
    -> ReaderT SqlBackend (RIO env) a
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit
        (ConduitT () Void (ReaderT SqlBackend (RIO env)) a
     -> ReaderT SqlBackend (RIO env) a)
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) a
    -> ReaderT SqlBackend (RIO env) a
    forall a b. (a -> b) -> a -> b
    $ ConduitM () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
    src
       ConduitM () (Entity PackageName) (ReaderT SqlBackend (RIO env)) ()
    -> ConduitM
         (Entity PackageName) Void (ReaderT SqlBackend (RIO env)) a
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| (Entity PackageName
     -> ReaderT SqlBackend (RIO env) (Maybe PackageName))
    -> ConduitT
         (Entity PackageName)
         (Element (Maybe PackageName))
         (ReaderT SqlBackend (RIO env))
         ()
    forall (m :: * -> *) mono a.
    (Monad m, MonoFoldable mono) =>
    (a -> m mono) -> ConduitT a (Element mono) m ()
    concatMapMC Entity PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    go
       ConduitT
      (Entity PackageName) PackageName (ReaderT SqlBackend (RIO env)) ()
    -> ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    -> ConduitM
         (Entity PackageName) Void (ReaderT SqlBackend (RIO env)) a
    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)) a
    sink
      where
        go :: Entity PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    go (Entity nameid :: Key PackageName
    nameid (PackageName (PackageNameP name :: PackageName
    name)))
          | PackageName -> Bool
    predicate PackageName
    name = do
              -- Make sure it's actually on Hackage. Would be much more
              -- efficient with some raw SQL and an inner join, but we
              -- don't have a Conduit version of rawSql.
              Bool
    onHackage <- Key PackageName -> ReaderT SqlBackend (RIO env) Bool
    forall (m :: * -> *) backend.
    (MonadIO m, PersistQueryRead backend,
     BaseBackend backend ~ SqlBackend) =>
    Key PackageName -> ReaderT backend m Bool
    checkOnHackage Key PackageName
    nameid
              Maybe PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe PackageName
     -> ReaderT SqlBackend (RIO env) (Maybe PackageName))
    -> Maybe PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    onHackage then PackageName -> Maybe PackageName
    forall a. a -> Maybe a
    Just PackageName
    name else Maybe PackageName
    forall a. Maybe a
    Nothing
          | Bool
    otherwise = Maybe PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe PackageName
    forall a. Maybe a
    Nothing

        checkOnHackage :: Key PackageName -> ReaderT backend m Bool
    checkOnHackage nameid :: Key PackageName
    nameid = do
          Int
    cnt <- [Filter HackageCabal] -> ReaderT backend m Int
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m Int
    count [EntityField HackageCabal (Key PackageName)
    forall typ. (typ ~ Key PackageName) => EntityField HackageCabal typ
    HackageCabalName EntityField HackageCabal (Key PackageName)
    -> Key PackageName -> Filter HackageCabal
    forall v typ.
    PersistField typ =>
    EntityField v typ -> typ -> Filter v
    ==. Key PackageName
    nameid]
          Bool -> ReaderT backend m Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool -> ReaderT backend m Bool) -> Bool -> ReaderT backend m Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    cnt Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0

    -- | Get the filename for the cabal file in the given directory.
    --
    -- If no .cabal file is present, or more than one is present, an exception is
    -- thrown via 'throwM'.
    --
    -- If the directory contains a file named package.yaml, hpack is used to
    -- generate a .cabal file from it.
    findOrGenerateCabalFile
        :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => Path Abs Dir -- ^ package directory
        -> RIO env (P.PackageName, Path Abs File)
    findOrGenerateCabalFile :: Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile pkgDir :: Path Abs Dir
    pkgDir = do
        Path Abs Dir -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env ()
    hpack Path Abs Dir
    pkgDir
        [Path Abs File]
    files <- (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> String -> Bool) -> String -> String -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> String -> Bool
    hasExtension "cabal" (String -> Bool)
    -> (Path Abs File -> String) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath) ([Path Abs File] -> [Path Abs File])
    -> (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
    -> ([Path Abs Dir], [Path Abs File])
    -> [Path Abs File]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Path Abs Dir], [Path Abs File]) -> [Path Abs File]
    forall a b. (a, b) -> b
    snd
             (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
    -> RIO env ([Path Abs Dir], [Path Abs File])
    -> RIO env [Path Abs File]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path Abs Dir -> RIO env ([Path Abs Dir], [Path Abs File])
    forall (m :: * -> *) b.
    MonadIO m =>
    Path b Dir -> m ([Path Abs Dir], [Path Abs File])
    listDir Path Abs Dir
    pkgDir
        -- If there are multiple files, ignore files that start with
        -- ".". On unixlike environments these are hidden, and this
        -- character is not valid in package names. The main goal is
        -- to ignore emacs lock files - see
        -- https://github.com/commercialhaskell/stack/issues/1897.
        let isHidden :: String -> Bool
    isHidden ('.':_) = Bool
    True
            isHidden _ = Bool
    False
        case (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Path Abs File -> Bool) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    isHidden (String -> Bool)
    -> (Path Abs File -> String) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Rel File -> String
    fromRelFile (Path Rel File -> String)
    -> (Path Abs File -> Path Rel File) -> Path Abs File -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename) [Path Abs File]
    files of
            [] -> PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> PantryException
    P.NoCabalFileFound Path Abs Dir
    pkgDir
            [x :: Path Abs File
    x] -> RIO env (PackageName, Path Abs File)
    -> (PackageName -> RIO env (PackageName, Path Abs File))
    -> Maybe PackageName
    -> RIO env (PackageName, Path Abs File)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
              (PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> PantryException
    P.InvalidCabalFilePath Path Abs File
    x)
              (\pn :: PackageName
    pn -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((PackageName, Path Abs File)
     -> RIO env (PackageName, Path Abs File))
    -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ (PackageName
    pn, Path Abs File
    x)) (Maybe PackageName -> RIO env (PackageName, Path Abs File))
    -> Maybe PackageName -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $
                String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripSuffix ".cabal" (Path Rel File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    x)) Maybe String -> (String -> Maybe PackageName) -> Maybe PackageName
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                String -> Maybe PackageName
    P.parsePackageName
            _:_ -> PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> [Path Abs File] -> PantryException
    P.MultipleCabalFilesFound Path Abs Dir
    pkgDir [Path Abs File]
    files
          where hasExtension :: String -> String -> Bool
    hasExtension fp :: String
    fp x :: String
    x = ShowS
    FilePath.takeExtension String
    fp String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x

    -- | Similar to 'hpackToCabal' but doesn't require a new connection to database.
    hpackToCabalS :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
                  => P.RawPackageLocationImmutable -- ^ for exceptions
                  -> P.Tree
                  -> ReaderT SqlBackend (RIO env) (P.PackageName, ByteString)
    hpackToCabalS :: RawPackageLocationImmutable
    -> Tree -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    hpackToCabalS rpli :: RawPackageLocationImmutable
    rpli tree :: Tree
    tree = do
      Path Abs Dir
    tmpDir <- RIO env (Path Abs Dir)
    -> ReaderT SqlBackend (RIO env) (Path Abs Dir)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env (Path Abs Dir)
     -> ReaderT SqlBackend (RIO env) (Path Abs Dir))
    -> RIO env (Path Abs Dir)
    -> ReaderT SqlBackend (RIO env) (Path Abs Dir)
    forall a b. (a -> b) -> a -> b
    $ do
                  Path Abs Dir
    tdir <- RIO env (Path Abs Dir)
    forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
    getTempDir
                  Path Abs Dir -> String -> RIO env (Path Abs Dir)
    forall (m :: * -> *) b.
    MonadIO m =>
    Path b Dir -> String -> m (Path Abs Dir)
    createTempDir Path Abs Dir
    tdir "hpack-pkg-dir"
      RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    unpackTreeToDir RawPackageLocationImmutable
    rpli Path Abs Dir
    tmpDir Tree
    tree
      (packageName :: PackageName
    packageName, cfile :: Path Abs File
    cfile) <- RIO env (PackageName, Path Abs File)
    -> ReaderT SqlBackend (RIO env) (PackageName, Path Abs File)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env (PackageName, Path Abs File)
     -> ReaderT SqlBackend (RIO env) (PackageName, Path Abs File))
    -> RIO env (PackageName, Path Abs File)
    -> ReaderT SqlBackend (RIO env) (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> RIO env (PackageName, Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile Path Abs Dir
    tmpDir
      !ByteString
    bs <- RIO env ByteString -> ReaderT SqlBackend (RIO env) ByteString
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env ByteString -> ReaderT SqlBackend (RIO env) ByteString)
    -> RIO env ByteString -> ReaderT SqlBackend (RIO env) ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> RIO env ByteString
    forall (m :: * -> *). MonadIO m => String -> m ByteString
    B.readFile (Path Abs File -> String
    fromAbsFile Path Abs File
    cfile)
      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
    $ Path Abs Dir -> RIO env ()
    forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
    removeDirRecur Path Abs Dir
    tmpDir
      (PackageName, ByteString)
    -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((PackageName, ByteString)
     -> ReaderT SqlBackend (RIO env) (PackageName, ByteString))
    -> (PackageName, ByteString)
    -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    forall a b. (a -> b) -> a -> b
    $ (PackageName
    packageName, ByteString
    bs)

    hpackToCabal :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
               => P.RawPackageLocationImmutable -- ^ for exceptions
               -> P.Tree
               -> RIO env (P.PackageName, ByteString)
    hpackToCabal :: RawPackageLocationImmutable
    -> Tree -> RIO env (PackageName, ByteString)
    hpackToCabal rpli :: RawPackageLocationImmutable
    rpli tree :: Tree
    tree = String
    -> (String -> RIO env (PackageName, ByteString))
    -> RIO env (PackageName, ByteString)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    String -> (String -> m a) -> m a
    withSystemTempDirectory "hpack-pkg-dir" ((String -> RIO env (PackageName, ByteString))
     -> RIO env (PackageName, ByteString))
    -> (String -> RIO env (PackageName, ByteString))
    -> RIO env (PackageName, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \tmpdir :: String
    tmpdir -> do
                   Path Abs Dir
    tdir <- String -> RIO env (Path Abs Dir)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
    parseAbsDir String
    tmpdir
                   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
    $ RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    unpackTreeToDir RawPackageLocationImmutable
    rpli Path Abs Dir
    tdir Tree
    tree
                   (packageName :: PackageName
    packageName, cfile :: Path Abs File
    cfile) <- Path Abs Dir -> RIO env (PackageName, Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile Path Abs Dir
    tdir
                   ByteString
    bs <- String -> RIO env ByteString
    forall (m :: * -> *). MonadIO m => String -> m ByteString
    B.readFile (Path Abs File -> String
    fromAbsFile Path Abs File
    cfile)
                   (PackageName, ByteString) -> RIO env (PackageName, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PackageName
    packageName, ByteString
    bs)

    unpackTreeToDir
      :: (HasPantryConfig env, HasLogFunc env)
      => P.RawPackageLocationImmutable -- ^ for exceptions
      -> Path Abs Dir -- ^ dest dir, will be created if necessary
      -> P.Tree
      -> ReaderT SqlBackend (RIO env) ()
    unpackTreeToDir :: RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    unpackTreeToDir rpli :: RawPackageLocationImmutable
    rpli (Path Abs Dir -> String
    forall b t. Path b t -> String
    toFilePath -> String
    dir) (P.TreeMap m :: Map SafeFilePath TreeEntry
    m) = do
      [(SafeFilePath, TreeEntry)]
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_  (Map SafeFilePath TreeEntry -> [(SafeFilePath, TreeEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map SafeFilePath TreeEntry
    m) (((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \(sfp :: SafeFilePath
    sfp, P.TreeEntry blobKey :: BlobKey
    blobKey ft :: FileType
    ft) -> do
        let dest :: String
    dest = String
    dir String -> ShowS
    </> Text -> String
    T.unpack (SafeFilePath -> Text
    P.unSafeFilePath SafeFilePath
    sfp)
        Bool -> String -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
    createDirectoryIfMissing Bool
    True (String -> ReaderT SqlBackend (RIO env) ())
    -> String -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ ShowS
    takeDirectory String
    dest
        Maybe ByteString
    mbs <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    blobKey
        case Maybe ByteString
    mbs of
          Nothing -> do
            -- TODO when we have pantry wire stuff, try downloading
            PantryException -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> ReaderT SqlBackend (RIO env) ())
    -> PantryException -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> SafeFilePath -> BlobKey -> PantryException
    P.TreeReferencesMissingBlob RawPackageLocationImmutable
    rpli SafeFilePath
    sfp BlobKey
    blobKey
          Just bs :: ByteString
    bs -> do
            String -> ByteString -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *). MonadIO m => String -> ByteString -> m ()
    B.writeFile String
    dest ByteString
    bs
            case FileType
    ft of
              FTNormal -> () -> ReaderT SqlBackend (RIO env) ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
              FTExecutable -> IO () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT SqlBackend (RIO env) ())
    -> IO () -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ do
                Permissions
    perms <- String -> IO Permissions
    forall (m :: * -> *). MonadIO m => String -> m Permissions
    getPermissions String
    dest
                String -> Permissions -> IO ()
    forall (m :: * -> *). MonadIO m => String -> Permissions -> m ()
    setPermissions String
    dest (Permissions -> IO ()) -> Permissions -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Permissions -> Permissions
    setOwnerExecutable Bool
    True Permissions
    perms

    countHackageCabals :: ReaderT SqlBackend (RIO env) Int
    countHackageCabals :: ReaderT SqlBackend (RIO env) Int
    countHackageCabals = do
      [Single Int]
    res <- Text -> [PersistValue] -> ReaderT SqlBackend (RIO env) [Single Int]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT COUNT(*)\n\
        \FROM hackage_cabal"
        []
      case [Single Int]
    res of
        [] -> Int -> ReaderT SqlBackend (RIO env) Int
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 0
        (Single n :: Int
    n):_ ->
          Int -> ReaderT SqlBackend (RIO env) Int
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    n

    getSnapshotCacheByHash
      :: SnapshotCacheHash
      -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    getSnapshotCacheByHash :: SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Maybe (Key SnapshotCache))
    getSnapshotCacheByHash =
      (Maybe (Entity SnapshotCache) -> Maybe (Key SnapshotCache))
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache))
    -> ReaderT SqlBackend (RIO env) (Maybe (Key SnapshotCache))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity SnapshotCache -> Key SnapshotCache)
    -> Maybe (Entity SnapshotCache) -> Maybe (Key SnapshotCache)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Entity SnapshotCache -> Key SnapshotCache
    forall record. Entity record -> Key record
    entityKey) (ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache))
     -> ReaderT SqlBackend (RIO env) (Maybe (Key SnapshotCache)))
    -> (SnapshotCacheHash
        -> ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache)))
    -> SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Maybe (Key SnapshotCache))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unique SnapshotCache
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache))
    forall backend (m :: * -> *) record.
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    getBy (Unique SnapshotCache
     -> ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache)))
    -> (SnapshotCacheHash -> Unique SnapshotCache)
    -> SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity SnapshotCache))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SHA256 -> Unique SnapshotCache
    UniqueSnapshotCache (SHA256 -> Unique SnapshotCache)
    -> (SnapshotCacheHash -> SHA256)
    -> SnapshotCacheHash
    -> Unique SnapshotCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SnapshotCacheHash -> SHA256
    unSnapshotCacheHash

    getSnapshotCacheId
      :: SnapshotCacheHash
      -> ReaderT SqlBackend (RIO env) SnapshotCacheId
    getSnapshotCacheId :: SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Key SnapshotCache)
    getSnapshotCacheId =
      (Either (Entity SnapshotCache) (Key SnapshotCache)
     -> Key SnapshotCache)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity SnapshotCache) (Key SnapshotCache))
    -> ReaderT SqlBackend (RIO env) (Key SnapshotCache)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity SnapshotCache -> Key SnapshotCache)
    -> (Key SnapshotCache -> Key SnapshotCache)
    -> Either (Entity SnapshotCache) (Key SnapshotCache)
    -> Key SnapshotCache
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity SnapshotCache -> Key SnapshotCache
    forall record. Entity record -> Key record
    entityKey Key SnapshotCache -> Key SnapshotCache
    forall a. a -> a
    id) (ReaderT
       SqlBackend
       (RIO env)
       (Either (Entity SnapshotCache) (Key SnapshotCache))
     -> ReaderT SqlBackend (RIO env) (Key SnapshotCache))
    -> (SnapshotCacheHash
        -> ReaderT
             SqlBackend
             (RIO env)
             (Either (Entity SnapshotCache) (Key SnapshotCache)))
    -> SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Key SnapshotCache)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SnapshotCache
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity SnapshotCache) (Key SnapshotCache))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy (SnapshotCache
     -> ReaderT
          SqlBackend
          (RIO env)
          (Either (Entity SnapshotCache) (Key SnapshotCache)))
    -> (SnapshotCacheHash -> SnapshotCache)
    -> SnapshotCacheHash
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Entity SnapshotCache) (Key SnapshotCache))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SHA256 -> SnapshotCache
    SnapshotCache (SHA256 -> SnapshotCache)
    -> (SnapshotCacheHash -> SHA256)
    -> SnapshotCacheHash
    -> SnapshotCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SnapshotCacheHash -> SHA256
    unSnapshotCacheHash

    getModuleNameId
      :: P.ModuleName
      -> ReaderT SqlBackend (RIO env) ModuleNameId
    getModuleNameId :: ModuleName -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    getModuleNameId =
      (Either (Entity ModuleName) (Key ModuleName) -> Key ModuleName)
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName))
    -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity ModuleName -> Key ModuleName)
    -> (Key ModuleName -> Key ModuleName)
    -> Either (Entity ModuleName) (Key ModuleName)
    -> Key ModuleName
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Entity ModuleName -> Key ModuleName
    forall record. Entity record -> Key record
    entityKey Key ModuleName -> Key ModuleName
    forall a. a -> a
    id) (ReaderT
       SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName))
     -> ReaderT SqlBackend (RIO env) (Key ModuleName))
    -> (ModuleName
        -> ReaderT
             SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName)))
    -> ModuleName
    -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName))
    forall (m :: * -> *) backend record.
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
    record -> ReaderT backend m (Either (Entity record) (Key record))
    insertBy (ModuleName
     -> ReaderT
          SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName)))
    -> (ModuleName -> ModuleName)
    -> ModuleName
    -> ReaderT
         SqlBackend (RIO env) (Either (Entity ModuleName) (Key ModuleName))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleNameP -> ModuleName
    ModuleName (ModuleNameP -> ModuleName)
    -> (ModuleName -> ModuleNameP) -> ModuleName -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> ModuleNameP
    P.ModuleNameP

    storeSnapshotModuleCache
      :: SnapshotCacheId
      -> Map P.PackageName (Set P.ModuleName)
      -> ReaderT SqlBackend (RIO env) ()
    storeSnapshotModuleCache :: Key SnapshotCache
    -> Map PackageName (Set ModuleName)
    -> ReaderT SqlBackend (RIO env) ()
    storeSnapshotModuleCache cache :: Key SnapshotCache
    cache packageModules :: Map PackageName (Set ModuleName)
    packageModules =
      [(PackageName, Set ModuleName)]
    -> ((PackageName, Set ModuleName)
        -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map PackageName (Set ModuleName) -> [(PackageName, Set ModuleName)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PackageName (Set ModuleName)
    packageModules) (((PackageName, Set ModuleName) -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> ((PackageName, Set ModuleName)
        -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \(pn :: PackageName
    pn, modules :: Set ModuleName
    modules) -> do
        Key PackageName
    package <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    pn
        Set ModuleName
    -> (ModuleName -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Set ModuleName
    modules ((ModuleName -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> (ModuleName -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \m :: ModuleName
    m -> do
          Key ModuleName
    moduleName <- ModuleName -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    forall env.
    ModuleName -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    getModuleNameId ModuleName
    m
          PackageExposedModule -> ReaderT SqlBackend (RIO env) ()
    forall backend (m :: * -> *) record.
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    record -> ReaderT backend m ()
    insert_ $WPackageExposedModule :: Key SnapshotCache
    -> Key ModuleName -> Key PackageName -> PackageExposedModule
    PackageExposedModule
            { packageExposedModuleSnapshotCache :: Key SnapshotCache
    packageExposedModuleSnapshotCache = Key SnapshotCache
    cache
            , packageExposedModulePackage :: Key PackageName
    packageExposedModulePackage = Key PackageName
    package
            , packageExposedModuleModule :: Key ModuleName
    packageExposedModuleModule = Key ModuleName
    moduleName
            }

    loadExposedModulePackages
      :: SnapshotCacheId
      -> P.ModuleName
      -> ReaderT SqlBackend (RIO env) [P.PackageName]
    loadExposedModulePackages :: Key SnapshotCache
    -> ModuleName -> ReaderT SqlBackend (RIO env) [PackageName]
    loadExposedModulePackages cacheId :: Key SnapshotCache
    cacheId mName :: ModuleName
    mName =
      (Single PackageNameP -> PackageName)
    -> [Single PackageNameP] -> [PackageName]
    forall a b. (a -> b) -> [a] -> [b]
    map Single PackageNameP -> PackageName
    go ([Single PackageNameP] -> [PackageName])
    -> ReaderT SqlBackend (RIO env) [Single PackageNameP]
    -> ReaderT SqlBackend (RIO env) [PackageName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> [PersistValue]
    -> ReaderT SqlBackend (RIO env) [Single PackageNameP]
    forall a (m :: * -> *) backend.
    (RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
    Text -> [PersistValue] -> ReaderT backend m [a]
    rawSql
        "SELECT package_name.name\n\
        \FROM package_name, package_exposed_module, module_name\n\
        \WHERE module_name.name=?\n\
        \AND   package_exposed_module.snapshot_cache=?\n\
        \AND   module_name.id=package_exposed_module.module\n\
        \AND   package_name.id=package_exposed_module.package"
        [ ModuleNameP -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue (ModuleName -> ModuleNameP
    P.ModuleNameP ModuleName
    mName)
        , Key SnapshotCache -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key SnapshotCache
    cacheId
        ]
      where
        go :: Single PackageNameP -> PackageName
    go (Single (P.PackageNameP m :: PackageName
    m)) = PackageName
    m