pantry 0.9.2 → 0.9.3

raw patch · 21 files changed

+339/−153 lines, 21 filesdep ~rio-prettyprintPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: rio-prettyprint

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• app/test-pretty-exceptions/Main.hs +12/−12
• int/Pantry/HPack.hs +6/−0
• int/Pantry/SHA256.hs +6/−3
• int/Pantry/Types.hs +38/−15
• pantry.cabal +10/−10
• src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +7/−3
• src/Pantry.hs +107/−56
• src/Pantry/Archive.hs +28/−6
• src/Pantry/Casa.hs +7/−1
• src/Pantry/HTTP.hs +9/−7
• src/Pantry/Hackage.hs +42/−13
• src/Pantry/Repo.hs +18/−3
• src/Pantry/SQLite.hs +7/−2
• src/Pantry/Storage.hs +19/−4
• src/Pantry/Tree.hs +6/−2
• test/Pantry/BuildPlanSpec.hs +0/−2
• test/Pantry/CabalSpec.hs +4/−6
• test/Pantry/CasaSpec.hs +2/−2
• test/Pantry/HackageSpec.hs +2/−2
• test/Pantry/TypesSpec.hs +4/−4

@@ -1,5 +1,10 @@ # Changelog for pantry
 
+## v0.9.3
+
+* Add error S-628 (`LocalNoArchiveFileFound`).
+* Depend on `rio-prettyprint-0.1.7.0`.
+
 ## v0.9.2
 
 * `defaultCasaRepoPrefix` references https://casa.stackage.org, instead of

@@ -161,6 +161,7 @@   , [ DownloadInvalidSHA256 urlExample (Mismatch sha256Example sha256Example) ]
   , [ DownloadInvalidSize urlExample (Mismatch fileSizeExample fileSizeExample) ]
   , [ DownloadTooLarge urlExample (Mismatch fileSizeExample fileSizeExample) ]
+  , [ LocalNoArchiveFileFound pathAbsFileExample ]
   , [ LocalInvalidSHA256 pathAbsFileExample (Mismatch sha256Example sha256Example) ]
   , [ LocalInvalidSize pathAbsFileExample (Mismatch fileSizeExample fileSizeExample) ]
   , [ UnknownArchiveType archiveLocation
@@ -258,16 +259,15 @@ treeKeyExample = TreeKey blobKeyExample
 
 rawPackageLocationImmutableExamples :: [RawPackageLocationImmutable]
-rawPackageLocationImmutableExamples = concat
-  [ [ RPLIHackage packageIdentifierRevision treeKey
-    | packageIdentifierRevision <- packageIdentifierRevisionExamples
-    , treeKey <- [Nothing, Just treeKeyExample]
-    ]
+rawPackageLocationImmutableExamples =
+     [ RPLIHackage packageIdentifierRevision treeKey
+     | packageIdentifierRevision <- packageIdentifierRevisionExamples
+     , treeKey <- [Nothing, Just treeKeyExample]
+     ]
 --, RPLIArchive
-  , [ RPLIRepo repoExample rawPackageMetadata
-    | rawPackageMetadata <- rawPackageMetadataExamples
-    ]
-  ]
+  <> [ RPLIRepo repoExample rawPackageMetadata
+     | rawPackageMetadata <- rawPackageMetadataExamples
+     ]
 
 safeFilePathExamples :: [SafeFilePath]
 safeFilePathExamples =
@@ -286,8 +286,8 @@   , WCGhcjs versionExample versionExample
   ]
 
-data ExceptionExample
-  = ExceptionExample !Text
+newtype ExceptionExample
+  = ExceptionExample Text
   deriving (Show, Typeable)
 
 instance Exception ExceptionExample where
@@ -400,7 +400,7 @@ 
 duplicatePackageNamesExamples :: [(PackageName, [RawPackageLocationImmutable])]
 duplicatePackageNamesExamples = map
