Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Pantry.Internal.Stackage
Description
All types and functions exported from this module are for advanced usage only. They are needed for stackage-server integration with pantry.
Synopsis
- data family EntityField record :: Type -> Type
- data family Key record
- data family Unique record
- data SafeFilePath
- newtype ModuleNameP = ModuleNameP {
- unModuleNameP :: ModuleName
- newtype VersionP = VersionP {}
- newtype PackageNameP = PackageNameP {}
- data PantryConfig = PantryConfig {
- pcHackageSecurity :: !HackageSecurityConfig
- pcHpackExecutable :: !HpackExecutable
- pcRootDir :: !(Path Abs Dir)
- pcStorage :: !Storage
- pcUpdateRef :: !(MVar Bool)
- pcParsedCabalFilesRawImmutable :: !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
- pcParsedCabalFilesMutable :: !(IORef (Map (Path Abs Dir) (PrintWarnings -> IO GenericPackageDescription, PackageName, Path Abs File)))
- pcConnectionCount :: !Int
- pcCasaRepoPrefix :: !CasaRepoPrefix
- pcCasaMaxPerRequest :: !Int
- pcSnapshotLocation :: SnapName -> RawSnapshotLocation
- data Storage = Storage {
- withStorage_ :: forall env a. HasLogFunc env => ReaderT SqlBackend (RIO env) a -> RIO env a
- withWriteLock_ :: forall env a. HasLogFunc env => RIO env a -> RIO env a
- packageTreeKey :: Package -> TreeKey
- unSafeFilePath :: SafeFilePath -> Text
- mkSafeFilePath :: Text -> Maybe SafeFilePath
- type ModuleNameId = Key ModuleName
- type TreeEntryId = Key TreeEntry
- type TreeId = Key Tree
- data Tree = Tree {
- treeKey :: !BlobId
- treeCabal :: !(Maybe BlobId)
- treeCabalType :: !FileType
- treeName :: !PackageNameId
- treeVersion :: !VersionId
- type HackageCabalId = Key HackageCabal
- type VersionId = Key Version
- data Version
- type PackageNameId = Key PackageName
- data PackageName
- type BlobId = Key Blob
- migrateAll :: Migration
- getPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
- getPackageNameId :: PackageName -> ReaderT SqlBackend (RIO env) PackageNameId
- getVersionId :: Version -> ReaderT SqlBackend (RIO env) VersionId
- storeBlob :: ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey)
- loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString
- allBlobsSource :: HasResourceMap env => Maybe BlobId -> ConduitT () (BlobId, ByteString) (ReaderT SqlBackend (RIO env)) ()
- allHackageCabalRawPackageLocations :: HasResourceMap env => Maybe HackageCabalId -> ReaderT SqlBackend (RIO env) (Map HackageCabalId RawPackageLocationImmutable)
- allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int
- allHackageCabalCount :: Maybe HackageCabalId -> ReaderT SqlBackend (RIO env) Int
- getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey
- getTreeForKey :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
- data HackageTarballResult = HackageTarballResult {
- htrPackage :: !Package
- htrFreshPackageInfo :: !(Maybe (GenericPackageDescription, TreeId))
- forceUpdateHackageIndex :: (HasPantryConfig env, HasLogFunc env) => Maybe Utf8Builder -> RIO env DidUpdateOccur
- getHackageTarball :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageIdentifierRevision -> Maybe TreeKey -> RIO env HackageTarballResult
Documentation
data family EntityField record :: Type -> Type #
Instances
SymbolToField sym rec typ => IsLabel sym (EntityField rec typ) | |
Defined in Database.Persist.Class.PersistEntity Methods fromLabel :: EntityField rec typ | |
data EntityField PackageName typ Source # | |
Defined in Pantry.Storage data EntityField PackageName typ
| |
data EntityField Tree typ Source # | |
Defined in Pantry.Storage data EntityField Tree typ
| |
data EntityField Version typ Source # | |
Defined in Pantry.Storage |
Instances
Instances
data Unique PackageName Source # | |
Defined in Pantry.Storage | |
data Unique Tree Source # | |
Defined in Pantry.Storage | |
data Unique Version Source # | |
Defined in Pantry.Storage |
data SafeFilePath Source #
Instances
Show SafeFilePath Source # | |
Defined in Pantry.Types Methods showsPrec :: Int -> SafeFilePath -> ShowS show :: SafeFilePath -> String showList :: [SafeFilePath] -> ShowS | |
Eq SafeFilePath Source # | |
Defined in Pantry.Types | |
Ord SafeFilePath Source # | |
Defined in Pantry.Types Methods compare :: SafeFilePath -> SafeFilePath -> Ordering (<) :: SafeFilePath -> SafeFilePath -> Bool (<=) :: SafeFilePath -> SafeFilePath -> Bool (>) :: SafeFilePath -> SafeFilePath -> Bool (>=) :: SafeFilePath -> SafeFilePath -> Bool max :: SafeFilePath -> SafeFilePath -> SafeFilePath min :: SafeFilePath -> SafeFilePath -> SafeFilePath | |
PersistField SafeFilePath Source # | |
Defined in Pantry.Types Methods toPersistValue :: SafeFilePath -> PersistValue fromPersistValue :: PersistValue -> Either Text SafeFilePath | |
PersistFieldSql SafeFilePath Source # | |
Defined in Pantry.Types Methods sqlType :: Proxy SafeFilePath -> SqlType | |
Display SafeFilePath Source # | |
Defined in Pantry.Types |
newtype ModuleNameP Source #
Constructors
ModuleNameP | |
Fields
|
Instances
Show ModuleNameP Source # | |
Defined in Pantry.Types Methods showsPrec :: Int -> ModuleNameP -> ShowS show :: ModuleNameP -> String showList :: [ModuleNameP] -> ShowS | |
NFData ModuleNameP Source # | |
Defined in Pantry.Types Methods rnf :: ModuleNameP -> () | |
Eq ModuleNameP Source # | |
Defined in Pantry.Types | |
Ord ModuleNameP Source # | |
Defined in Pantry.Types Methods compare :: ModuleNameP -> ModuleNameP -> Ordering (<) :: ModuleNameP -> ModuleNameP -> Bool (<=) :: ModuleNameP -> ModuleNameP -> Bool (>) :: ModuleNameP -> ModuleNameP -> Bool (>=) :: ModuleNameP -> ModuleNameP -> Bool max :: ModuleNameP -> ModuleNameP -> ModuleNameP min :: ModuleNameP -> ModuleNameP -> ModuleNameP | |
PersistField ModuleNameP Source # | |
Defined in Pantry.Types Methods toPersistValue :: ModuleNameP -> PersistValue fromPersistValue :: PersistValue -> Either Text ModuleNameP | |
PersistFieldSql ModuleNameP Source # | |
Defined in Pantry.Types Methods sqlType :: Proxy ModuleNameP -> SqlType | |
Display ModuleNameP Source # | |
Defined in Pantry.Types |
Constructors
VersionP | |
Fields |
Instances
FromJSON VersionP Source # | |
Defined in Pantry.Types | |
ToJSON VersionP Source # | |
Defined in Pantry.Types | |
Read VersionP Source # | |
Defined in Pantry.Types | |
Show VersionP Source # | |
NFData VersionP Source # | |
Defined in Pantry.Types | |
Eq VersionP Source # | |
Ord VersionP Source # | |
PersistField VersionP Source # | |
Defined in Pantry.Types Methods toPersistValue :: VersionP -> PersistValue fromPersistValue :: PersistValue -> Either Text VersionP | |
PersistFieldSql VersionP Source # | |
Defined in Pantry.Types | |
Display VersionP Source # | |
Defined in Pantry.Types | |
SymbolToField "version" Version VersionP | |
Defined in Pantry.Storage Methods |
newtype PackageNameP Source #
Constructors
PackageNameP | |
Fields |
Instances
data PantryConfig Source #
Configuration value used by the entire pantry package. Create one
using withPantryConfig
. See also PantryApp
for a convenience
approach to using pantry.
Since: 0.1.0.0
Constructors
PantryConfig | |
Fields
|
Represents a SQL database connection. This used to be a newtype wrapper around a connection pool. However, when investigating https://github.com/commercialhaskell/stack/issues/4471, it appeared that holding a pool resulted in overly long write locks being held on the database. As a result, we now abstract away whether a pool is used, and the default implementation in Pantry.Storage does not use a pool.
Constructors
Storage | |
Fields
|
packageTreeKey :: Package -> TreeKey Source #
The TreeKey
containing this package.
This is a hash of the binary representation of packageTree
.
Since: 0.1.0.0
unSafeFilePath :: SafeFilePath -> Text Source #
mkSafeFilePath :: Text -> Maybe SafeFilePath Source #
type ModuleNameId = Key ModuleName Source #
type TreeEntryId = Key TreeEntry Source #
Constructors
Tree | |
Fields
|
Instances
PersistEntity Tree Source # | |
Defined in Pantry.Storage Methods keyToValues :: Key Tree -> [PersistValue] keyFromValues :: [PersistValue] -> Either Text (Key Tree) persistIdField :: EntityField Tree (Key Tree) entityDef :: proxy Tree -> EntityDef persistFieldDef :: EntityField Tree typ -> FieldDef toPersistFields :: Tree -> [SomePersistField] fromPersistValues :: [PersistValue] -> Either Text Tree persistUniqueKeys :: Tree -> [Unique Tree] persistUniqueToFieldNames :: Unique Tree -> NonEmpty (FieldNameHS, FieldNameDB) persistUniqueToValues :: Unique Tree -> [PersistValue] fieldLens :: EntityField Tree field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity Tree -> f (Entity Tree) keyFromRecordM :: Maybe (Tree -> Key Tree) | |
PersistField Tree Source # | |
Defined in Pantry.Storage | |
AtLeastOneUniqueKey Tree Source # | |
Defined in Pantry.Storage Methods requireUniquesP :: Tree -> NonEmpty (Unique Tree) | |
OnlyOneUniqueKey Tree Source # | |
Defined in Pantry.Storage Methods onlyUniqueP :: Tree -> Unique Tree | |
PersistFieldSql Tree Source # | |
Defined in Pantry.Storage | |
ToBackendKey SqlBackend Tree Source # | |
Defined in Pantry.Storage Methods toBackendKey :: Key Tree -> BackendKey SqlBackend fromBackendKey :: BackendKey SqlBackend -> Key Tree | |
SymbolToField "cabalType" Tree FileType Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "key" Tree BlobId Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "name" Tree PackageNameId Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "version" Tree VersionId Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "cabal" Tree (Maybe BlobId) Source # | |
Defined in Pantry.Storage Methods symbolToField :: EntityField Tree (Maybe BlobId) | |
SymbolToField "id" Tree (Key Tree) Source # | |
Defined in Pantry.Storage Methods symbolToField :: EntityField Tree (Key Tree) | |
FromJSON (Key Tree) Source # | |
ToJSON (Key Tree) Source # | |
Read (Key Tree) Source # | |
Show (Key Tree) Source # | |
Eq (Key Tree) Source # | |
Ord (Key Tree) Source # | |
FromHttpApiData (Key Tree) Source # | |
Defined in Pantry.Storage Methods parseUrlPiece :: Text -> Either Text (Key Tree) parseHeader :: ByteString -> Either Text (Key Tree) parseQueryParam :: Text -> Either Text (Key Tree) | |
ToHttpApiData (Key Tree) Source # | |
Defined in Pantry.Storage Methods toUrlPiece :: Key Tree -> Text toEncodedUrlPiece :: Key Tree -> Builder toHeader :: Key Tree -> ByteString toQueryParam :: Key Tree -> Text | |
PathPiece (Key Tree) Source # | |
Defined in Pantry.Storage | |
PersistField (Key Tree) Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Key Tree -> PersistValue fromPersistValue :: PersistValue -> Either Text (Key Tree) | |
PersistFieldSql (Key Tree) Source # | |
Defined in Pantry.Storage | |
data EntityField Tree typ Source # | |
Defined in Pantry.Storage data EntityField Tree typ
| |
newtype Key Tree Source # | |
Defined in Pantry.Storage | |
type PersistEntityBackend Tree Source # | |
Defined in Pantry.Storage type PersistEntityBackend Tree = SqlBackend | |
data Unique Tree Source # | |
Defined in Pantry.Storage |
type HackageCabalId = Key HackageCabal Source #
Instances
PersistEntity Version Source # | |
Defined in Pantry.Storage Methods keyToValues :: Key Version -> [PersistValue] keyFromValues :: [PersistValue] -> Either Text (Key Version) persistIdField :: EntityField Version (Key Version) entityDef :: proxy Version -> EntityDef persistFieldDef :: EntityField Version typ -> FieldDef toPersistFields :: Version -> [SomePersistField] fromPersistValues :: [PersistValue] -> Either Text Version persistUniqueKeys :: Version -> [Unique Version] persistUniqueToFieldNames :: Unique Version -> NonEmpty (FieldNameHS, FieldNameDB) persistUniqueToValues :: Unique Version -> [PersistValue] fieldLens :: EntityField Version field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity Version -> f (Entity Version) keyFromRecordM :: Maybe (Version -> Key Version) | |
PersistField Version Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Version -> PersistValue fromPersistValue :: PersistValue -> Either Text Version | |
AtLeastOneUniqueKey Version Source # | |
Defined in Pantry.Storage Methods requireUniquesP :: Version -> NonEmpty (Unique Version) | |
OnlyOneUniqueKey Version Source # | |
Defined in Pantry.Storage Methods onlyUniqueP :: Version -> Unique Version | |
PersistFieldSql Version Source # | |
Defined in Pantry.Storage | |
ToBackendKey SqlBackend Version Source # | |
Defined in Pantry.Storage Methods toBackendKey :: Key Version -> BackendKey SqlBackend fromBackendKey :: BackendKey SqlBackend -> Key Version | |
SymbolToField "version" Tree VersionId Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "version" Version VersionP Source # | |
Defined in Pantry.Storage Methods | |
SymbolToField "id" Version (Key Version) Source # | |
Defined in Pantry.Storage Methods | |
FromJSON (Key Version) Source # | |
ToJSON (Key Version) Source # | |
Read (Key Version) Source # | |
Show (Key Version) Source # | |
Eq (Key Version) Source # | |
Ord (Key Version) Source # | |
FromHttpApiData (Key Version) Source # | |
Defined in Pantry.Storage Methods parseUrlPiece :: Text -> Either Text (Key Version) parseHeader :: ByteString -> Either Text (Key Version) parseQueryParam :: Text -> Either Text (Key Version) | |
ToHttpApiData (Key Version) Source # | |
Defined in Pantry.Storage Methods toUrlPiece :: Key Version -> Text toEncodedUrlPiece :: Key Version -> Builder toHeader :: Key Version -> ByteString toQueryParam :: Key Version -> Text | |
PathPiece (Key Version) Source # | |
Defined in Pantry.Storage | |
PersistField (Key Version) Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Key Version -> PersistValue fromPersistValue :: PersistValue -> Either Text (Key Version) | |
PersistFieldSql (Key Version) Source # | |
Defined in Pantry.Storage | |
data EntityField Version typ Source # | |
Defined in Pantry.Storage | |
newtype Key Version Source # | |
Defined in Pantry.Storage | |
type PersistEntityBackend Version Source # | |
Defined in Pantry.Storage type PersistEntityBackend Version = SqlBackend | |
data Unique Version Source # | |
Defined in Pantry.Storage |
type PackageNameId = Key PackageName Source #
data PackageName Source #
Instances
migrateAll :: Migration Source #
getPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageName) Source #
getPackageNameId :: PackageName -> ReaderT SqlBackend (RIO env) PackageNameId Source #
getVersionId :: Version -> ReaderT SqlBackend (RIO env) VersionId Source #
loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString Source #
Arguments
:: HasResourceMap env | |
=> Maybe BlobId | For some x, yield blob whose id>x. |
-> ConduitT () (BlobId, ByteString) (ReaderT SqlBackend (RIO env)) () |
allHackageCabalRawPackageLocations Source #
Arguments
:: HasResourceMap env | |
=> Maybe HackageCabalId | For some x, yield cabals whose id>x. |
-> ReaderT SqlBackend (RIO env) (Map HackageCabalId RawPackageLocationImmutable) |
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.
allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int Source #
allHackageCabalCount :: Maybe HackageCabalId -> ReaderT SqlBackend (RIO env) Int Source #
getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey Source #
getTreeForKey :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)) Source #
data HackageTarballResult Source #
Information returned by getHackageTarball
Since: 0.1.0.0
Constructors
HackageTarballResult | |
Fields
|
forceUpdateHackageIndex :: (HasPantryConfig env, HasLogFunc env) => Maybe Utf8Builder -> RIO env DidUpdateOccur Source #
Same as updateHackageIndex
, but force the database update even if hackage
security tells that there is no change. This can be useful in order to make
sure the database is in sync with the locally downloaded tarball
Since: 0.1.0.0
getHackageTarball :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageIdentifierRevision -> Maybe TreeKey -> RIO env HackageTarballResult Source #