    {-# LANGUAGE NoImplicitPrelude          #-}
    {-# LANGUAGE BangPatterns               #-}
    {-# LANGUAGE DataKinds                  #-}
    {-# LANGUAGE DerivingStrategies         #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GADTs                      #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE LambdaCase                 #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE NamedFieldPuns             #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE QuasiQuotes                #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE StandaloneDeriving         #-}
    {-# LANGUAGE TemplateHaskell            #-}
    {-# LANGUAGE TupleSections              #-}
    {-# LANGUAGE TypeApplications           #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeOperators              #-}
    {-# LANGUAGE UndecidableInstances       #-}
    {-# LANGUAGE ViewPatterns               #-}

    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
      , findOrGenerateCabalFile
      , PackageNameId
      , PackageName
      , VersionId
      , ModuleNameId
      , Version
      , versionVersion
      , Unique(..)
      , EntityField(..)
        -- avoid warnings

      , BlobId
      , Key(unBlobKey)
      , HackageCabalId
      , HackageCabal(..)
      , HackageTarballId
      , CacheUpdateId
      , FilePathId
      , Tree(..)
      , TreeId
      , TreeEntry(..)
      , TreeEntryId
      , ArchiveCacheId
      , RepoCacheId
      , PreferredVersionsId
      , UrlBlobId
      , SnapshotCacheId
      , PackageExposedModuleId
      , loadCachedTree
      , CachedTree (..)
      , unCachedTree
      ) where

    import           Conduit ( ConduitT, (.|), concatMapMC, mapC, runConduit )
    import           Data.Acquire ( with )
    import           Database.Persist ( ( !=.), (=.), (==.), (>.) )
    import           Database.Persist.Class.PersistEntity
                       ( Entity (..), EntityField, Filter (..), Key, SelectOpt (..)
                       , Unique
                       )
    import           Database.Persist.Class.PersistField ( PersistField (..) )
    import           Database.Persist.Class.PersistQuery
                       ( count, deleteWhere, selectFirst, selectKeysList, selectList
                       , selectSource, selectSourceRes, updateWhere
                       )
    import           Database.Persist.Class.PersistStore
                       ( get, getJust, insert, insert_, update,  )
    import           Database.Persist.Class.PersistUnique ( getBy, insertBy )
    import           Database.Persist.Sql ( Single (..), rawExecute, rawSql )
    import           Database.Persist.SqlBackend ( SqlBackend )
    import           Database.Persist.TH
                       ( mkMigrate, mkPersist, persistLowerCase, share, sqlSettings
                       )
    import           Pantry.HPack ( hpack, hpackVersion )
    import qualified Pantry.SHA256 as SHA256
    import qualified Pantry.SQLite as SQLite
    import           Pantry.Types
                       ( BlobKey, FileSize (..), FileType (..), HasPantryConfig
                       , Package (..), PackageNameP (..), Repo (..), Revision (..)
                       , SHA256, SafeFilePath, SnapshotCacheHash (..), TreeKey
                       , VersionP (..), connRDBMS
                       )
    import qualified Pantry.Types as P
    import           Path
                       ( Abs, Dir, File, Path, filename, fromAbsFile, fromRelFile
                       , parseAbsDir, toFilePath
                       )
    import           Path.IO ( createTempDir, getTempDir, listDir, removeDirRecur )
    import           RIO hiding ( FilePath )
    import qualified RIO.ByteString as B
    import           RIO.Directory
                       ( createDirectoryIfMissing, getPermissions
                       , setOwnerExecutable, setPermissions
                       )
    import           RIO.FilePath ( (</>), takeDirectory )
    import qualified RIO.FilePath as FilePath
    import qualified RIO.List as List
    import qualified RIO.Map as Map
    import           RIO.Orphans ( HasResourceMap )
    import           RIO.Process ( HasProcessContext )
    import qualified RIO.Text as T
    import           RIO.Time ( UTCTime, getCurrentTime )

    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 :: forall env a.
    HasLogFunc env =>
    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 Text
    "Pantry" Migration
    migrateAll

    withStorage ::
         (HasPantryConfig env, HasLogFunc env)
      => ReaderT SqlBackend (RIO env) a
      -> RIO env a
    withStorage :: forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage ReaderT SqlBackend (RIO env) a
    action = do
      storage <- 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
    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)
      SQLite.withStorage_ storage action

    -- | 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
      { forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raSqlite :: !(ReaderT SqlBackend (RIO env) a)
      -- ^ A query that is specific to SQLite

      , forall env a. 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 :: forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery RdbmsActions {ReaderT SqlBackend (RIO env) a
    raSqlite :: forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raSqlite :: ReaderT SqlBackend (RIO env) a
    raSqlite, ReaderT SqlBackend (RIO env) a
    raPostgres :: forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    raPostgres :: ReaderT SqlBackend (RIO env) a
    raPostgres} = do
      rdbms <- SqlBackend -> Text
    Pantry.Types.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 rdbms of
        Text
    "postgresql" -> ReaderT SqlBackend (RIO env) a
    raPostgres
        Text
    "sqlite" -> ReaderT SqlBackend (RIO env) a
    raSqlite
        Text
    _ -> 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
    $ String
    "rdbmsAwareQuery: unsupported rdbms '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    rdbms String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"

    getPackageNameById ::
         PackageNameId
      -> ReaderT SqlBackend (RIO env) (Maybe P.PackageName)
    getPackageNameById :: forall env.
    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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 record (m :: * -> *).
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Key record -> ReaderT SqlBackend m (Maybe record)
    get

    getPackageNameId ::
         P.PackageName
      -> ReaderT SqlBackend (RIO env) PackageNameId
    getPackageNameId :: forall env.
    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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 record backend (m :: * -> *).
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record,
     SafeToInsert 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 :: forall env. 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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 record backend (m :: * -> *).
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record,
     SafeToInsert 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 :: forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob 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
      keys <- [Filter Blob]
    -> [SelectOpt Blob] -> ReaderT SqlBackend (RIO env) [Key Blob]
    forall record backend (m :: * -> *).
    (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 <-
        case keys of
          [] ->
            RdbmsActions env (Key Blob)
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall env a. RdbmsActions env a -> ReaderT SqlBackend (RIO env) a
    rdbmsAwareQuery
              RdbmsActions
                { raSqlite :: ReaderT SqlBackend (RIO env) (Key Blob)
    raSqlite =
                    Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall backend record (m :: * -> *).
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend, SafeToInsert record) =>
    record -> ReaderT backend m (Key record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend,
     SafeToInsert record) =>
    record -> ReaderT SqlBackend m (Key record)
    insert 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
                      Text
    "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
                      Text
    "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 a b.
    ReaderT SqlBackend (RIO env) a
    -> (a -> ReaderT SqlBackend (RIO env) b)
    -> ReaderT SqlBackend (RIO env) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                      [Single Key Blob
    key] -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    key
                      [Single (Key Blob)]
    _ -> String -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. HasCallStack => String -> a
    error
                        String
    "soreBlob: there was a critical problem storing a blob."
                }
          Key Blob
    key:[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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Key Blob]
    rest) (Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    key)
      pure (key, P.BlobKey sha size)

    loadBlob ::
         HasLogFunc env
      => BlobKey
      -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob :: forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob (P.BlobKey SHA256
    sha FileSize
    size) = do
      ment <- Unique Blob -> ReaderT SqlBackend (RIO env) (Maybe (Entity Blob))
    forall backend record (m :: * -> *).
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Unique record -> ReaderT SqlBackend 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 ment of
        Maybe (Entity Blob)
    Nothing -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ByteString
    forall a. Maybe a
    Nothing
        Just (Entity Key Blob
    _ 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 a. a -> ReaderT SqlBackend (RIO env) a
    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 a b.
    a
    -> ReaderT SqlBackend (RIO env) b -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                 Utf8Builder
    "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
    <>
                 Utf8Builder
    ". 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
    <>
                 Utf8Builder
    ". 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 :: forall env.
    SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    loadBlobBySHA 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 record backend (m :: * -> *).
    (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 :: forall env. Key Blob -> ReaderT SqlBackend (RIO env) ByteString
    loadBlobById Key Blob
    bid = do
      mbt <- Key Blob -> ReaderT SqlBackend (RIO env) (Maybe Blob)
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Key record -> ReaderT SqlBackend m (Maybe record)
    get Key Blob
    bid
      case mbt of
        Maybe Blob
    Nothing -> String -> ReaderT SqlBackend (RIO env) ByteString
    forall a. HasCallStack => String -> a
    error String
    "loadBlobById: ID doesn't exist in database"
        Just Blob
    bt -> ByteString -> ReaderT SqlBackend (RIO env) ByteString
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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 :: forall env.
    HasResourceMap env =>
    Maybe (Key Blob)
    -> ConduitT
         () (Key Blob, ByteString) (ReaderT SqlBackend (RIO env)) ()
    allBlobsSource Maybe (Key Blob)
    mblobId =
      [Filter Blob]
    -> [SelectOpt Blob]
    -> ConduitM () (Entity Blob) (ReaderT SqlBackend (RIO env)) ()
    forall record backend (m :: * -> *).
    (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 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)) ()
    -> ConduitT
         (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 =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .|
      (Entity Blob -> (Key Blob, ByteString))
    -> ConduitT
         (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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& 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 :: forall env.
    HasResourceMap env =>
    Maybe (Key HackageCabal)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Map (Key HackageCabal) RawPackageLocationImmutable)
    allHackageCabalRawPackageLocations Maybe (Key HackageCabal)
    mhackageId = do
      hackageCabals :: Map HackageCabalId HackageCabal <-
        [Filter HackageCabal]
    -> [SelectOpt HackageCabal]
    -> ReaderT
         SqlBackend (RIO env) (Map (Key HackageCabal) HackageCabal)
    forall {a} {backend} {m :: * -> *}.
    (PersistEntityBackend a ~ BaseBackend backend,
     PersistQueryRead backend, MonadIO m, PersistEntity a) =>
    [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 Key HackageCabal
    hackageId <- [Maybe (Key HackageCabal)
    mhackageId]]
          []
      packageNames :: Map PackageNameId PackageName <- selectTuples [] []
      versions :: Map VersionId Version <- selectTuples [] []
      for
        hackageCabals
        (\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
             Maybe PackageName
    Nothing -> String -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable
    forall a. HasCallStack => String -> a
    error String
    "no such package name"
             Just PackageName
    packageName ->
               let P.PackageNameP 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
                     Maybe Version
    Nothing -> String -> ReaderT SqlBackend (RIO env) RawPackageLocationImmutable
    forall a. HasCallStack => String -> a
    error String
    "no such version"
                     Just Version
    version ->
                       let P.VersionP Version
    version' = Version -> VersionP
    versionVersion Version
    version
                        in do mtree <-
                                case HackageCabal -> Maybe (Key Tree)
    hackageCabalTree HackageCabal
    hackageCabal of
                                  Just 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))
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record]
    -> [SelectOpt record]
    -> ReaderT SqlBackend 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] []
                                  Maybe (Key Tree)
    Nothing -> Maybe (Entity Tree)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Entity Tree)
    forall a. Maybe a
    Nothing
                              mblobKey <-
                                maybe
                                  (pure Nothing)
                                  ((fmap Just . getBlobKey) . treeKey . entityVal)
                                  mtree
                              pure
                                (P.RPLIHackage
                                   (P.PackageIdentifierRevision
                                      packageName'
                                      version'
                                      (P.CFIRevision
                                         (hackageCabalRevision hackageCabal)))
                                   (fmap P.TreeKey mblobKey)))
     where
      selectTuples :: [Filter a] -> [SelectOpt a] -> ReaderT backend m (Map (Key a) a)
    selectTuples [Filter a]
    pred [SelectOpt a]
    sort =
        ([Entity a] -> Map (Key a) a)
    -> ReaderT backend m [Entity a]
    -> ReaderT backend m (Map (Key a) a)
    forall a b. (a -> b) -> ReaderT backend m a -> ReaderT backend m b
    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 record backend (m :: * -> *).
    (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 Key b
    k b
    v) = (Key b
    k, b
    v)

    allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int
    allBlobsCount :: forall env. Maybe (Key Blob) -> ReaderT SqlBackend (RIO env) Int
    allBlobsCount 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
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record] -> ReaderT SqlBackend 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 Key Blob
    blobId <- [Maybe (Key Blob)
    mblobId]]

    allHackageCabalCount :: Maybe HackageCabalId -> ReaderT SqlBackend (RIO env) Int
    allHackageCabalCount :: forall env.
    Maybe (Key HackageCabal) -> ReaderT SqlBackend (RIO env) Int
    allHackageCabalCount 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
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record] -> ReaderT SqlBackend 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 Key HackageCabal
    hackageCabalId <- [Maybe (Key HackageCabal)
    mhackageCabalId]
        ]

    getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey :: forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey Key Blob
    bid = do
      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 Text
    "SELECT sha, size FROM blob WHERE id=?" [Key Blob -> PersistValue
    forall a. PersistField a => a -> PersistValue
    toPersistValue Key Blob
    bid]
      case 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
    $ String
    "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 SHA256
    sha, Single FileSize
    size)] -> BlobKey -> ReaderT SqlBackend (RIO env) BlobKey
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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
        [(Single SHA256, Single FileSize)]
    _ -> 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
    $ String
    "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 :: forall env.
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    getBlobId (P.BlobKey SHA256
    sha FileSize
    size) = do
      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 Text
    "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]
      pure $ listToMaybe $ map unSingle res

    loadURLBlob :: Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadURLBlob :: forall env. Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadURLBlob Text
    url = do
      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
        Text
    "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 ment of
        [] -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ByteString
    forall a. Maybe a
    Nothing
        (Single ByteString
    bs) : [Single ByteString]
    _ -> Maybe ByteString -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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 :: forall env. Text -> ByteString -> ReaderT SqlBackend (RIO env) ()
    storeURLBlob Text
    url ByteString
    blob = do
      (blobId, _) <- ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob ByteString
    blob
      now <- getCurrentTime
      insert_ UrlBlob
            { urlBlobUrl = url
            , urlBlobBlob = blobId
            , urlBlobTime = now
            }

    clearHackageRevisions :: ReaderT SqlBackend (RIO env) ()
    clearHackageRevisions :: forall env. 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 ()
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record] -> ReaderT SqlBackend m ()
    deleteWhere ([] :: [Filter HackageCabal])

    storeHackageRevision ::
         P.PackageName
      -> P.Version
      -> BlobId
      -> ReaderT SqlBackend (RIO env) ()
    storeHackageRevision :: forall env.
    PackageName
    -> Version -> Key Blob -> ReaderT SqlBackend (RIO env) ()
    storeHackageRevision PackageName
    name Version
    version Key Blob
    key = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId version
      rev <- count
        [ HackageCabalName ==. nameid
        , HackageCabalVersion ==. versionid
        ]
      insert_ HackageCabal
        { hackageCabalName = nameid
        , hackageCabalVersion = versionid
        , hackageCabalRevision = Revision (fromIntegral rev)
        , hackageCabalCabal = key
        , hackageCabalTree = Nothing
        }

    loadHackagePackageVersions ::
         P.PackageName
      -> ReaderT SqlBackend (RIO env) (Map P.Version (Map Revision BlobKey))
    loadHackagePackageVersions :: forall env.
    PackageName
    -> ReaderT
         SqlBackend (RIO env) (Map Version (Map Revision BlobKey))
    loadHackagePackageVersions PackageName
    name = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      -- would be better with esqueleto

      Map.fromListWith Map.union . map go <$> 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"
        [toPersistValue nameid]
      where
        go :: (Single k, Single VersionP, Single SHA256, Single FileSize)
    -> (Version, Map k BlobKey)
    go (Single k
    revision, Single (P.VersionP Version
    version), Single SHA256
    key, Single 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 :: forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Map Revision (Key Blob, BlobKey))
    loadHackagePackageVersion PackageName
    name Version
    version = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId version
      -- would be better with esqueleto

      Map.fromList . map go <$> 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"
        [toPersistValue nameid, toPersistValue versionid]
     where
      go :: (Single a, Single SHA256, Single FileSize, Single a)
    -> (a, (a, BlobKey))
    go (Single a
    revision, Single SHA256
    sha, Single FileSize
    size, Single a
    bid) =
        (a
    revision, (a
    bid, SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size))

    loadLatestCacheUpdate ::
      ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate :: forall env. ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256))
    loadLatestCacheUpdate = (Entity CacheUpdate -> (FileSize, SHA256))
    -> Maybe (Entity CacheUpdate) -> Maybe (FileSize, SHA256)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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))
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record]
    -> [SelectOpt record]
    -> ReaderT SqlBackend 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 Key CacheUpdate
    _ CacheUpdate
    cu) = (CacheUpdate -> FileSize
    cacheUpdateSize CacheUpdate
    cu, CacheUpdate -> SHA256
    cacheUpdateSha CacheUpdate
    cu)

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

    storeHackageTarballInfo ::
         P.PackageName
      -> P.Version
      -> SHA256
      -> FileSize
      -> ReaderT SqlBackend (RIO env) ()
    storeHackageTarballInfo :: forall env.
    PackageName
    -> Version -> SHA256 -> FileSize -> ReaderT SqlBackend (RIO env) ()
    storeHackageTarballInfo PackageName
    name Version
    version SHA256
    sha FileSize
    size = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId version
      void $ insertBy HackageTarball
        { hackageTarballName = nameid
        , hackageTarballVersion = versionid
        , hackageTarballSha = sha
        , hackageTarballSize = size
        }

    loadHackageTarballInfo ::
         P.PackageName
      -> P.Version
      -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    loadHackageTarballInfo :: forall env.
    PackageName
    -> Version
    -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize))
    loadHackageTarballInfo PackageName
    name Version
    version = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId version
      fmap go <$> getBy (UniqueHackageTarball nameid versionid)
     where
      go :: Entity HackageTarball -> (SHA256, FileSize)
    go (Entity Key HackageTarball
    _ HackageTarball
    ht) = (HackageTarball -> SHA256
    hackageTarballSha HackageTarball
    ht, HackageTarball -> FileSize
    hackageTarballSize HackageTarball
    ht)

    storeCabalFile ::
         ByteString
      -> P.PackageName
      -> ReaderT SqlBackend (RIO env) BlobId
    storeCabalFile :: forall env.
    ByteString
    -> PackageName -> ReaderT SqlBackend (RIO env) (Key Blob)
    storeCabalFile ByteString
    cabalBS PackageName
    pkgName = do
      (bid, _) <- ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    forall env.
    ByteString -> ReaderT SqlBackend (RIO env) (Key Blob, BlobKey)
    storeBlob ByteString
    cabalBS
      let cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    pkgName
      _ <- insertBy FilePath {filePathPath = cabalFile}
      pure bid

    loadFilePath ::
         SafeFilePath
      -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath :: forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath SafeFilePath
    path = do
      fp <- Unique FilePath
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity FilePath))
    forall backend record (m :: * -> *).
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Unique record -> ReaderT SqlBackend 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 fp of
        Maybe (Entity FilePath)
    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
    $
          String
    "loadFilePath: No row found for " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack (SafeFilePath -> Text
    P.unSafeFilePath SafeFilePath
    path)
        Just Entity FilePath
    record -> Entity FilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Entity FilePath
    record

    loadHPackTreeEntity :: TreeId -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    loadHPackTreeEntity :: forall env.
    Key Tree -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    loadHPackTreeEntity Key Tree
    tid = do
      filepath <- SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath)
    loadFilePath SafeFilePath
    P.hpackSafeFilePath
      let filePathId :: FilePathId = entityKey filepath
      hpackTreeEntry <-
        selectFirst [TreeEntryTree ==. tid, TreeEntryPath ==. filePathId] []
      case hpackTreeEntry of
        Maybe (Entity TreeEntry)
    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
    $
             String
    "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 Entity TreeEntry
    record -> Entity TreeEntry -> ReaderT SqlBackend (RIO env) (Entity TreeEntry)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Entity TreeEntry
    record

    storeHPack ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => P.RawPackageLocationImmutable
      -> TreeId
      -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) (Key HPack)
    storeHPack RawPackageLocationImmutable
    rpli Key Tree
    tid = do
      vid <- ReaderT SqlBackend (RIO env) (Key Version)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId
      hpackRecord <- getBy (UniqueHPack tid vid)
      case hpackRecord of
        Maybe (Entity HPack)
    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 Entity HPack
    record -> Key HPack -> ReaderT SqlBackend (RIO env) (Key HPack)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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 :: forall env. Key HPack -> ReaderT SqlBackend (RIO env) BlobKey
    loadCabalBlobKey Key HPack
    hpackId = do
      hpackRecord <- Key HPack -> ReaderT SqlBackend (RIO env) HPack
    forall record backend (m :: * -> *).
    (PersistStoreRead backend, PersistRecordBackend record backend,
     MonadIO m) =>
    Key record -> ReaderT backend m record
    getJust Key HPack
    hpackId
      getBlobKey $ hPackCabalBlob hpackRecord

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

      -> TreeId
      -> VersionId
      -> ReaderT SqlBackend (RIO env) (Key HPack)
    generateHPack :: 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 = do
      tree <- Key Tree -> ReaderT SqlBackend (RIO env) Tree
    forall env. Key Tree -> ReaderT SqlBackend (RIO env) Tree
    getTree Key Tree
    tid
      (pkgName, cabalBS) <- hpackToCabalS rpli tree
      bid <- storeCabalFile cabalBS pkgName
      let cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    pkgName
      fid <- insertBy FilePath {filePathPath = cabalFile}
      let hpackRecord =
            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
              }
      either entityKey id <$> insertBy hpackRecord

    hpackVersionId ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => ReaderT SqlBackend (RIO env) VersionId
    hpackVersionId :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId = do
      hpackSoftwareVersion <- RIO env Version -> ReaderT SqlBackend (RIO env) Version
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift RIO env Version
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RIO env Version
    hpackVersion
      fmap (either entityKey id) $
        insertBy $
        Version {versionVersion = P.VersionP hpackSoftwareVersion}

    getFilePathId :: SafeFilePath -> ReaderT SqlBackend (RIO env) FilePathId
    getFilePathId :: forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    getFilePathId SafeFilePath
    sfp =
      [Filter FilePath]
    -> [SelectOpt FilePath]
    -> ReaderT SqlBackend (RIO env) [Key FilePath]
    forall record backend (m :: * -> *).
    (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 a b.
    ReaderT SqlBackend (RIO env) a
    -> (a -> ReaderT SqlBackend (RIO env) b)
    -> ReaderT SqlBackend (RIO env) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        [Key FilePath
    fpId] -> Key FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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
            RdbmsActions
              { raSqlite :: ReaderT SqlBackend (RIO env) (Key FilePath)
    raSqlite = FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall backend record (m :: * -> *).
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend, SafeToInsert record) =>
    record -> ReaderT backend m (Key record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend,
     SafeToInsert record) =>
    record -> ReaderT SqlBackend 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
                    Text
    "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
                    Text
    "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 a b.
    ReaderT SqlBackend (RIO env) a
    -> (a -> ReaderT SqlBackend (RIO env) b)
    -> ReaderT SqlBackend (RIO env) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    [Single Key FilePath
    key] -> Key FilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key FilePath
    key
                    [Single (Key FilePath)]
    _ -> String -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall a. HasCallStack => String -> a
    error
                      String
    "getFilePathId: there was a critical problem storing a blob."
              }
        [Key FilePath]
    _ ->
          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
    $
          String
    "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)

    -- | A tree that has already been stored in the database

    newtype CachedTree
      = CachedTreeMap (Map SafeFilePath (P.TreeEntry, BlobId))
      deriving Int -> CachedTree -> ShowS
    [CachedTree] -> ShowS
    CachedTree -> String
    (Int -> CachedTree -> ShowS)
    -> (CachedTree -> String)
    -> ([CachedTree] -> ShowS)
    -> Show CachedTree
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CachedTree -> ShowS
    showsPrec :: Int -> CachedTree -> ShowS
    $cshow :: CachedTree -> String
    show :: CachedTree -> String
    $cshowList :: [CachedTree] -> ShowS
    showList :: [CachedTree] -> ShowS
    Show

    unCachedTree :: CachedTree -> P.Tree
    unCachedTree :: CachedTree -> Tree
    unCachedTree (CachedTreeMap Map SafeFilePath (TreeEntry, Key Blob)
    m) = Map SafeFilePath TreeEntry -> Tree
    P.TreeMap (Map SafeFilePath TreeEntry -> Tree)
    -> Map SafeFilePath TreeEntry -> Tree
    forall a b. (a -> b) -> a -> b
    $ (TreeEntry, Key Blob) -> TreeEntry
    forall a b. (a, b) -> a
    fst ((TreeEntry, Key Blob) -> TreeEntry)
    -> Map SafeFilePath (TreeEntry, Key Blob)
    -> Map SafeFilePath TreeEntry
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map SafeFilePath (TreeEntry, Key Blob)
    m

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

      -> P.PackageIdentifier
      -> CachedTree
      -> P.BuildFile
      -> ReaderT SqlBackend (RIO env) (TreeId, P.TreeKey)
    storeTree :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    storeTree RawPackageLocationImmutable
    rpli (P.PackageIdentifier PackageName
    name Version
    version) tree :: CachedTree
    tree@(CachedTreeMap Map SafeFilePath (TreeEntry, Key Blob)
    m) BuildFile
    buildFile = do
      (bid, 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 -> ByteString) -> Tree -> ByteString
    forall a b. (a -> b) -> a -> b
    $ CachedTree -> Tree
    unCachedTree CachedTree
    tree
      (cabalid, ftype) <- case buildFile of
        P.BFHpack (P.TreeEntry BlobKey
    _ FileType
    ftype) -> (Maybe (Key Blob), FileType)
    -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob), FileType)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Key Blob)
    forall a. Maybe a
    Nothing, FileType
    ftype)
        P.BFCabal SafeFilePath
    _ (P.TreeEntry (P.BlobKey SHA256
    btypeSha FileSize
    _) FileType
    ftype) -> do
          buildTypeid <- SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    loadBlobBySHA SHA256
    btypeSha
          buildid <-
            case buildTypeid of
              Just Key Blob
    buildId -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    buildId
              Maybe (Key Blob)
    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
    $
                   String
    "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]
    ++ String
    " BlobKey not found: "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (CachedTree, SHA256) -> String
    forall a. Show a => a -> String
    show (CachedTree
    tree, SHA256
    btypeSha)
          pure (Just buildid, ftype)
      nameid <- getPackageNameId name
      versionid <- getVersionId version
      etid <- insertBy Tree
        { treeKey = bid
        , treeCabal = cabalid
        , treeCabalType = ftype
        , treeName = nameid
        , treeVersion = versionid
        }

      (tid, pTreeKey) <- case etid of
        Left (Entity Key Tree
    tid Tree
    _) -> (Key Tree, TreeKey)
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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 Key Tree
    tid -> do
          [(SafeFilePath, (TreeEntry, Key Blob))]
    -> ((SafeFilePath, (TreeEntry, Key Blob))
        -> 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, Key Blob)
    -> [(SafeFilePath, (TreeEntry, Key Blob))]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map SafeFilePath (TreeEntry, Key Blob)
    m) (((SafeFilePath, (TreeEntry, Key Blob))
      -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> ((SafeFilePath, (TreeEntry, Key Blob))
        -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \(SafeFilePath
    sfp, (P.TreeEntry BlobKey
    _blobKey FileType
    ft, Key Blob
    bid')) -> do
            sfpid <- SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    forall env.
    SafeFilePath -> ReaderT SqlBackend (RIO env) (Key FilePath)
    getFilePathId SafeFilePath
    sfp
            insert_ TreeEntry
              { treeEntryTree = tid
              , treeEntryPath = sfpid
              , treeEntryBlob = bid'
              , treeEntryType = ft
              }
          (Key Tree, TreeKey)
    -> ReaderT SqlBackend (RIO env) (Key Tree, TreeKey)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Key Tree
    tid, BlobKey -> TreeKey
    P.TreeKey BlobKey
    blobKey)
      case buildFile of
        P.BFHpack TreeEntry
    _ -> ReaderT SqlBackend (RIO env) (Key HPack)
    -> ReaderT SqlBackend (RIO env) ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT SqlBackend (RIO env) (Key HPack)
     -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) (Key HPack)
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ 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
        P.BFCabal SafeFilePath
    _ TreeEntry
    _ -> () -> ReaderT SqlBackend (RIO env) ()
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      pure (tid, pTreeKey)

    getTree :: TreeId -> ReaderT SqlBackend (RIO env) P.Tree
    getTree :: forall env. Key Tree -> ReaderT SqlBackend (RIO env) Tree
    getTree Key Tree
    tid = do
      (mts :: Maybe Tree) <- Key Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Key record -> ReaderT SqlBackend m (Maybe record)
    get Key Tree
    tid
      ts <-
          case mts of
            Maybe Tree
    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
    $ String
    "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 Tree
    ts -> Tree -> ReaderT SqlBackend (RIO env) Tree
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    ts
      loadTreeByEnt $ Entity tid ts

    loadTree :: P.TreeKey -> ReaderT SqlBackend (RIO env) (Maybe P.Tree)
    loadTree :: forall env. TreeKey -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    loadTree TreeKey
    key = do
      ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey TreeKey
    key
      case ment of
        Maybe (Entity Tree)
    Nothing -> Maybe Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Tree
    forall a. Maybe a
    Nothing
        Just 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 :: forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey (P.TreeKey BlobKey
    key) = do
      mbid <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    getBlobId BlobKey
    key
      case mbid of
        Maybe (Key Blob)
    Nothing -> Maybe (Entity Tree)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Entity Tree)
    forall a. Maybe a
    Nothing
        Just Key Blob
    bid -> Unique Tree -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall backend record (m :: * -> *).
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Unique record -> ReaderT SqlBackend 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Key Tree -> ReaderT SqlBackend (RIO env) Package
    loadPackageById RawPackageLocationImmutable
    rpli Key Tree
    tid = do
      (mts :: Maybe Tree) <- Key Tree -> ReaderT SqlBackend (RIO env) (Maybe Tree)
    forall backend record (m :: * -> *).
    (PersistStoreRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> ReaderT backend m (Maybe record)
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Key record -> ReaderT SqlBackend m (Maybe record)
    get Key Tree
    tid
      ts <- case mts of
        Maybe Tree
    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
    $ String
    "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 Tree
    ts -> Tree -> ReaderT SqlBackend (RIO env) Tree
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Tree
    ts
      (tree :: P.Tree) <- loadTreeByEnt $ Entity tid ts
      (blobKey :: BlobKey) <- getBlobKey $ treeKey ts
      (mname :: Maybe PackageName) <- get $ treeName ts
      name <- case mname of
        Maybe PackageName
    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
    $
          String
    "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 PackageName
    name)) -> PackageName -> ReaderT SqlBackend (RIO env) PackageName
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PackageName
    name
      mversion <- get $ treeVersion ts
      version <- case mversion of
        Maybe Version
    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
    $
          String
    "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 -> ReaderT SqlBackend (RIO env) Version
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Version
    version
      let ident = PackageName -> Version -> PackageIdentifier
    P.PackageIdentifier PackageName
    name Version
    version
      (packageEntry, mtree) <- case treeCabal ts of
        Just Key Blob
    keyBlob -> do
          cabalKey <- Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    forall env. Key Blob -> ReaderT SqlBackend (RIO env) BlobKey
    getBlobKey Key Blob
    keyBlob
          pure
            ( P.PCCabalFile $ P.TreeEntry cabalKey (treeCabalType ts)
            , tree)
        Maybe (Key Blob)
    Nothing -> do
          hpackVid <- ReaderT SqlBackend (RIO env) (Key Version)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ReaderT SqlBackend (RIO env) (Key Version)
    hpackVersionId
          hpackEntity <- getBy (UniqueHPack tid hpackVid)
          let (P.TreeMap tmap) = tree
              cabalFile = PackageName -> SafeFilePath
    P.cabalFileName PackageName
    name
          case hpackEntity of
            Maybe (Entity HPack)
    Nothing -> do
              -- This case will happen when you either update stack with a new hpack

              -- version or use different hpack version via --with-hpack option.

              (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
              hpackRecord <- getJust hpackId
              getHPackCabalFile hpackRecord ts tmap cabalFile
            Just (Entity Key HPack
    _ 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
      pure
        Package
          { packageTreeKey = P.TreeKey blobKey
          , packageTree = mtree
          , packageCabalEntry = packageEntry
          , packageIdent = ident
          }

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

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

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

    loadTreeByEnt :: Entity Tree -> ReaderT SqlBackend (RIO env) P.Tree
    loadTreeByEnt :: forall env. Entity Tree -> ReaderT SqlBackend (RIO env) Tree
    loadTreeByEnt (Entity Key Tree
    tid Tree
    _t) = do
      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
        Text
    "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]
      pure $ P.TreeMap $ Map.fromList $ map
        (\(Single SafeFilePath
    sfp, Single SHA256
    sha, Single FileSize
    size, Single FileType
    ft) ->
             (SafeFilePath
    sfp, BlobKey -> FileType -> TreeEntry
    P.TreeEntry (SHA256 -> FileSize -> BlobKey
    P.BlobKey SHA256
    sha FileSize
    size) FileType
    ft))
        entries

    storeHackageTree ::
         P.PackageName
      -> P.Version
      -> BlobId
      -> P.TreeKey
      -> ReaderT SqlBackend (RIO env) ()
    storeHackageTree :: forall env.
    PackageName
    -> Version
    -> Key Blob
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    storeHackageTree PackageName
    name Version
    version Key Blob
    cabal TreeKey
    treeKey' = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId version
      ment <- getTreeForKey treeKey'
      for_ ment $ \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 ()
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record] -> [Update record] -> ReaderT SqlBackend 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 :: forall env.
    PackageName
    -> Version
    -> SHA256
    -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    loadHackageTreeKey PackageName
    name Version
    ver SHA256
    sha = do
      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
        Text
    "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 res of
        [] -> Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe TreeKey
    forall a. Maybe a
    Nothing
        (Single SHA256
    treesha, Single FileSize
    size):[(Single SHA256, Single FileSize)]
    _ ->
          Maybe TreeKey -> ReaderT SqlBackend (RIO env) (Maybe TreeKey)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageName
    -> Version
    -> Key Blob
    -> ReaderT SqlBackend (RIO env) (Maybe Package)
    loadHackageTree RawPackageLocationImmutable
    rpli PackageName
    name Version
    ver Key Blob
    bid = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      versionid <- getVersionId ver
      ment <- selectFirst
        [ HackageCabalName ==. nameid
        , HackageCabalVersion ==. versionid
        , HackageCabalCabal ==. bid
        , HackageCabalTree !=. Nothing
        ]
        []
      case ment of
        Maybe (Entity HackageCabal)
    Nothing -> Maybe Package -> ReaderT SqlBackend (RIO env) (Maybe Package)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just (Entity Key HackageCabal
    _ HackageCabal
    hc) ->
          case HackageCabal -> Maybe (Key Tree)
    hackageCabalTree HackageCabal
    hc of
            Maybe (Key Tree)
    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 a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
            Just 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 :: forall env.
    Text
    -> Text
    -> SHA256
    -> FileSize
    -> TreeKey
    -> ReaderT SqlBackend (RIO env) ()
    storeArchiveCache Text
    url Text
    subdir SHA256
    sha FileSize
    size TreeKey
    treeKey' = do
      now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      ment <- getTreeForKey treeKey'
      for_ ment $ \Entity Tree
    ent -> ArchiveCache -> ReaderT SqlBackend (RIO env) ()
    forall backend record (m :: * -> *).
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend, SafeToInsert record) =>
    record -> ReaderT backend m ()
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend,
     SafeToInsert record) =>
    record -> ReaderT SqlBackend m ()
    insert_ 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 :: forall env.
    Text
    -> Text
    -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, Key Tree)]
    loadArchiveCache Text
    url 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 record backend (m :: * -> *).
    (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 Key ArchiveCache
    _ 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 :: forall env.
    Repo -> Text -> Key Tree -> ReaderT SqlBackend (RIO env) ()
    storeRepoCache Repo
    repo Text
    subdir Key Tree
    tid = do
      now <- ReaderT SqlBackend (RIO env) UTCTime
    forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime
      insert_ RepoCache
        { repoCacheTime = now
        , repoCacheUrl = repoUrl repo
        , repoCacheType = repoType repo
        , repoCacheCommit = repoCommit repo
        , repoCacheSubdir = subdir
        , repoCacheTree = tid
        }

    loadRepoCache ::
         Repo
      -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    loadRepoCache :: forall env. Repo -> ReaderT SqlBackend (RIO env) (Maybe (Key Tree))
    loadRepoCache Repo
    repo = (Entity RepoCache -> Key Tree)
    -> Maybe (Entity RepoCache) -> Maybe (Key Tree)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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))
    forall (m :: * -> *) record.
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    [Filter record]
    -> [SelectOpt record]
    -> ReaderT SqlBackend 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
    ==. Repo -> Text
    repoSubdir Repo
    repo
      ]
      [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 :: forall env. PackageName -> Text -> ReaderT SqlBackend (RIO env) ()
    storePreferredVersion PackageName
    name Text
    p = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      ment <- getBy $ UniquePreferred nameid
      case ment of
        Maybe (Entity PreferredVersions)
    Nothing -> PreferredVersions -> ReaderT SqlBackend (RIO env) ()
    forall backend record (m :: * -> *).
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend, SafeToInsert record) =>
    record -> ReaderT backend m ()
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend,
     SafeToInsert record) =>
    record -> ReaderT SqlBackend m ()
    insert_ PreferredVersions
          { preferredVersionsName :: Key PackageName
    preferredVersionsName = Key PackageName
    nameid
          , preferredVersionsPreferred :: Text
    preferredVersionsPreferred = Text
    p
          }
        Just (Entity Key PreferredVersions
    pid PreferredVersions
    _) -> Key PreferredVersions
    -> [Update PreferredVersions] -> ReaderT SqlBackend (RIO env) ()
    forall backend record (m :: * -> *).
    (PersistStoreWrite backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Key record -> [Update record] -> ReaderT backend m ()
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Key record -> [Update record] -> ReaderT SqlBackend 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 :: forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text)
    loadPreferredVersion PackageName
    name = do
      nameid <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    name
      fmap (preferredVersionsPreferred . entityVal) <$> getBy (UniquePreferred nameid)

    sinkHackagePackageNames ::
         (P.PackageName -> Bool)
      -> ConduitT P.PackageName Void (ReaderT SqlBackend (RIO env)) a
      -> ReaderT SqlBackend (RIO env) a
    sinkHackagePackageNames :: forall env a.
    (PackageName -> Bool)
    -> ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    -> ReaderT SqlBackend (RIO env) a
    sinkHackagePackageNames PackageName -> Bool
    predicate ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    sink = do
      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 ()))
    forall record (m1 :: * -> *) (m2 :: * -> *).
    (PersistRecordBackend record SqlBackend, MonadIO m1, MonadIO m2) =>
    [Filter record]
    -> [SelectOpt record]
    -> ReaderT
         SqlBackend m1 (Acquire (ConduitM () (Entity record) m2 ()))
    selectSourceRes [] []
      with acqSrc $ \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)) ()
    -> ConduitT
         (Entity PackageName) Void (ReaderT SqlBackend (RIO env)) a
    -> ConduitT () Void (ReaderT SqlBackend (RIO env)) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| (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
    -> ConduitT
         (Entity PackageName) Void (ReaderT SqlBackend (RIO env)) a
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT PackageName Void (ReaderT SqlBackend (RIO env)) a
    sink
     where
      go :: Entity PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    go (Entity Key PackageName
    nameid (PackageName (PackageNameP 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.

            onHackage <- Key PackageName -> ReaderT SqlBackend (RIO env) Bool
    forall {backend} {m :: * -> *}.
    (BaseBackend backend ~ SqlBackend, MonadIO m,
     PersistQueryRead backend) =>
    Key PackageName -> ReaderT backend m Bool
    checkOnHackage Key PackageName
    nameid
            pure $ if onHackage then Just name else Nothing
        | Bool
    otherwise = Maybe PackageName
    -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe PackageName
    forall a. Maybe a
    Nothing

      checkOnHackage :: Key PackageName -> ReaderT backend m Bool
    checkOnHackage Key PackageName
    nameid = do
        cnt <- [Filter HackageCabal] -> ReaderT backend m Int
    forall backend (m :: * -> *) record.
    (PersistQueryRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    [Filter record] -> ReaderT backend m Int
    forall (m :: * -> *) record.
    (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]
        pure $ cnt > 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile 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
      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 String
    "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 unix-like

      -- 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 (Char
    '.':String
    _) = Bool
    True
          isHidden String
    _ = Bool
    False
      case filter (not . isHidden . fromRelFile . filename) 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
        [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)
          (\PackageName
    pn -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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 String
    ".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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            String -> Maybe PackageName
    P.parsePackageName
        Path Abs File
    _:[Path Abs File]
    _ -> 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 String
    fp String
    x = ShowS
    FilePath.takeExtension String
    fp String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "." 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Tree -> ReaderT SqlBackend (RIO env) (PackageName, ByteString)
    hpackToCabalS RawPackageLocationImmutable
    rpli Tree
    tree = do
      tmpDir <- RIO env (Path Abs Dir)
    -> ReaderT SqlBackend (RIO env) (Path Abs Dir)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env (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
        tdir <- RIO env (Path Abs Dir)
    forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
    getTempDir
        createTempDir tdir "hpack-pkg-dir"
      unpackTreeToDir rpli tmpDir tree
      (packageName, cfile) <- lift $ findOrGenerateCabalFile tmpDir
      !bs <- lift $ B.readFile (fromAbsFile cfile)
      lift $ removeDirRecur tmpDir
      pure (packageName, bs)

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

      -> P.Tree
      -> RIO env (P.PackageName, ByteString)
    hpackToCabal :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> Tree -> RIO env (PackageName, ByteString)
    hpackToCabal RawPackageLocationImmutable
    rpli Tree
    tree = String
    -> (String -> RIO env (PackageName, ByteString))
    -> RIO env (PackageName, ByteString)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    String -> (String -> m a) -> m a
    withSystemTempDirectory String
    "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
    $ \String
    tmpdir -> do
      tdir <- String -> RIO env (Path Abs Dir)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
    parseAbsDir String
    tmpdir
      withStorage $ unpackTreeToDir rpli tdir tree
      (packageName, cfile) <- findOrGenerateCabalFile tdir
      bs <- B.readFile (fromAbsFile cfile)
      pure (packageName, 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable
    -> Path Abs Dir -> Tree -> ReaderT SqlBackend (RIO env) ()
    unpackTreeToDir RawPackageLocationImmutable
    rpli (Path Abs Dir -> String
    forall b t. Path b t -> String
    toFilePath -> String
    dir) (P.TreeMap 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
    $ \(SafeFilePath
    sfp, P.TreeEntry BlobKey
    blobKey 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
        mbs <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    blobKey
        case mbs of
          Maybe ByteString
    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 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
              FileType
    FTNormal -> () -> ReaderT SqlBackend (RIO env) ()
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
              FileType
    FTExecutable -> IO () -> ReaderT SqlBackend (RIO env) ()
    forall a. IO a -> ReaderT SqlBackend (RIO env) a
    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
                perms <- String -> IO Permissions
    forall (m :: * -> *). MonadIO m => String -> m Permissions
    getPermissions String
    dest
                setPermissions dest $ setOwnerExecutable True perms

    countHackageCabals :: ReaderT SqlBackend (RIO env) Int
    countHackageCabals :: forall env. ReaderT SqlBackend (RIO env) Int
    countHackageCabals = do
      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
        Text
    "SELECT COUNT(*)\n\
        \FROM hackage_cabal"
        []
      case res of
        [] -> Int -> ReaderT SqlBackend (RIO env) Int
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    0
        (Single Int
    n):[Single Int]
    _ ->
          Int -> ReaderT SqlBackend (RIO env) Int
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    n

    getSnapshotCacheByHash ::
         SnapshotCacheHash
      -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    getSnapshotCacheByHash :: forall env.
    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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Entity SnapshotCache -> Key SnapshotCache)
    -> Maybe (Entity SnapshotCache) -> Maybe (Key SnapshotCache)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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 record (m :: * -> *).
    (PersistUniqueRead backend, MonadIO m,
     PersistRecordBackend record backend) =>
    Unique record -> ReaderT backend m (Maybe (Entity record))
    forall record (m :: * -> *).
    (MonadIO m, PersistRecordBackend record SqlBackend) =>
    Unique record -> ReaderT SqlBackend 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 :: forall env.
    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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 record backend (m :: * -> *).
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record,
     SafeToInsert 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 :: forall env.
    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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 record backend (m :: * -> *).
    (MonadIO m, PersistUniqueWrite backend,
     PersistRecordBackend record backend, AtLeastOneUniqueKey record,
     SafeToInsert 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 :: forall env.
    Key SnapshotCache
    -> Map PackageName (Set ModuleName)
    -> ReaderT SqlBackend (RIO env) ()
    storeSnapshotModuleCache Key SnapshotCache
    cache 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
    $ \(PackageName
    pn, Set ModuleName
    modules) -> do
        package <- PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    forall env.
    PackageName -> ReaderT SqlBackend (RIO env) (Key PackageName)
    getPackageNameId PackageName
    pn
        forM_ modules $ \ModuleName
    m -> do
          moduleName <- ModuleName -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    forall env.
    ModuleName -> ReaderT SqlBackend (RIO env) (Key ModuleName)
    getModuleNameId ModuleName
    m
          insert_ PackageExposedModule
            { packageExposedModuleSnapshotCache = cache
            , packageExposedModulePackage = package
            , packageExposedModuleModule = moduleName
            }

    loadExposedModulePackages ::
         SnapshotCacheId
      -> P.ModuleName
      -> ReaderT SqlBackend (RIO env) [P.PackageName]
    loadExposedModulePackages :: forall env.
    Key SnapshotCache
    -> ModuleName -> ReaderT SqlBackend (RIO env) [PackageName]
    loadExposedModulePackages Key SnapshotCache
    cacheId 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
        Text
    "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 PackageName
    m)) = PackageName
    m

    newtype LoadCachedTreeException = MissingBlob BlobKey
      deriving (Int -> LoadCachedTreeException -> ShowS
    [LoadCachedTreeException] -> ShowS
    LoadCachedTreeException -> String
    (Int -> LoadCachedTreeException -> ShowS)
    -> (LoadCachedTreeException -> String)
    -> ([LoadCachedTreeException] -> ShowS)
    -> Show LoadCachedTreeException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LoadCachedTreeException -> ShowS
    showsPrec :: Int -> LoadCachedTreeException -> ShowS
    $cshow :: LoadCachedTreeException -> String
    show :: LoadCachedTreeException -> String
    $cshowList :: [LoadCachedTreeException] -> ShowS
    showList :: [LoadCachedTreeException] -> ShowS
    Show, Typeable)

    instance Exception LoadCachedTreeException

    -- | Ensure that all blobs needed for this package are present in the cache

    loadCachedTree ::
         forall env. P.Tree
      -> ReaderT SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    loadCachedTree :: forall env.
    Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    loadCachedTree (P.TreeMap Map SafeFilePath TreeEntry
    m) =
      ReaderT SqlBackend (RIO env) CachedTree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    forall (m :: * -> *) e a.
    (MonadUnliftIO m, Exception e) =>
    m a -> m (Either e a)
    try (ReaderT SqlBackend (RIO env) CachedTree
     -> ReaderT
          SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree))
    -> ReaderT SqlBackend (RIO env) CachedTree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    forall a b. (a -> b) -> a -> b
    $ Map SafeFilePath (TreeEntry, Key Blob) -> CachedTree
    CachedTreeMap (Map SafeFilePath (TreeEntry, Key Blob) -> CachedTree)
    -> ReaderT
         SqlBackend (RIO env) (Map SafeFilePath (TreeEntry, Key Blob))
    -> ReaderT SqlBackend (RIO env) CachedTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TreeEntry -> ReaderT SqlBackend (RIO env) (TreeEntry, Key Blob))
    -> Map SafeFilePath TreeEntry
    -> ReaderT
         SqlBackend (RIO env) (Map SafeFilePath (TreeEntry, Key Blob))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map SafeFilePath a -> f (Map SafeFilePath b)
    traverse TreeEntry -> ReaderT SqlBackend (RIO env) (TreeEntry, Key Blob)
    loadEntry Map SafeFilePath TreeEntry
    m
     where
      loadEntry :: P.TreeEntry -> ReaderT SqlBackend (RIO env) (P.TreeEntry, BlobId)
      loadEntry :: TreeEntry -> ReaderT SqlBackend (RIO env) (TreeEntry, Key Blob)
    loadEntry TreeEntry
    te = (TreeEntry
    te, ) (Key Blob -> (TreeEntry, Key Blob))
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    -> ReaderT SqlBackend (RIO env) (TreeEntry, Key Blob)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlobKey -> ReaderT SqlBackend (RIO env) (Key Blob)
    loadBlob' (TreeEntry -> BlobKey
    P.teBlob TreeEntry
    te)

      loadBlob' :: BlobKey -> ReaderT SqlBackend (RIO env) BlobId
      loadBlob' :: BlobKey -> ReaderT SqlBackend (RIO env) (Key Blob)
    loadBlob' blobKey :: BlobKey
    blobKey@(P.BlobKey SHA256
    sha FileSize
    _) = do
        mbid <- SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    forall env.
    SHA256 -> ReaderT SqlBackend (RIO env) (Maybe (Key Blob))
    loadBlobBySHA SHA256
    sha
        case mbid of
          Maybe (Key Blob)
    Nothing -> LoadCachedTreeException -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (LoadCachedTreeException
     -> ReaderT SqlBackend (RIO env) (Key Blob))
    -> LoadCachedTreeException
    -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> LoadCachedTreeException
    MissingBlob BlobKey
    blobKey
          Just Key Blob
    bid -> Key Blob -> ReaderT SqlBackend (RIO env) (Key Blob)
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Key Blob
    bid