-  ((, rawPackageLocationImmutableExamples))
+  (, rawPackageLocationImmutableExamples)
   packageNameExamples
 
 descriptionExample :: Text

@@ -13,11 +13,17 @@ 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)

@@ -39,15 +39,18 @@   , 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
                    ( Bytes32, StaticBytesException, toStaticExact )
-import           Database.Persist.Sql
+import           Database.Persist.Class.PersistField ( PersistField (..) )
+import           Database.Persist.PersistValue ( PersistValue (..) )
+import           Database.Persist.Sql ( PersistFieldSql (..) )
+import           Database.Persist.Types ( SqlType (..) )
 import           RIO
 import qualified RIO.Text as T
 

@@ -125,11 +125,13 @@   ) 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 (..)
@@ -188,8 +190,8 @@ import           RIO.Time ( Day, UTCTime, toGregorian )
 import qualified RIO.Map as Map
 import           RIO.PrettyPrint
-                   ( bulletedList, fillSep, flow, hang, line, mkNarrativeList
-                   , parens, string, style
+                   ( blankLine, bulletedList, fillSep, flow, hang, line
+                   , mkNarrativeList, parens, string, style
                    )
 import           RIO.PrettyPrint.Types ( Style (..) )
 import           Text.PrettyPrint.Leijen.Extended ( Pretty (..), StyleDoc )
@@ -1078,6 +1080,7 @@   | DownloadTooLarge !Text !(Mismatch FileSize)
   -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is
   -- a lower bound on the size from the server.
+  | LocalNoArchiveFileFound !(Path Abs File)
   | LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
   | LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
   | UnknownArchiveType !ArchiveLocation
@@ -1184,8 +1187,9 @@     <> "is not the package name."
   display (NoLocalPackageDirFound dir) =
     "Error: [S-395]\n"
-    <> "Stack looks for packages in the directories configured in\n"
-    <> "the 'packages' and 'extra-deps' fields defined in your stack.yaml\n"
+    <> "Stack looks for packages in the directories configured in the\n"
+    <> "'packages' and 'extra-deps' fields defined in its project-level\n"
+    <> "configuration file (usually stack.yaml)\n"
     <> "The current entry points to "
     <> fromString (toFilePath dir)
     <> ",\nbut no such directory could be found. If, alternatively, a package\n"
@@ -1193,8 +1197,9 @@     <> "specified as an extra-dep."
   display (NoCabalFileFound dir) =
     "Error: [S-636]\n"
-    <> "Stack looks for packages in the directories configured in\n"
-    <> "the 'packages' and 'extra-deps' fields defined in your stack.yaml\n"
+    <> "Stack looks for packages in the directories configured in the\n"
+    <> "'packages' and 'extra-deps' fields defined in its project-level\n"
+    <> "configuration file (usually stack.yaml)\n"
     <> "The current entry points to "
     <> fromString (toFilePath dir)
     <> ",\nbut no .cabal or package.yaml file could be found there."
@@ -1298,6 +1303,14 @@     <> display mismatchExpected
     <> ", stopped after receiving: "
     <> display mismatchActual
+  display (LocalNoArchiveFileFound path) =
+    "Error: [S-628]\n"
+    <> "Stack looks for packages in the archive files configured in the\n"
+    <> "'extra-deps' field defined in its project-level configuration file\n"
+    <> "(usually stack.yaml)\n"
+    <> "An entry points to "
+    <> fromString (toFilePath path)
+    <> ",\nbut no such archive file could be found."
   display (LocalInvalidSHA256 path Mismatch {..}) =
     "Error: [S-834]\n"
     <> "Mismatched SHA256 hash from "
@@ -1539,8 +1552,8 @@          , style Shell "packages"
          , "and"
          , style Shell "extra-deps"
-         , flow "fields defined in your"
-         , style File "stack.yaml" <> "."
+         , flow "fields defined in its project-level configuration file"
+         , parens (fillSep ["usually", style File "stack.yaml"]) <> "."
          , flow "The current entry points to"
          , pretty dir
          , flow "but no such directory could be found. If, alternatively, a"
@@ -1555,8 +1568,8 @@          , style Shell "packages"
          , "and"
          , style Shell "extra-deps"
-         , flow "fields defined in your"
-         , style File "stack.yaml" <> "."
+         , flow "fields defined in its project-level configuration file"
+         , parens (fillSep ["usually", style File "stack.yaml"]) <> "."
          , flow "The current entry points to"
          , pretty dir
          , flow "but no Cabal file or"
@@ -1727,6 +1740,19 @@          , flow "stopped after receiving:"
          , fromString . T.unpack $ textDisplay mismatchActual <> "."
          ]
