From 7e801331b22c3eba981cc94001aba73f8a632d6e Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 31 Oct 2023 00:08:23 +0000 Subject: [PATCH] Add import lists --- int/Pantry/HPack.hs | 6 ++ int/Pantry/SHA256.hs | 4 +- int/Pantry/Types.hs | 6 +- .../Client/Repository/HttpLib/HttpClient.hs | 10 ++- src/Pantry.hs | 72 ++++++++++++++++--- src/Pantry/Archive.hs | 27 +++++-- src/Pantry/Casa.hs | 4 +- src/Pantry/HTTP.hs | 4 +- src/Pantry/Hackage.hs | 43 +++++++++-- src/Pantry/Repo.hs | 19 ++++- src/Pantry/SQLite.hs | 4 ++ src/Pantry/Storage.hs | 23 ++++-- src/Pantry/Tree.hs | 8 ++- 13 files changed, 190 insertions(+), 40 deletions(-) diff --git a/int/Pantry/HPack.hs b/int/Pantry/HPack.hs index 8e3ca9ca..a362b654 100644 --- a/int/Pantry/HPack.hs +++ b/int/Pantry/HPack.hs @@ -13,11 +13,17 @@ import Data.Char ( isDigit, isSpace ) import qualified Hpack import qualified Hpack.Config as Hpack import Pantry.Types + ( HasPantryConfig, HpackExecutable (..), PantryConfig (..) + , Version, pantryConfigL, parseVersionThrowing + ) import Path ( Abs, Dir, Path, (), filename, parseRelFile, toFilePath ) import Path.IO ( doesFileExist ) import RIO import RIO.Process + ( HasProcessContext, proc, readProcessStdout_, runProcess_ + , withWorkingDir + ) hpackVersion :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) diff --git a/int/Pantry/SHA256.hs b/int/Pantry/SHA256.hs index 97b64e09..13bca111 100644 --- a/int/Pantry/SHA256.hs +++ b/int/Pantry/SHA256.hs @@ -39,10 +39,10 @@ module Pantry.SHA256 , toRaw ) where -import Conduit +import Conduit ( ConduitT ) import qualified Crypto.Hash as Hash ( Digest, SHA256, hash, hashlazy ) import qualified Crypto.Hash.Conduit as Hash ( hashFile, sinkHash ) -import Data.Aeson +import Data.Aeson ( FromJSON (..), ToJSON (..), withText ) import qualified Data.ByteArray import qualified Data.ByteArray.Encoding as Mem import Data.StaticBytes diff --git a/int/Pantry/Types.hs b/int/Pantry/Types.hs index 0585420e..ac764d2c 100644 --- a/int/Pantry/Types.hs +++ b/int/Pantry/Types.hs @@ -125,11 +125,13 @@ module Pantry.Types ) where import Casa.Client ( CasaRepoPrefix ) -import Database.Persist -import Database.Persist.Sql +import Database.Persist.Class.PersistField ( PersistField (..) ) +import Database.Persist.PersistValue ( PersistValue (..) ) +import Database.Persist.Sql ( PersistFieldSql (..), SqlBackend ) #if MIN_VERSION_persistent(2, 13, 0) import Database.Persist.SqlBackend.Internal ( connRDBMS ) #endif +import Database.Persist.Types ( SqlType (..) ) import Data.Aeson.Encoding.Internal ( unsafeToEncoding ) import Data.Aeson.Types ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..) diff --git a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs index a0088dd0..17351da6 100644 --- a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +++ b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs @@ -10,15 +10,19 @@ module Hackage.Security.Client.Repository.HttpLib.HttpClient ( httpLib ) where -import Control.Exception +import Control.Exception ( handle ) import Control.Monad ( void ) import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.C8 -import Hackage.Security.Client hiding ( Header ) +import Hackage.Security.Client ( SomeRemoteError (..) ) import Hackage.Security.Client.Repository.HttpLib + ( BodyReader, HttpLib (..), HttpRequestHeader (..) + , HttpResponseHeader (..), HttpStatus (..) + ) import Hackage.Security.Util.Checked -import Network.URI + ( Throws, handleChecked, throwChecked ) +import Network.URI ( URI ) import qualified Pantry.HTTP as HTTP {------------------------------------------------------------------------------- diff --git a/src/Pantry.hs b/src/Pantry.hs index 892edcbf..ceeffc6a 100644 --- a/src/Pantry.hs +++ b/src/Pantry.hs @@ -69,7 +69,7 @@ module Pantry , CabalFileInfo (..) , Revision (..) , PackageIdentifierRevision (..) - , UsePreferredVersions (..) + , UsePreferredVersions -- ** Archives , RawArchive (..) @@ -180,7 +180,7 @@ module Pantry -- * Hackage index , updateHackageIndex , DidUpdateOccur (..) - , RequireHackageIndex (..) + , RequireHackageIndex , hackageIndexTarballL , getHackagePackageVersions , getLatestHackageVersion @@ -196,7 +196,7 @@ module Pantry ) where import Casa.Client ( CasaRepoPrefix, thParserCasaRepo ) -import Conduit +import Conduit ( (.|), mapC, mapMC, runConduitRes, sinkList, sumC ) import Control.Applicative ( empty ) import Control.Arrow ( right ) import Control.Monad.State.Strict ( State, execState, get, modify' ) @@ -214,7 +214,7 @@ import Data.Monoid ( Endo (..) ) import Data.Time ( diffUTCTime, getCurrentTime ) import qualified Data.Yaml as Yaml import Data.Yaml.Include ( decodeFileWithWarnings ) -import Database.Persist ( entityKey ) +import Database.Persist.Class.PersistEntity ( entityKey ) import Distribution.PackageDescription ( FlagName, GenericPackageDescription ) import qualified Distribution.PackageDescription as D @@ -223,17 +223,66 @@ import qualified Hpack import qualified Hpack.Config as Hpack import Hpack.Error ( formatHpackError ) import Hpack.Yaml ( formatWarning ) -import Network.HTTP.Download +import Network.HTTP.Download ( download, redownload ) import Pantry.Archive -import Pantry.Casa -import Pantry.HTTP + ( fetchArchives, findCabalOrHpackFile, getArchive + , getArchiveKey, getArchivePackage + ) +import Pantry.Casa ( casaBlobSource, casaLookupKey, casaLookupTree ) +import Pantry.HTTP ( httpSinkChecked, parseRequest ) import Pantry.Hackage + ( DidUpdateOccur (..), RequireHackageIndex + , UsePreferredVersions, getHackageCabalFile + , getHackagePackageVersionRevisions + , getHackagePackageVersions, getHackageTarball + , getHackageTarballKey, getHackageTypoCorrections + , hackageIndexTarballL, htrPackage, updateHackageIndex + ) import Pantry.Repo + ( fetchRepos, fetchReposRaw, getRepo, getRepoKey, withRepo ) import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage hiding - ( TreeEntry, PackageName, Version, findOrGenerateCabalFile ) -import Pantry.Tree +import Pantry.Storage + ( getSnapshotCacheByHash, getSnapshotCacheId, getTreeForKey + , initStorage, loadBlob, loadCachedTree + , loadExposedModulePackages, loadPackageById, loadURLBlob + , storeSnapshotModuleCache, storeTree, storeURLBlob + , withStorage + ) +import Pantry.Tree ( rawParseGPD, unpackTree ) import Pantry.Types as P + ( Archive (..), ArchiveLocation (..), BlobKey (..) + , CabalFileInfo (..), CabalString (..), FileSize (..) + , FuzzyResults (..), HackageSecurityConfig (..) + , HasPantryConfig (..), HpackExecutable (..), Mismatch (..) + , ModuleName, Package (..), PackageCabal (..) + , PackageIdentifier (..), PackageIdentifierRevision (..) + , PackageIndexConfig (..), PackageLocation (..) + , PackageLocationImmutable (..), PackageMetadata (..) + , PackageName, PantryConfig (..), PantryException (..) + , PHpack (..), PrintWarnings (..), RawArchive (..) + , RawPackageLocation (..), RawPackageLocationImmutable (..) + , RawPackageMetadata (..), RawSnapshot (..) + , RawSnapshotLayer (..), RawSnapshotLocation (..) + , RawSnapshotPackage (..), RelFilePath (..), Repo (..) + , RepoType (..), ResolvedPath (..), Revision (..) + , SafeFilePath, SHA256, SimpleRepo (..), SnapName (..) + , Snapshot (..), SnapshotCacheHash (..), SnapshotLayer (..) + , SnapshotLocation (..), SnapshotPackage (..), Tree (..) + , TreeEntry (..), TreeKey (..), Unresolved, Version + , WantedCompiler (..), bsToBlobKey, cabalFileName + , defaultHackageSecurityConfig, defaultSnapshotLocation + , flagNameString, getGlobalHintsFile, mkSafeFilePath + , moduleNameString, packageIdentifierString + , packageNameString, parseFlagName, parseHackageText + , parsePackageIdentifier, parsePackageIdentifierRevision + , parsePackageName, parsePackageNameThrowing + , parseRawSnapshotLocation, parseSnapName, parseTreeM + , parseVersion, parseVersionThrowing, parseWantedCompiler + , pirForHash, resolvePaths, snapshotLocation + , toCabalStringMap, toRawPL, toRawPLI, toRawPM, toRawSL + , toRawSnapshotLayer, unCabalStringMap, unSafeFilePath + , versionString, warnMissingCabalFile + ) import Path ( Abs, Dir, File, Path, (), filename, parent, parseAbsDir , parseRelFile, toFilePath @@ -249,6 +298,7 @@ import RIO.PrettyPrint ( HasTerm (..) ) import RIO.PrettyPrint.StylesUpdate ( HasStylesUpdate (..), StylesUpdate ) import RIO.Process + ( HasProcessContext (..), proc, runProcess_, withWorkingDir ) import qualified RIO.Set as Set import RIO.Text ( unpack ) import qualified RIO.Text as T @@ -992,7 +1042,7 @@ tryLoadPackageRawViaCasa rlpi treeKey' = runMaybeT $ do lift $ fetchTreeKeys [rlpi] tryViaLocalDb treeKey'' <|> warn treeKey'' where - tryViaLocalDb = MaybeT . (tryLoadPackageRawViaLocalDb rlpi) + tryViaLocalDb = MaybeT . tryLoadPackageRawViaLocalDb rlpi warn treeKey'' = do lift $ logWarn $ "Did not find tree key in DB after pulling it from Casa: " diff --git a/src/Pantry/Archive.hs b/src/Pantry/Archive.hs index 0ca7ae86..d246a8ec 100644 --- a/src/Pantry/Archive.hs +++ b/src/Pantry/Archive.hs @@ -15,6 +15,9 @@ module Pantry.Archive import qualified Codec.Archive.Zip as Zip import Conduit + ( ConduitT, (.|), runConduit, sinkHandle, sinkList + , sourceHandle, sourceLazy, withSourceFile + ) import Data.Bits ( (.&.), shiftR ) import qualified Data.Conduit.Tar as Tar import Data.Conduit.Zlib ( ungzip ) @@ -22,19 +25,33 @@ import qualified Data.Digest.CRC32 as CRC32 import Distribution.PackageDescription ( package, packageDescription ) import qualified Hpack.Config as Hpack import Pantry.HPack ( hpackVersion ) -import Pantry.HTTP +import Pantry.HTTP ( httpSinkChecked ) import Pantry.Internal ( makeTarRelative, normalizeParents ) import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage hiding - ( Tree, TreeEntry, findOrGenerateCabalFile ) -import Pantry.Tree +import Pantry.Storage + ( BlobId, CachedTree (..), TreeId, hpackToCabal + , loadArchiveCache, loadBlob, loadCabalBlobKey + , loadCachedTree, loadPackageById, storeArchiveCache + , storeBlob, storeHPack, storeTree, unCachedTree, withStorage + ) +import Pantry.Tree ( rawParseGPD ) import Pantry.Types + ( Archive, ArchiveLocation (..), BlobKey, BuildFile (..) + , FileSize (..), FileType (..), HasPantryConfig + , Mismatch (..), Package (..), PackageCabal (..) + , PackageIdentifier (..), PackageMetadata (..) + , PantryException (..), PHpack (..), RawArchive (..) + , RawPackageLocationImmutable (..), RawPackageMetadata (..) + , ResolvedPath (..), SHA256, Tree (..), TreeEntry (..) + , TreeKey, cabalFileName, hpackSafeFilePath, mkSafeFilePath + , toRawArchive, toRawPM, unSafeFilePath + ) import Path ( toFilePath ) import RIO import qualified RIO.ByteString.Lazy as BL import qualified RIO.List as List import qualified RIO.Map as Map -import RIO.Process +import RIO.Process ( HasProcessContext ) import qualified RIO.Set as Set import qualified RIO.Text as T import qualified RIO.Text.Partial as T diff --git a/src/Pantry/Casa.hs b/src/Pantry/Casa.hs index 11ef21ab..1b0201c0 100644 --- a/src/Pantry/Casa.hs +++ b/src/Pantry/Casa.hs @@ -4,12 +4,14 @@ module Pantry.Casa where +import Database.Persist.Sql ( SqlBackend ) import qualified Casa.Client as Casa import qualified Casa.Types as Casa import Conduit + ( ConduitT, ResourceT, (.|), await, mapMC, runConduitRes ) import qualified Data.HashMap.Strict as HM import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage hiding ( findOrGenerateCabalFile ) +import Pantry.Storage ( storeBlob, withStorage ) import Pantry.Types as P import RIO import qualified RIO.ByteString as B diff --git a/src/Pantry/HTTP.hs b/src/Pantry/HTTP.hs index d86d0370..15058203 100644 --- a/src/Pantry/HTTP.hs +++ b/src/Pantry/HTTP.hs @@ -8,7 +8,7 @@ module Pantry.HTTP , httpSinkChecked ) where -import Conduit +import Conduit ( ConduitT, ZipSink (..), await, getZipSink ) import Network.HTTP.Client as Export ( BodyReader, HttpExceptionContent (StatusCodeException) , parseRequest, parseUrlThrow @@ -28,6 +28,8 @@ import Network.HTTP.Types as Export ) import qualified Pantry.SHA256 as SHA256 import Pantry.Types + ( FileSize (..), Mismatch (..), PantryException (..), SHA256 + ) import RIO import qualified RIO.ByteString as B import qualified RIO.Text as T diff --git a/src/Pantry/Hackage.hs b/src/Pantry/Hackage.hs index 22df0c44..2b0fcc90 100644 --- a/src/Pantry/Hackage.hs +++ b/src/Pantry/Hackage.hs @@ -22,12 +22,20 @@ module Pantry.Hackage ) where import Conduit + ( ZipSink (..), (.|), getZipSink, runConduit, sinkLazy + , sinkList, sourceHandle, takeC, takeCE + ) import Data.Aeson + ( FromJSON (..), Value (..), (.:), eitherDecode' + , withObject + ) import Data.Conduit.Tar + ( FileInfo (..), FileType (..), untar ) import qualified Data.List.NonEmpty as NE import Data.Text.Metrics (damerauLevenshtein) import Data.Text.Unsafe ( unsafeTail ) import Data.Time ( getCurrentTime ) +import Database.Persist.Sql ( SqlBackend ) import Distribution.PackageDescription ( GenericPackageDescription ) import qualified Distribution.PackageDescription as Cabal import qualified Distribution.Text @@ -40,13 +48,34 @@ import qualified Hackage.Security.Client.Repository.Remote as HS import qualified Hackage.Security.Util.Path as HS import qualified Hackage.Security.Util.Pretty as HS import Network.URI ( parseURI ) -import Pantry.Archive -import Pantry.Casa +import Pantry.Archive ( getArchive ) +import Pantry.Casa ( casaLookupKey ) import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage hiding - ( PackageName, TreeEntry, Version, findOrGenerateCabalFile ) -import Pantry.Tree -import Pantry.Types hiding ( FileType (..) ) +import Pantry.Storage + ( CachedTree (..), TreeId, BlobId, clearHackageRevisions + , countHackageCabals, getBlobKey, loadBlobById, loadBlobBySHA + , loadHackagePackageVersion, loadHackagePackageVersions + , loadHackageTarballInfo, loadHackageTree, loadHackageTreeKey + , loadLatestCacheUpdate, loadPreferredVersion + , sinkHackagePackageNames, storeBlob, storeCacheUpdate + , storeHackageRevision, storeHackageTarballInfo + , storeHackageTree, storePreferredVersion, storeTree + , unCachedTree, withStorage + ) +import Pantry.Tree ( rawParseGPD ) +import Pantry.Types + ( ArchiveLocation (..), BlobKey (..), BuildFile (..) + , CabalFileInfo (..), FileSize (..), FuzzyResults (..) + , HackageSecurityConfig (..), HasPantryConfig (..) + , Mismatch (..), Package (..), PackageCabal (..) + , PackageIdentifier (..), PackageIdentifierRevision (..) + , PackageIndexConfig (..), PackageName, PantryConfig (..) + , PantryException (..), RawArchive (..) + , RawPackageLocationImmutable (..), RawPackageMetadata (..) + , Revision, SHA256, Storage (..), TreeEntry (..), TreeKey + , Version, cabalFileName, packageNameString, parsePackageName + , unSafeFilePath + ) import Path ( Abs, Dir, File, Path, Rel, (), parseRelDir, parseRelFile , toFilePath @@ -55,7 +84,7 @@ import RIO import qualified RIO.ByteString as B import qualified RIO.ByteString.Lazy as BL import qualified RIO.Map as Map -import RIO.Process +import RIO.Process ( HasProcessContext ) import qualified RIO.Text as T #if !MIN_VERSION_rio(0,1,16) -- Now provided by RIO from the rio package. Resolvers before lts-15.16 diff --git a/src/Pantry/Repo.hs b/src/Pantry/Repo.hs index 34c270cb..b6e6999c 100644 --- a/src/Pantry/Repo.hs +++ b/src/Pantry/Repo.hs @@ -16,9 +16,20 @@ module Pantry.Repo ) where import Database.Persist ( Entity (..) ) -import Pantry.Archive -import Pantry.Storage hiding ( findOrGenerateCabalFile ) +import Pantry.Archive ( getArchivePackage ) +import Pantry.Storage + ( getTreeForKey, loadPackageById, loadRepoCache + , storeRepoCache, withStorage + ) import Pantry.Types + ( AggregateRepo (..), ArchiveLocation (..), HasPantryConfig + , Package (..), PackageMetadata (..), PantryException (..) + , RawArchive (..), RawPackageLocationImmutable (..) + , RawPackageMetadata (..), RelFilePath (..), Repo (..) + , RepoType (..), ResolvedPath (..), SimpleRepo (..) + , TreeKey (..), arToSimpleRepo, rToSimpleRepo + , toAggregateRepos, toRawPM + ) import Path.IO ( resolveFile' ) import RIO import RIO.ByteString ( isInfixOf ) @@ -27,6 +38,10 @@ import RIO.Directory ( doesDirectoryExist ) import RIO.FilePath ( () ) import qualified RIO.Map as Map import RIO.Process + ( ExitCodeException (..), HasProcessContext, proc + , readProcess, readProcess_, withModifyEnvVars + , withWorkingDir + ) import qualified RIO.Text as T import System.Console.ANSI ( hSupportsANSIWithoutEmulation ) import System.IsWindows ( osIsWindows ) diff --git a/src/Pantry/SQLite.hs b/src/Pantry/SQLite.hs index 2956ff16..4e8f18c5 100644 --- a/src/Pantry/SQLite.hs +++ b/src/Pantry/SQLite.hs @@ -11,6 +11,10 @@ module Pantry.SQLite import Control.Concurrent.Companion ( Companion, onCompanionDone, withCompanion ) import Database.Persist.Sqlite + ( Migration, extraPragmas, fkEnabled, mkSqliteConnectionInfo + , runMigrationSilent, runSqlConn, walEnabled + , withSqliteConnInfo + ) import Pantry.Types ( PantryException (MigrationFailure), Storage (..) ) import Path ( Abs, File, Path, parent, toFilePath ) diff --git a/src/Pantry/Storage.hs b/src/Pantry/Storage.hs index 31a7e224..da6836bb 100644 --- a/src/Pantry/Storage.hs +++ b/src/Pantry/Storage.hs @@ -102,11 +102,26 @@ module Pantry.Storage , unCachedTree ) where -import Conduit +import Conduit ( ConduitT, (.|), concatMapMC, mapC, runConduit ) import Data.Acquire ( with ) -import Database.Persist -import Database.Persist.Sqlite +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 @@ -133,7 +148,7 @@ 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 +import RIO.Process ( HasProcessContext ) import qualified RIO.Text as T import RIO.Time ( UTCTime, getCurrentTime ) diff --git a/src/Pantry/Tree.hs b/src/Pantry/Tree.hs index e46734be..dd011b92 100644 --- a/src/Pantry/Tree.hs +++ b/src/Pantry/Tree.hs @@ -8,10 +8,14 @@ module Pantry.Tree import Distribution.PackageDescription ( GenericPackageDescription ) import Distribution.PackageDescription.Parsec + ( parseGenericPackageDescription, runParseResult ) import Distribution.Parsec ( PWarning (..) ) -import Pantry.Storage hiding - ( Tree, TreeEntry, findOrGenerateCabalFile ) +import Pantry.Storage ( loadBlob, withStorage ) import Pantry.Types + ( FileType (..), HasPantryConfig, PantryException (..) + , RawPackageLocationImmutable, Tree (..), TreeEntry (..) + , unSafeFilePath + ) import Path ( Abs, Dir, File, Path, toFilePath ) import RIO import qualified RIO.ByteString as B