+  pretty (LocalNoArchiveFileFound path) =
+    "[S-628]"
+    <> line
+    <> fillSep
+         [ flow "Stack looks for packages in the archive files configured in"
+         , "the"
+         , style Shell "extra-deps"
+         , flow "field defined in its project-level configuration file"
+         , parens (fillSep ["usually", style File "stack.yaml"]) <> "."
+         , flow "An entry points to"
+         , pretty path
+         , flow "but no such archive file could be found."
+         ]
   pretty (LocalInvalidSHA256 path Mismatch {..}) =
     "[S-834]"
     <> line
@@ -1961,9 +1987,6 @@          ]
     <> blankLine
     <> string (displayException err)
-
-blankLine :: StyleDoc
-blankLine = line <> line
 
 data FuzzyResults
   = FRNameNotFound ![PackageName]

@@ -1,11 +1,11 @@ cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           pantry
-version:        0.9.2
+version:        0.9.3
 synopsis:       Content addressable Haskell package management
 description:    Please see the README on GitHub at <https://github.com/commercialhaskell/pantry#readme>
 category:       Development
@@ -51,7 +51,7 @@       Pantry.SHA256
   hs-source-dirs:
       src/
-  ghc-options: -Wall
+  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall
   build-depends:
       Cabal >=3 && <3.11
     , aeson
@@ -90,7 +90,7 @@     , resourcet
     , rio
     , rio-orphans
-    , rio-prettyprint
+    , rio-prettyprint >=0.1.7.0
     , static-bytes
     , tar-conduit >=0.4.0
     , text
@@ -130,7 +130,7 @@       Paths_pantry
   hs-source-dirs:
       int/
-  ghc-options: -Wall
+  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall
   build-depends:
       Cabal >=3 && <3.11
     , aeson
@@ -168,7 +168,7 @@     , resourcet
     , rio
     , rio-orphans
-    , rio-prettyprint
+    , rio-prettyprint >=0.1.7.0
     , static-bytes
     , tar-conduit >=0.4.0
     , text
@@ -194,7 +194,7 @@       Paths_pantry
   hs-source-dirs:
       app/test-pretty-exceptions
-  ghc-options: -Wall
+  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall
   build-depends:
       Cabal >=3 && <3.11
     , aeson
@@ -234,7 +234,7 @@     , resourcet
     , rio
     , rio-orphans
-    , rio-prettyprint
+    , rio-prettyprint >=0.1.7.0
     , static-bytes
     , tar-conduit >=0.4.0
     , text
@@ -288,7 +288,7 @@       Paths_pantry
   hs-source-dirs:
       test
-  ghc-options: -Wall
+  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall
   build-tool-depends:
       hspec-discover:hspec-discover
   build-depends:
@@ -335,7 +335,7 @@     , resourcet
     , rio
     , rio-orphans
-    , rio-prettyprint
+    , rio-prettyprint >=0.1.7.0
     , static-bytes
     , tar-conduit >=0.4.0
     , text

@@ -10,15 +10,19 @@   ( 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
 
 {-------------------------------------------------------------------------------

@@ -196,9 +196,14 @@   ) 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' )
+import           Control.Monad.Trans.Maybe ( MaybeT (..) )
+#if MIN_VERSION_transformers(0,6,0)
+import           Control.Monad.Trans.Maybe ( hoistMaybe )
+#endif
 import           Data.Aeson.Types ( Value, parseEither )
 import           Data.Aeson.WarningParser ( WithJSONWarnings (..) )
 #if !MIN_VERSION_rio(0,1,17)
@@ -209,7 +214,7 @@ 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
@@ -218,17 +223,66 @@ 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
@@ -240,14 +294,22 @@ import qualified RIO.FilePath as FilePath
 import qualified RIO.List as List
 import qualified RIO.Map as Map
-import           RIO.PrettyPrint
+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
 import           System.IO.Error ( isDoesNotExistError )
 
+#if !MIN_VERSION_transformers(0,6,0)
+-- | Convert a 'Maybe' computation to 'MaybeT'.
+hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b
+hoistMaybe = MaybeT . pure
+#endif
+
 decodeYaml :: FilePath -> IO (Either String ([String], Value))
 decodeYaml file = do
   bimap displayException (first formatWarnings) <$> decodeFileWithWarnings file
@@ -956,23 +1018,18 @@   => RawPackageLocationImmutable
   -> TreeKey
   -> RIO env (Maybe Package)
-tryLoadPackageRawViaDbOrCasa rpli treeKey' = do
-  mviaDb <- tryLoadPackageRawViaLocalDb rpli treeKey'
-  case mviaDb of
-    Just package -> do
-      logDebug ("Loaded package from Pantry: " <> display rpli)
-      pure (Just package)
-    Nothing -> do
-      mCasaConfig <- view $ pantryConfigL . to pcCasaConfig
-      case mCasaConfig of
-        Nothing -> pure Nothing
-        Just _ -> do
-          mviaCasa <- tryLoadPackageRawViaCasa rpli treeKey'
-          case mviaCasa of
-            Just package -> do
-              logDebug ("Loaded package from Casa: " <> display rpli)
-              pure (Just package)
-            Nothing -> pure Nothing
+tryLoadPackageRawViaDbOrCasa rpli treeKey' = runMaybeT $
+  tryViaLocalDb <|> tryCasa
+ where
+  tryViaLocalDb = do
+    package <- MaybeT $ tryLoadPackageRawViaLocalDb rpli treeKey'
+    lift $ logDebug ("Loaded package from Pantry: " <> display rpli)
+    pure package
+  tryCasa = do
+    void $ MaybeT $ view $ pantryConfigL . to pcCasaConfig
+    package <- MaybeT $ tryLoadPackageRawViaCasa rpli treeKey'
+    lift $ logDebug ("Loaded package from Casa: " <> display rpli)
+    pure package
 
 -- | Maybe load the package from Casa.
 tryLoadPackageRawViaCasa ::
@@ -980,23 +1037,20 @@   => RawPackageLocationImmutable
   -> TreeKey
   -> RIO env (Maybe Package)
-tryLoadPackageRawViaCasa rlpi treeKey' = do
-  mtreePair <- casaLookupTree treeKey'
-  case mtreePair of
-    Nothing -> pure Nothing
-    Just (treeKey'', _tree) -> do
-      fetchTreeKeys [rlpi]
-      mdb <- tryLoadPackageRawViaLocalDb rlpi treeKey''
-      case mdb of
-        Nothing -> do
-          logWarn
-            ("Did not find tree key in DB after pulling it from Casa: " <>
-             display treeKey'' <>
-             " (for " <>
-             display rlpi <>
-             ")")
-          pure Nothing
-        Just package -> pure (Just package)
+tryLoadPackageRawViaCasa rlpi treeKey' = runMaybeT $ do
+  (treeKey'', _) <- MaybeT $ casaLookupTree treeKey'
+  lift $ fetchTreeKeys [rlpi]
+  tryViaLocalDb treeKey'' <|> warn treeKey''
+ where
+  tryViaLocalDb = MaybeT . tryLoadPackageRawViaLocalDb rlpi
+  warn treeKey'' = do
+    lift $ logWarn $
+         "Did not find tree key in DB after pulling it from Casa: "
+      <> display treeKey''
+      <> " (for "
+      <> display rlpi
+      <> ")"
+    empty
 
 -- | Maybe load the package from the local database.
 tryLoadPackageRawViaLocalDb ::
@@ -1004,12 +1058,9 @@   => RawPackageLocationImmutable
   -> TreeKey
   -> RIO env (Maybe Package)
-tryLoadPackageRawViaLocalDb rlpi treeKey' = do
-  mtreeEntity <- withStorage (getTreeForKey treeKey')
-  case mtreeEntity of
-    Nothing -> pure Nothing
-    Just treeId ->
-      fmap Just (withStorage (loadPackageById rlpi (entityKey treeId)))
+tryLoadPackageRawViaLocalDb rlpi treeKey' = runMaybeT $ do
+  treeId <- MaybeT $ withStorage (getTreeForKey treeKey')
+  lift $ withStorage (loadPackageById rlpi (entityKey treeId))
 
 -- | Complete package location, plus whether the package has a cabal file. This
 -- is relevant to reproducibility, see
@@ -1483,13 +1534,13 @@   => Map RawPackageLocationImmutable PackageLocationImmutable
   -> RawPackageLocationImmutable
   -> RIO env (Maybe PackageLocationImmutable)
-cachedSnapshotCompletePackageLocation cachePackages rpli = do
-  let xs = Map.lookup rpli cachePackages
-  case xs of
-    Nothing -> do
-      cpl <- completePackageLocation rpli
-      pure $ if cplHasCabalFile cpl then Just (cplComplete cpl) else Nothing
-    Just x -> pure $ Just x
+cachedSnapshotCompletePackageLocation cachePackages rpli = runMaybeT $
+  tryCache <|> tryCpl
+ where
+  tryCache = hoistMaybe $ Map.lookup rpli cachePackages
+  tryCpl = do
+    cpl <- lift $ completePackageLocation rpli
+    if cplHasCabalFile cpl then pure (cplComplete cpl) else empty
 
 -- | Add more packages to a snapshot completing their locations if needed
 --

@@ -15,6 +15,9 @@ 
 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,34 @@ 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           Path.IO ( doesFileExist )
 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
@@ -219,7 +237,8 @@    in if and tests then Right pa else Left err
 
 -- | Provide a local file with the contents of the archive, regardless of where
--- it comes from. Perform SHA256 and file size validation if downloading.
+-- it comes from. If not downloading, checks that the archive file exists.
+-- Performs SHA256 and file size validation.
 withArchiveLoc ::
      HasLogFunc env
   => RawArchive
@@ -228,6 +247,9 @@ withArchiveLoc (RawArchive (ALFilePath resolved) msha msize _subdir) f = do
   let abs' = resolvedAbsolute resolved
       fp = toFilePath abs'
+  archiveExists <- doesFileExist abs'
+  unless archiveExists $
+    throwIO $ LocalNoArchiveFileFound abs'
   (sha, size) <- withBinaryFile fp ReadMode $ \h -> do
     size <- FileSize . fromIntegral <$> hFileSize h
     for_ msize $ \size' ->

@@ -4,13 +4,19 @@ 
 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
+                   ( BlobKey (..), FileSize (..), HasPantryConfig (..)
+                   , PantryConfig (..), PantryException (..), Tree, TreeKey (..)
+                   , parseTreeM
+                   )
 import           RIO
 import qualified RIO.ByteString as B
 

@@ -8,7 +8,7 @@   , 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 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
@@ -35,8 +37,8 @@ setUserAgent :: Request -> Request
 setUserAgent = setRequestHeader "User-Agent" ["Haskell pantry package"]
 
-withResponse
-  :: MonadUnliftIO m
+withResponse ::
+     MonadUnliftIO m
   => HTTP.Request
   -> (Response BodyReader -> m a)
   -> m a
@@ -44,15 +46,15 @@   manager <- getGlobalManager
   HTTP.withResponse (setUserAgent req) manager (run . inner)
 
-httpSink
-  :: MonadUnliftIO m
+httpSink ::
+     MonadUnliftIO m
   => Request
   -> (Response () -> ConduitT ByteString Void m a)
   -> m a
 httpSink req = HTTP.httpSink (setUserAgent req)
 
-httpSinkChecked
-  :: MonadUnliftIO m
+httpSinkChecked ::
+     MonadUnliftIO m
   => Text
   -> Maybe SHA256
   -> Maybe FileSize

@@ -22,12 +22,20 @@   ) 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.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 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
@@ -102,8 +131,8 @@ -- sanity. See the return value to find out if it happened.
 --
 -- @since 0.1.0.0
-updateHackageIndex
-  :: (HasPantryConfig env, HasLogFunc env)
+updateHackageIndex ::
+     (HasPantryConfig env, HasLogFunc env)
   => Maybe Utf8Builder -- ^ reason for updating, if any
   -> RIO env DidUpdateOccur
 updateHackageIndex = updateHackageIndexInternal False
@@ -113,15 +142,15 @@ -- sure the database is in sync with the locally downloaded tarball
 --
 -- @since 0.1.0.0
-forceUpdateHackageIndex
-  :: (HasPantryConfig env, HasLogFunc env)
+forceUpdateHackageIndex ::
+     (HasPantryConfig env, HasLogFunc env)
   => Maybe Utf8Builder
   -> RIO env DidUpdateOccur
 forceUpdateHackageIndex = updateHackageIndexInternal True
 
 
-updateHackageIndexInternal
-  :: (HasPantryConfig env, HasLogFunc env)
+updateHackageIndexInternal ::
+     (HasPantryConfig env, HasLogFunc env)
   => Bool -- ^ Force the database update.
   -> Maybe Utf8Builder -- ^ reason for updating, if any
   -> RIO env DidUpdateOccur

@@ -15,10 +15,21 @@   , withRepo
   ) where
 
-import           Database.Persist ( Entity (..) )
-import           Pantry.Archive
-import           Pantry.Storage hiding ( findOrGenerateCabalFile )
+import           Database.Persist.Class.PersistEntity ( Entity (..) )
+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.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 )

@@ -10,9 +10,14 @@ 
 import           Control.Concurrent.Companion
                    ( Companion, onCompanionDone, withCompanion )
+import           Database.Persist.Sql ( runSqlConn )
+import           Database.Persist.Sql.Migration
+                   ( Migration, runMigrationSilent )
 import           Database.Persist.Sqlite
-import           Pantry.Types
-                   ( PantryException (MigrationFailure), Storage (..) )
+                   ( extraPragmas, fkEnabled, mkSqliteConnectionInfo
+                   , walEnabled, withSqliteConnInfo
+                   )
+import           Pantry.Types ( PantryException (..), Storage (..) )
 import           Path ( Abs, File, Path, parent, toFilePath )
 import           Path.IO ( ensureDir )
 import           RIO hiding ( FilePath )

@@ -102,11 +102,26 @@   , 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.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 )
 

@@ -8,10 +8,14 @@ 
 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

@@ -3,10 +3,8 @@ 
 module Pantry.BuildPlanSpec where
 
-import           Control.Monad.Catch ( MonadThrow )
 import           Data.Aeson.WarningParser ( WithJSONWarnings(..) )
 import qualified Data.ByteString.Char8 as S8
-import           Data.List.NonEmpty ( NonEmpty )
 import           Data.Yaml ( decodeThrow )
 import           Pantry
 import           RIO

@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Pantry.CabalSpec
@@ -32,8 +33,7 @@         version2 = mkVersion [0, 2]
         version3 = mkVersion [0, 3]
         size = FileSize 597
-    go `shouldThrow'` \e ->
-      case e of
+    go `shouldThrow'` \case
         MismatchedPackageMetadata rpli' rpm _tree ident ->
           rpli == rpli' &&
           rpm == RawPackageMetadata
@@ -64,8 +64,7 @@         go = loadCabalFileRawImmutable rpli
         acmeMissiles = mkPackageName "acme-missiles"
         version2 = mkVersion [0, 2]
-    go `shouldThrow'` \e ->
-      case e of
+    go `shouldThrow'` \case
         MismatchedPackageMetadata rpli' rpm' _treeKey ident ->
           rpli == rpli' &&
           rpm == rpm' &&
@@ -94,8 +93,7 @@         yesodAuth = mkPackageName "yesod-auth"
         version = mkVersion [1, 6, 4, 1]
         badVersion = mkVersion [1, 6, 4, 0]
-    go `shouldThrow'` \e ->
-      case e of
+    go `shouldThrow'` \case
         MismatchedPackageMetadata rpli' rpm' _treeKey ident ->
           rpli == rpli' &&
           rpm == rpm' &&

@@ -66,11 +66,11 @@ 
 unliftio_0_2_12 :: Args
 unliftio_0_2_12 =
-  let cabalHash = (either
+  let cabalHash = either
                      (error . show)
                      id
                      (fromHexText
-                        "b089fbc2ff2628a963c2c4b12143f2020874e3e5144ffd6c62b25639a0ca1483"))
+                        "b089fbc2ff2628a963c2c4b12143f2020874e3e5144ffd6c62b25639a0ca1483")
       cabalLen = FileSize 3325
       cabalFileHash =
         CFIHash

@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Pantry.HackageSpec
@@ -16,8 +17,7 @@   it "fuzzy lookup kicks in" $ do
     let pir = PackageIdentifierRevision "thisisnot-tobe-foundon-hackage-please" (mkVersion [1..3]) CFILatest
     runPantryApp (loadPackageRaw (RPLIHackage pir Nothing))
-      `shouldThrow` \e ->
-        case e of
+      `shouldThrow` \case
           UnknownHackagePackage pir' _  -> pir == pir'
           _ -> False
   -- Flaky test, can be broken by new packages on Hackage.

@@ -34,7 +34,7 @@   unless result $ throwString "Hedgehog property failed" :: IO ()
 
 genBlobKey :: Gen BlobKey
-genBlobKey = BlobKey <$> genSha256 <*> (FileSize <$> (Gen.word (Range.linear 1 10000)))
+genBlobKey = BlobKey <$> genSha256 <*> (FileSize <$> Gen.word (Range.linear 1 10000))
 
 genSha256 :: Gen SHA256
 genSha256 = SHA256.hashBytes <$> Gen.bytes (Range.linear 1 500)
@@ -109,13 +109,13 @@       RawSnapshotLayer{..} <- parseSl $
         "name: 'test'\n" ++
         "resolver: lts-2.10\n"
-      rslParent `shouldBe` (RSLSynonym $ LTS 2 10)
+      rslParent `shouldBe` RSLSynonym (LTS 2 10)
 
     it "parses snapshot using 'snapshot'" $ do
       RawSnapshotLayer{..} <- parseSl $
         "name: 'test'\n" ++
         "snapshot: lts-2.10\n"
-      rslParent `shouldBe` (RSLSynonym $ LTS 2 10)
+      rslParent `shouldBe` RSLSynonym (LTS 2 10)
 
     it "throws if both 'resolver' and 'snapshot' are present" $ do
       let go = parseSl $
@@ -190,7 +190,7 @@         Right sha' -> pure sha'
         _ -> fail "parseHackagetext: failed decoding the sha256"
       let Right (pkgIdentifier, blobKey) = parseHackageText txt
-      blobKey `shouldBe` (BlobKey sha (FileSize 5058))
+      blobKey `shouldBe` BlobKey sha (FileSize 5058)
       pkgIdentifier `shouldBe`
           PackageIdentifier
               (mkPackageName "persistent")