pantry 0.8.3 → 0.9.0

raw patch · 22 files changed

+4177/−4755 lines, 22 filesdep +aeson-warning-parserdep +companiondep +static-bytesPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-warning-parser, companion, static-bytes

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• app/test-pretty-exceptions/Main.hs +1/−0
• int/Pantry/HPack.hs +81/−0
• int/Pantry/Internal.hs +69/−0
• int/Pantry/SHA256.hs +198/−0
• int/Pantry/SQLite.hs +116/−0
• int/Pantry/Types.hs +3339/−0
• pantry.cabal +354/−275
• src/Pantry.hs +2/−2
• src/Pantry/HPack.hs +0/−81
• src/Pantry/Internal.hs +0/−85
• src/Pantry/Internal/AesonExtended.hs +0/−268
• src/Pantry/Internal/Companion.hs +0/−80
• src/Pantry/Internal/StaticBytes.hs +0/−244
• src/Pantry/SHA256.hs +0/−197
• src/Pantry/SQLite.hs +0/−115
• src/Pantry/Types.hs +0/−3320
• test/Pantry/BuildPlanSpec.hs +1/−1
• test/Pantry/GlobalHintsSpec.hs +1/−1
• test/Pantry/Internal/StaticBytesSpec.hs +0/−79
• test/Pantry/InternalSpec.hs +2/−2
• test/Pantry/TypesSpec.hs +3/−5

@@ -1,5 +1,15 @@ # Changelog for pantry
 
+## v0.9.0
+
+* Remove module `Pantry.Internal.AesonExtended` and depend on
+  `aeson-warning-parser` package.
+* Remove module `Pantry.Internal.Companion` and depend on `companion` package.
+* Remove module `Pantry.Internal.StaticBytes` and depend on `static-bytes`
+  package.
+* Remove module `Pantry.Internal`, previously exposed only for testing.
+* Update Hackage bootstrap root key set.
+
 ## v0.8.3
 
 * Expose `withPantryConfig'`, which allows for optional use of Casa.

@@ -197,6 +197,7 @@   , [ InvalidCabalFilePath pathAbsFileExample ]
   , [ DuplicatePackageNames sourceMsgExample duplicatePackageNamesExamples ]
   , [ MigrationFailure descriptionExample pathAbsFileExample someExceptionExample ]
+  , [ NoCasaConfig ]
   , [ InvalidTreeFromCasa blobKeyExample blobExample ]
   , [ ParseSnapNameException rawSnapNameExample ]
   , [ HpackLibraryException pathAbsFileExample errorMessageExample ]

@@ -0,0 +1,81 @@+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Pantry.HPack
+  ( hpack
+  , hpackVersion
+  ) where
+
+import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Char ( isDigit, isSpace )
+import qualified Hpack
+import qualified Hpack.Config as Hpack
+import           Pantry.Types
+import           Path
+                   ( Abs, Dir, Path, (</>), filename, parseRelFile, toFilePath )
+import           Path.IO ( doesFileExist )
+import           RIO
+import           RIO.Process
+
+hpackVersion ::
+     (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
+  => RIO env Version
+hpackVersion = do
+  he <- view $ pantryConfigL.to pcHpackExecutable
+  case he of
+    HpackBundled -> do
+      let bundledHpackVersion :: String = VERSION_hpack
+      parseVersionThrowing bundledHpackVersion
+    HpackCommand command -> do
+      version <- BL.unpack <$> proc command ["--version"] readProcessStdout_
+      let version' = dropWhile (not . isDigit) version
+          version'' = filter (not . isSpace) version'
+      parseVersionThrowing version''
+
+-- | Generate .cabal file from package.yaml, if necessary.
+hpack ::
+     (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
+  => Path Abs Dir
+  -> RIO env ()
+hpack pkgDir = do
+  packageConfigRelFile <- parseRelFile Hpack.packageConfig
+  let hpackFile = pkgDir Path.</> packageConfigRelFile
+  whenM (doesFileExist hpackFile) $ do
+    logDebug $ "Running hpack on " <> fromString (toFilePath hpackFile)
+    he <- view $ pantryConfigL.to pcHpackExecutable
+    case he of
+      HpackBundled -> do
+        r <- liftIO $ Hpack.hpackResult $ Hpack.setProgramName "stack" $
+          Hpack.setTarget (toFilePath hpackFile) Hpack.defaultOptions
+        forM_ (Hpack.resultWarnings r) (logWarn . fromString)
+        let cabalFile = fromString . Hpack.resultCabalFile $ r
+        case Hpack.resultStatus r of
+          Hpack.Generated -> logDebug $
+               "hpack generated a modified version of "
+            <> cabalFile
+          Hpack.OutputUnchanged -> logDebug $
+               "hpack output unchanged in "
+            <> cabalFile
+          Hpack.AlreadyGeneratedByNewerHpack -> logWarn $
+               cabalFile
+            <> " was generated with a newer version of hpack. Ignoring "
+            <> fromString (toFilePath hpackFile)
+            <> " in favor of the Cabal file.\n"
+            <> "Either please upgrade and try again or, if you want to use the "
+            <> fromString (toFilePath (filename hpackFile))
+            <> " file instead of the Cabal file,\n"
+            <> "then please delete the Cabal file."
+          Hpack.ExistingCabalFileWasModifiedManually -> logWarn $
+               cabalFile
+            <> " was modified manually. Ignoring "
+            <> fromString (toFilePath hpackFile)
+            <> " in favor of the Cabal file.\n"
+            <> "If you want to use the "
+            <> fromString (toFilePath (filename hpackFile))
+            <> " file instead of the Cabal file,\n"
+            <> "then please delete the Cabal file."
+      HpackCommand command ->
+        withWorkingDir (toFilePath pkgDir) $
+        proc command [] runProcess_

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Pantry.Internal
+  ( normalizeParents
+  , makeTarRelative
+  ) where
+
+import           Control.Exception ( assert )
+import           Data.Maybe ( fromMaybe )
+import qualified Data.Text as T
+
+-- | Like @System.FilePath.normalise@, however:
+--
+-- * Only works on relative paths, absolute paths fail
+--
+-- * Strips trailing slashes
+--
+-- * Only works on forward slashes, even on Windows
+--
+-- * Normalizes parent dirs @foo/../@ get stripped
+--
+-- * Cannot begin with a parent directory (@../@)
+--
+-- * Spelled like an American, sorry
+normalizeParents ::
+     FilePath
+  -> Either String FilePath
+normalizeParents "" = Left "empty file path"
+normalizeParents ('/':_) = Left "absolute path"
+normalizeParents ('.':'.':'/':_) = Left "absolute path"
+normalizeParents fp = do
+  -- Strip a single trailing, but not multiple
+  let t0 = T.pack fp
+      t = fromMaybe t0 $ T.stripSuffix "/" t0
+  case T.unsnoc t of
+    Just (_, '/') -> Left "multiple trailing slashes"
+    _ -> Right ()
+
+  let c1 = T.split (== '/') t
+
+  case reverse c1 of
+    ".":_ -> Left "last component is a single dot"
+    _ -> Right ()
+
+  let c2 = filter (\x -> not (T.null x || x == ".")) c1
+
+  let loop [] routput = reverse routput
+      loop ("..":rest) (_:routput) = loop rest routput
+      loop (x:xs) routput = loop xs (x:routput)
+
+  case loop c2 [] of
+    [] -> Left "no non-empty components"
+    c' -> Right $ T.unpack $ T.intercalate "/" c'
+
+-- | Following tar file rules (Unix file paths only), make the second file
+-- relative to the first file.
+makeTarRelative ::
+     FilePath -- ^ base file
+  -> FilePath -- ^ relative part
+  -> Either String FilePath
+makeTarRelative _ ('/':_) = Left "absolute path found"
+makeTarRelative base rel =
+  case reverse base of
+    [] -> Left "cannot have empty base"
+    '/':_ -> Left "base cannot be a directory"
+    _:rest -> Right $
+      case dropWhile (/= '/') rest of
+        '/':rest' -> reverse rest' ++ '/' : rel
+        rest' -> assert (null rest') rel

@@ -0,0 +1,198 @@+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+-- | Provides a data type ('SHA256') for efficient memory representation of a
+-- sha-256 hash value, together with helper functions for converting to and from
+-- that value. This module is intended to be imported qualified as @SHA256@.
+--
+-- Some nomenclature:
+--
+-- * Hashing calculates a new hash value from some input. @from@ takes a value
+--   that represents an existing hash.
+--
+-- * Raw means a raw binary representation of the hash value, without any hex
+--   encoding.
+--
+-- * Text always uses lower case hex encoding
+--
+-- @since 0.1.0.0
+module Pantry.SHA256
+  ( -- * Types
+    SHA256
+  , SHA256Exception (..)
+    -- * Hashing
+  , hashFile
+  , hashBytes
+  , hashLazyBytes
+  , sinkHash
+    -- * Convert from a hash representation
+  , fromHexText
+  , fromHexBytes
+  , fromDigest
+  , fromRaw
+    -- * Convert to a hash representation
+  , toHexText
+  , toHexBytes
+  , toRaw
+  ) where
+
+import           Conduit
+import qualified Crypto.Hash as Hash ( Digest, SHA256, hash, hashlazy )
+import qualified Crypto.Hash.Conduit as Hash ( hashFile, sinkHash )
+import           Data.Aeson
+import qualified Data.ByteArray
+import qualified Data.ByteArray.Encoding as Mem
+import           Data.StaticBytes
+                   ( Bytes32, StaticBytesException, toStaticExact )
+import           Database.Persist.Sql
+import           RIO
+import qualified RIO.Text as T
+
+-- | A SHA256 hash, stored in a static size for more efficient
+-- memory representation.
+--
+-- @since 0.1.0.0
+newtype SHA256 = SHA256 Bytes32
+  deriving (Generic, Eq, NFData, Data, Typeable, Ord, Hashable)
+
+-- | Exceptions which can occur in this module
+--
+-- @since 0.1.0.0
+data SHA256Exception
+  = InvalidByteCount !ByteString !StaticBytesException
+  | InvalidHexBytes !ByteString !Text
+  deriving (Typeable)
+
+-- | Generate a 'SHA256' value by hashing the contents of a file.
+--
+-- @since 0.1.0.0
+hashFile :: MonadIO m => FilePath -> m SHA256
+hashFile fp = fromDigest <$> Hash.hashFile fp
+
+-- | Generate a 'SHA256' value by hashing a @ByteString@.
+--
+-- @since 0.1.0.0
+hashBytes :: ByteString -> SHA256
+hashBytes = fromDigest . Hash.hash
+
+-- | Generate a 'SHA256' value by hashing a lazy @ByteString@.
+--
+-- @since 0.1.0.0
+hashLazyBytes :: LByteString -> SHA256
+hashLazyBytes = fromDigest . Hash.hashlazy
+
+-- | Generate a 'SHA256' value by hashing the contents of a stream.
+--
+-- @since 0.1.0.0
+sinkHash :: Monad m => ConduitT ByteString o m SHA256
+sinkHash = fromDigest <$> Hash.sinkHash
+
+-- | Convert a base16-encoded 'Text' value containing a hash into a 'SHA256'.
+--
+-- @since 0.1.0.0
+fromHexText :: Text -> Either SHA256Exception SHA256
+fromHexText = fromHexBytes . encodeUtf8
+
+-- | Convert a base16-encoded 'ByteString' value containing a hash into a
+-- 'SHA256'.
+--
+-- @since 0.1.0.0
+fromHexBytes :: ByteString -> Either SHA256Exception SHA256
+fromHexBytes hexBS = do
+  mapLeft (InvalidHexBytes hexBS . T.pack) (Mem.convertFromBase Mem.Base16 hexBS) >>= fromRaw
+
+-- | Convert a 'Hash.Digest' into a 'SHA256'
+--
+-- @since 0.1.0.0
+fromDigest :: Hash.Digest Hash.SHA256 -> SHA256
+fromDigest digest =
+  case toStaticExact (Data.ByteArray.convert digest :: ByteString) of
+    Left e -> error $ "Impossible failure in fromDigest: " ++ show (digest, e)
+    Right x -> SHA256 x
+
+-- | Convert a raw representation of a hash into a 'SHA256'.
+--
+-- @since 0.1.0.0
+fromRaw :: ByteString -> Either SHA256Exception SHA256
+fromRaw bs =
+  either (Left . InvalidByteCount bs) (Right . SHA256) (toStaticExact bs)
+
+-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
+--
+-- @since 0.1.0.0
+toHexText :: SHA256 -> Text
+toHexText ss =
+  case decodeUtf8' $ toHexBytes ss of
+    Left e ->
+      error $ "Impossible failure in staticSHA256ToText: " ++ show (ss, e)
+    Right t -> t
+
+-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
+--
+-- @since 0.1.0.0
+toHexBytes :: SHA256 -> ByteString
+toHexBytes (SHA256 x) = Mem.convertToBase Mem.Base16 x
+
+-- | Convert a 'SHA256' into a raw binary representation.
+--
+-- @since 0.1.0.0
+toRaw :: SHA256 -> ByteString
+toRaw (SHA256 x) = Data.ByteArray.convert x
+
+-- Instances
+
+instance Show SHA256 where
+  show s = "SHA256 " ++ show (toHexText s)
+
+instance PersistField SHA256 where
+  toPersistValue = PersistByteString . toRaw
+  fromPersistValue (PersistByteString bs) =
+    case toStaticExact bs of
+      Left e -> Left $ tshow e
+      Right ss -> pure $ SHA256 ss
+  fromPersistValue x = Left $ "Unexpected value: " <> tshow x
+
+instance PersistFieldSql SHA256 where
+  sqlType _ = SqlBlob
+
+instance Display SHA256 where
+  display = displayBytesUtf8 . toHexBytes
+
+instance ToJSON SHA256 where
+  toJSON = toJSON . toHexText
+instance FromJSON SHA256 where
+  parseJSON = withText "SHA256" $ \t ->
+    case fromHexText t of
+      Right x -> pure x
+      Left e -> fail $ concat
+        [ "Invalid SHA256 "
+        , show t
+        , ": "
+        , show e
+        ]
+
+instance Exception SHA256Exception
+instance Show SHA256Exception where
+  show = T.unpack . utf8BuilderToText . display
+
+-- To support the Haskell Foundation's
+-- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry
+-- error messages generated by Pantry itself begin with an unique code in the
+-- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.
+-- The numbers are selected at random, not in sequence.
+instance Display SHA256Exception where
+  display (InvalidByteCount bs sbe) =
+    "Error: [S-161]\n"
+    <> "Invalid byte count creating a SHA256 from "
+    <> displayShow bs
+    <> ": "
+    <> displayShow sbe
+  display (InvalidHexBytes bs t) =
+    "Error: [S-165]\n"
+    <> "Invalid hex bytes creating a SHA256: "
+    <> displayShow bs
+    <> ": "
+    <> display t

@@ -0,0 +1,116 @@+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Pantry.SQLite
+  ( Storage (..)
+  , initStorage
+  ) where
+
+import           Control.Concurrent.Companion
+                   ( Companion, onCompanionDone, withCompanion )
+import           Database.Persist.Sqlite
+import           Pantry.Types
+                   ( PantryException (MigrationFailure), Storage (..) )
+import           Path ( Abs, File, Path, parent, toFilePath )
+import           Path.IO ( ensureDir )
+import           RIO hiding ( FilePath )
+import           RIO.Orphans ()
+import           System.FileLock
+                   ( SharedExclusive (..), withFileLock, withTryFileLock )
+
+initStorage ::
+     HasLogFunc env
+  => Text
+  -> Migration
+  -> Path Abs File -- ^ storage file
+  -> (Storage -> RIO env a)
+  -> RIO env a
+initStorage description migration fp inner = do
+  ensureDir $ parent fp
+
+  migrates <- withWriteLock (display description) fp $ wrapMigrationFailure $
+    withSqliteConnInfo (sqinfo True) $ runSqlConn $
+    runMigrationSilent migration
+  forM_ migrates $ \mig -> logDebug $ "Migration executed: " <> display mig
+
+  -- Make a single connection to the SQLite database and wrap it in an MVar for
+  -- the entire execution context. Previously we used a resource pool of size
+  -- 1, but (1) there's no advantage to that, and (2) it had a _very_ weird
+  -- interaction with Docker on OS X where when resource-pool's reaper would
+  -- trigger, it would somehow cause the Stack process inside the container to
+  -- die with a SIGBUS. Definitely an interesting thing worth following up
+  -- on...
+  withSqliteConnInfo (sqinfo False) $ \conn0 -> do
+    connVar <- newMVar conn0
+    inner $ Storage
+      -- NOTE: Currently, we take a write lock on every action. This is
+      -- a bit heavyweight, but it avoids the SQLITE_BUSY errors
+      -- reported in
+      -- <https://github.com/commercialhaskell/stack/issues/4471>
+      -- completely. We can investigate more elegant solutions in the
+      -- future, such as separate read and write actions or introducing
+      -- smarter retry logic.
+      { withStorage_ = \action -> withMVar connVar $ \conn ->
+                       withWriteLock (display description) fp $
+                       runSqlConn action conn
+      , withWriteLock_ = id
+      }
+ where
+  wrapMigrationFailure = handleAny (throwIO . MigrationFailure description fp)
+
+  sqinfo isMigration
+    = set extraPragmas ["PRAGMA busy_timeout=2000;"]
+    $ set walEnabled False
+
+    -- When doing a migration, we want to disable foreign key checking, since
+    -- the order in which tables are created by the migration scripts may not
+    -- respect foreign keys. The rest of the time: enforce those foreign keys.
+    $ set fkEnabled (not isMigration)
+
+    $ mkSqliteConnectionInfo (fromString $ toFilePath fp)
+
+-- | Ensure that only one process is trying to write to the database at a time.
+-- See https://github.com/commercialhaskell/stack/issues/4471 and comments
+-- above.
+withWriteLock ::
+     HasLogFunc env
+  => Utf8Builder -- ^ database description, for lock messages
+  -> Path Abs File -- ^ SQLite database file
+  -> RIO env a
+  -> RIO env a
+withWriteLock desc dbFile inner = do
+  let lockFile = toFilePath dbFile ++ ".pantry-write-lock"
+  withRunInIO $ \run -> do
+    mres <- withTryFileLock lockFile Exclusive $ const $ run inner
+    case mres of
+      Just res -> pure res
+      Nothing -> do
+        let complainer :: Companion IO
+            complainer delay = run $ do
+              -- Wait five seconds before giving the first message to
+              -- avoid spamming the user for uninteresting file locks
+              delay $ 5 * 1000 * 1000 -- 5 seconds
+              logInfo $
+                   "Unable to get a write lock on the "
+                <> desc
+                <> " database, waiting..."
+
+              -- Now loop printing a message every 1 minute
+              forever $ do
+                delay (60 * 1000 * 1000) -- 1 minute
+                  `onCompanionDone` logInfo
+                    (  "Acquired the "
+                    <> desc
+                    <> " database write lock"
+                    )
+                logWarn
+                  (  "Still waiting on the "
+                  <> desc
+                  <> " database write lock..."
+                  )
+        withCompanion complainer $ \stopComplaining ->
+          withFileLock lockFile Exclusive $ const $ do
+            stopComplaining
+            run inner

@@ -0,0 +1,3339 @@+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiWayIf                 #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TupleSections              #-}
+
+module Pantry.Types
+  ( PantryConfig (..)
+  , PackageIndexConfig (..)
+  , HackageSecurityConfig (..)
+  , defaultHackageSecurityConfig
+  , Storage (..)
+  , HasPantryConfig (..)
+  , BlobKey (..)
+  , PackageName
+  , Version
+  , PackageIdentifier (..)
+  , Revision (..)
+  , ModuleName
+  , CabalFileInfo (..)
+  , PrintWarnings (..)
+  , PackageNameP (..)
+  , VersionP (..)
+  , ModuleNameP (..)
+  , PackageIdentifierRevision (..)
+  , pirForHash
+  , FileType (..)
+  , BuildFile (..)
+  , FileSize (..)
+  , TreeEntry (..)
+  , SafeFilePath
+  , unSafeFilePath
+  , mkSafeFilePath
+  , safeFilePathToPath
+  , hpackSafeFilePath
+  , TreeKey (..)
+  , Tree (..)
+  , renderTree
+  , parseTree
+  , parseTreeM
+  , SHA256
+  , Unresolved
+  , resolvePaths
+  , Package (..)
+  , PackageCabal (..)
+  , PHpack (..)
+  -- , PackageTarball (..)
+  , RawPackageLocation (..)
+  , PackageLocation (..)
+  , toRawPL
+  , RawPackageLocationImmutable (..)
+  , PackageLocationImmutable (..)
+  , toRawPLI
+  , RawArchive (..)
+  , Archive (..)
+  , toRawArchive
+  , Repo (..)
+  , AggregateRepo (..)
+  , SimpleRepo (..)
+  , toAggregateRepos
+  , rToSimpleRepo
+  , arToSimpleRepo
+  , RepoType (..)
+  , parsePackageIdentifier
+  , parsePackageName
+  , parsePackageNameThrowing
+  , parseFlagName
+  , parseVersion
+  , parseVersionThrowing
+  , packageIdentifierString
+  , packageNameString
+  , flagNameString
+  , versionString
+  , moduleNameString
+  , OptionalSubdirs (..)
+  , ArchiveLocation (..)
+  , RelFilePath (..)
+  , CabalString (..)
+  , toCabalStringMap
+  , unCabalStringMap
+  , parsePackageIdentifierRevision
+  , Mismatch (..)
+  , PantryException (..)
+  , FuzzyResults (..)
+  , ResolvedPath (..)
+  , HpackExecutable (..)
+  , WantedCompiler (..)
+  --, resolveSnapshotLocation
+  , snapshotLocation
+  , defaultSnapshotLocation
+  , SnapName (..)
+  , parseSnapName
+  , RawSnapshotLocation (..)
+  , SnapshotLocation (..)
+  , toRawSL
+  , parseHackageText
+  , parseRawSnapshotLocation
+  , RawSnapshotLayer (..)
+  , SnapshotLayer (..)
+  , toRawSnapshotLayer
+  , RawSnapshot (..)
+  , Snapshot (..)
+  , RawSnapshotPackage (..)
+  , SnapshotPackage (..)
+  , parseWantedCompiler
+  , RawPackageMetadata (..)
+  , PackageMetadata (..)
+  , toRawPM
+  , cabalFileName
+  , SnapshotCacheHash (..)
+  , getGlobalHintsFile
+  , bsToBlobKey
+  , warnMissingCabalFile
+  , connRDBMS
+  ) where
+
+import           Casa.Client ( CasaRepoPrefix )
+import           Database.Persist
+import           Database.Persist.Sql
+#if MIN_VERSION_persistent(2, 13, 0)
+import           Database.Persist.SqlBackend.Internal ( connRDBMS )
+#endif
+import           Data.Aeson.Encoding.Internal ( unsafeToEncoding )
+import           Data.Aeson.Types
+                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
+                   , Object, Parser, ToJSON (..), ToJSONKey (..)
+                   , ToJSONKeyFunction (..), Value (..), (.=), object
+                   , toJSONKeyText, withObject, withText
+                   )
+import           Data.Aeson.WarningParser
+                   ( WarningParser, WithJSONWarnings, (..:), (..:?), (..!=)
+                   , (.:), (...:?), jsonSubWarnings, jsonSubWarningsT
+                   , noJSONWarnings, tellJSONField, withObjectWarnings
+                   )
+import           Data.ByteString.Builder
+                   ( byteString, toLazyByteString, wordDec )
+import qualified Data.Conduit.Tar as Tar
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as Map ( mapKeysMonotonic )
+import           Data.Text.Read ( decimal )
+import           Distribution.CabalSpecVersion ( cabalSpecLatest )
+#if MIN_VERSION_Cabal(3,4,0)
+import           Distribution.CabalSpecVersion ( cabalSpecToVersionDigits )
+#else
+import           Distribution.CabalSpecVersion ( CabalSpecVersion (..) )
+#endif
+import qualified Distribution.Compat.CharParsing as Parse
+import           Distribution.ModuleName ( ModuleName )
+import           Distribution.PackageDescription
+                   ( FlagName, GenericPackageDescription, unFlagName )
+import           Distribution.Parsec
+                   ( PError (..), PWarning (..), ParsecParser
+                   , explicitEitherParsec, parsec, showPos
+                   )
+import qualified Distribution.Pretty
+import qualified Distribution.Text
+import           Distribution.Types.PackageId ( PackageIdentifier (..) )
+import           Distribution.Types.PackageName
+                   ( PackageName, mkPackageName, unPackageName )
+import           Distribution.Types.Version ( Version, mkVersion, nullVersion )
+import           Distribution.Types.VersionRange ( VersionRange )
+import qualified Hpack.Config as Hpack
+import           Network.HTTP.Client ( parseRequest )
+import           Network.HTTP.Types ( Status, statusCode )
+import           Pantry.SHA256 ( SHA256 )
+import qualified Pantry.SHA256 as SHA256
+import           Path
+                   ( Abs, Dir, File, Path, (</>), filename, parseRelFile
+                   , toFilePath
+                   )
+import           Path.IO ( resolveDir, resolveFile )
+import qualified RIO.Set as Set
+import           RIO
+import qualified RIO.ByteString as B
+import qualified RIO.ByteString.Lazy as BL
+import           RIO.List ( groupBy, intersperse )
+import qualified RIO.Text as T
+import           RIO.Time ( Day, UTCTime, toGregorian )
+import qualified RIO.Map as Map
+import           RIO.PrettyPrint
+                   ( bulletedList, fillSep, flow, hang, line, mkNarrativeList
+                   , parens, string, style
+                   )
+import           RIO.PrettyPrint.Types ( Style (..) )
+import           Text.PrettyPrint.Leijen.Extended ( Pretty (..), StyleDoc )
+
+#if MIN_VERSION_aeson(2, 0, 0)
+import qualified Data.Aeson.KeyMap as HM
+import qualified Data.Aeson.Key
+
+type AesonKey = Data.Aeson.Key.Key
+#else
+import qualified RIO.HashMap as HM
+
+type AesonKey = Text
+#endif
+
+-- | Parsed tree with more information on the Haskell package it contains.
+--
+-- @since 0.1.0.0
+data Package = Package
+  { packageTreeKey :: !TreeKey
+    -- ^ The 'TreeKey' containing this package.
+    --
+    -- This is a hash of the binary representation of 'packageTree'.
+    --
+    -- @since 0.1.0.0
+  , packageTree :: !Tree
+    -- ^ The 'Tree' containing this package.
+    --
+    -- @since 0.1.0.0
+  , packageCabalEntry :: !PackageCabal
+    -- ^ Information on the cabal file inside this package.
+    --
+    -- @since 0.1.0.0
+  , packageIdent :: !PackageIdentifier
+    -- ^ The package name and version in this package.
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Show, Eq, Ord)
+
+data PHpack = PHpack
+  { phOriginal :: !TreeEntry
+    -- ^ Original hpack file
+  , phGenerated :: !TreeEntry
+    -- ^ Generated Cabal file
+  , phVersion :: !Version
+    -- ^ Version of Hpack used
+  }
+  deriving (Show, Eq, Ord)
+
+data PackageCabal
+  = PCCabalFile !TreeEntry -- ^ TreeEntry of Cabal file
+  | PCHpack !PHpack
+  deriving (Show, Eq, Ord)
+
+cabalFileName :: PackageName -> SafeFilePath
+cabalFileName name =
+  case mkSafeFilePath $ T.pack (packageNameString name) <> ".cabal" of
+    Nothing -> error $ "cabalFileName: failed for " ++ show name
+    Just sfp -> sfp
+
+-- | The revision number of a package from Hackage, counting upwards from 0 (the
+-- original cabal file).
+--
+-- See caveats on 'CFIRevision'.
+--
+-- @since 0.1.0.0
+newtype Revision = Revision Word
+  deriving (Generic, Show, Eq, NFData, Data, Typeable, Ord, Hashable, Display, PersistField, PersistFieldSql)
+
+-- | 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.
+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
+  }
+
+-- | Configuration value used by the entire pantry package. Create one using
+-- 'withPantryConfig' or 'withPantryConfig''. See also 'PantryApp' for a
+-- convenience approach to using pantry.
+--
+-- @since 0.1.0.0
+data PantryConfig = PantryConfig
+  { pcPackageIndex :: !PackageIndexConfig
+  , pcHpackExecutable :: !HpackExecutable
+  , pcRootDir :: !(Path Abs Dir)
+  , pcStorage :: !Storage
+  , pcUpdateRef :: !(MVar Bool)
+    -- ^ Want to try updating the index once during a single run for missing
+    -- package identifiers. We also want to ensure we only update once at a
+    -- time. Start at @True@.
+  , pcParsedCabalFilesRawImmutable ::
+      !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
+    -- ^ Cache of previously parsed cabal files, to save on slow parsing time.
+  , pcParsedCabalFilesMutable ::
+      !( IORef
+           ( Map
+             (Path Abs Dir)
+             ( PrintWarnings -> IO GenericPackageDescription
+             , PackageName
+             , Path Abs File
+             )
+           )
+       )
+    -- ^ Cache for mutable packages. We want to allow for an optimization:
+    -- deferring parsing of the 'GenericPackageDescription' until its actually
+    -- needed. Therefore, we keep the filepath and the 'PackageName' derived
+    -- from that filepath. When the @IO GenericPackageDescription@ is run, it
+    -- will ensure that the @PackageName@ matches the value inside the cabal
+    -- file, and print out any warnings that still need to be printed.
+  , pcConnectionCount :: !Int
+    -- ^ concurrently open downloads
+  , pcCasaConfig :: !(Maybe (CasaRepoPrefix, Int))
+    -- ^ Optionally, the Casa pull URL e.g. @https://casa.fpcomplete.com@ and
+    -- the maximum number of Casa keys to pull per request.
+  , pcSnapshotLocation :: SnapName -> RawSnapshotLocation
+    -- ^ The location of snapshot synonyms
+  }
+
+-- | Get the location of a snapshot synonym from the 'PantryConfig'.
+--
+-- @since 0.5.0.0
+snapshotLocation ::
+     HasPantryConfig env
+  => SnapName
+  -> RIO env RawSnapshotLocation
+snapshotLocation name = do
+  loc <- view $ pantryConfigL.to pcSnapshotLocation
+  pure $ loc name
+
+-- | Should we print warnings when loading a cabal file?
+--
+-- @since 0.1.0.0
+data PrintWarnings = YesPrintWarnings | NoPrintWarnings
+
+-- | Wraps a value which potentially contains relative paths. Needs to be
+-- provided with a base directory to resolve these paths.
+--
+-- Unwrap this using 'resolvePaths'.
+--
+-- @since 0.1.0.0
+newtype Unresolved a = Unresolved (Maybe (Path Abs Dir) -> IO a)
+  deriving Functor
+
+instance Applicative Unresolved where
+  pure = Unresolved . const . pure
+  Unresolved f <*> Unresolved x = Unresolved $ \mdir -> f mdir <*> x mdir
+
+-- | Resolve all of the file paths in an 'Unresolved' relative to the given
+-- directory.
+--
+-- @since 0.1.0.0
+resolvePaths ::
+     MonadIO m
+  => Maybe (Path Abs Dir) -- ^ directory to use for relative paths
+  -> Unresolved a
+  -> m a
+resolvePaths mdir (Unresolved f) = liftIO (f mdir)
+
+-- | A combination of the relative path provided in a config file, together with
+-- the resolved absolute path.
+--
+-- @since 0.1.0.0
+data ResolvedPath t = ResolvedPath
+  { resolvedRelative :: !RelFilePath
+    -- ^ Original value parsed from a config file.
+  , resolvedAbsolute :: !(Path Abs t)
+    -- ^ Absolute path resolved against base directory loaded from.
+  }
+  deriving (Show, Eq, Generic, Ord)
+
+instance NFData (ResolvedPath t)
+
+-- | Location to load a package from. Can either be immutable (see
+-- 'PackageLocationImmutable') or a local directory which is expected to change
+-- over time. Raw version doesn't include exact package version (e.g. could
+-- refer to the latest revision on Hackage)
+--
+-- @since 0.1.0.0
+data RawPackageLocation
+  = RPLImmutable !RawPackageLocationImmutable
+  | RPLMutable !(ResolvedPath Dir)
+  deriving (Show, Eq, Generic)
+
+instance NFData RawPackageLocation
+
+-- | Location to load a package from. Can either be immutable (see
+-- 'PackageLocationImmutable') or a local directory which is expected to change
+-- over time.
+--
+-- @since 0.1.0.0
+data PackageLocation
+  = PLImmutable !PackageLocationImmutable
+  | PLMutable !(ResolvedPath Dir)
+  deriving (Show, Eq, Generic)
+
+instance NFData PackageLocation
+
+instance Display PackageLocation where
+  display (PLImmutable loc) = display loc
+  display (PLMutable fp) = fromString $ toFilePath $ resolvedAbsolute fp
+
+-- | Convert `PackageLocation` to its "raw" equivalent
+--
+-- @since 0.1.0.0
+toRawPL :: PackageLocation -> RawPackageLocation
+toRawPL (PLImmutable im) = RPLImmutable (toRawPLI im)
+toRawPL (PLMutable m) = RPLMutable m
+
+-- | Location for remote packages or archives assumed to be immutable.
+-- as user specifies it i.e. not an exact location
+--
+-- @since 0.1.0.0
+data RawPackageLocationImmutable
+  = RPLIHackage !PackageIdentifierRevision !(Maybe TreeKey)
+  | RPLIArchive !RawArchive !RawPackageMetadata
+  | RPLIRepo    !Repo !RawPackageMetadata
+  deriving (Show, Eq, Ord, Generic)
+
+instance NFData RawPackageLocationImmutable
+
+instance Display RawPackageLocationImmutable where
+  display (RPLIHackage pir _tree) = display pir <> " (from Hackage)"
+  display (RPLIArchive archive _pm) =
+    "Archive from " <> display (raLocation archive) <>
+    (if T.null $ raSubdir archive
+       then mempty
+       else " in subdir " <> display (raSubdir archive))
+  display (RPLIRepo repo _pm) =
+    "Repo from " <> display (repoUrl repo) <>
+    ", commit " <> display (repoCommit repo) <>
+    (if T.null $ repoSubdir repo
+       then mempty
+       else " in subdir " <> display (repoSubdir repo))
+
+instance Pretty RawPackageLocationImmutable where
+  pretty (RPLIHackage pir _tree) = fillSep
+    [ fromString . T.unpack $ textDisplay pir
+    , parens (flow "from Hackage")
+    ]
+  pretty (RPLIArchive archive _pm) = fillSep
+    [ flow "Archive from"
+    , pretty (raLocation archive)
+    , if T.null $ raSubdir archive
+        then mempty
+        else fillSep
+          [ flow "in subdir"
+          , style Dir (fromString $ T.unpack (raSubdir archive))
+          ]
+    ]
+  pretty (RPLIRepo repo _pm) = fillSep
+    [ flow "Repo from"
+    , style Url (fromString $ T.unpack (repoUrl repo)) <> ","
+    , "commit"
+    , fromString $ T.unpack (repoCommit repo)
+    , if T.null $ repoSubdir repo
+        then mempty
+        else fillSep
+          [ flow "in subdir"
+          , style Dir (fromString $ T.unpack (repoSubdir repo))
+          ]
+    ]
+
+-- | Location for remote packages or archives assumed to be immutable.
+--
+-- @since 0.1.0.0
+data PackageLocationImmutable
+  = PLIHackage !PackageIdentifier !BlobKey !TreeKey
+  | PLIArchive !Archive !PackageMetadata
+  | PLIRepo    !Repo !PackageMetadata
+  deriving (Generic, Show, Eq, Ord, Typeable)
+
+instance NFData PackageLocationImmutable
+
+instance Display PackageLocationImmutable where
+  display (PLIHackage ident _cabalHash _tree) =
+    fromString (packageNameString $ pkgName ident) <> " (from Hackage)"
+  display (PLIArchive archive _pm) =
+    "Archive from " <> display (archiveLocation archive) <>
+    (if T.null $ archiveSubdir archive
+       then mempty
+       else " in subdir " <> display (archiveSubdir archive))
+  display (PLIRepo repo _pm) =
+    "Repo from " <> display (repoUrl repo) <>
+    ", commit " <> display (repoCommit repo) <>
+    (if T.null $ repoSubdir repo
+       then mempty
+       else " in subdir " <> display (repoSubdir repo))
+
+instance ToJSON PackageLocationImmutable where
+  toJSON = toJSON . toRawPLI
+
+-- | Package identifier and revision with a specified cabal file hash
+--
+-- @since 0.1.0.0
+pirForHash :: PackageIdentifier -> BlobKey -> PackageIdentifierRevision
+pirForHash (PackageIdentifier name ver) (BlobKey sha size') =
+  let cfi = CFIHash sha (Just size')
+  in PackageIdentifierRevision name ver cfi
+
+-- | Convert `PackageLocationImmutable` to its "raw" equivalent
+--
+-- @since 0.1.0.0
+toRawPLI :: PackageLocationImmutable -> RawPackageLocationImmutable
+toRawPLI (PLIHackage ident cfKey treeKey) =
+  RPLIHackage (pirForHash ident cfKey) (Just treeKey)
+toRawPLI (PLIArchive archive pm) =
+  RPLIArchive (toRawArchive archive) (toRawPM pm)
+toRawPLI (PLIRepo repo pm) = RPLIRepo repo (toRawPM pm)
+
+-- | A raw package archive, specified by a user, could have no
+-- hash and file size information.
+--
+-- @since 0.1.0.0
+data RawArchive = RawArchive
+  { raLocation :: !ArchiveLocation
+    -- ^ Location of the archive
+    --
+    -- @since 0.1.0.0
+  , raHash :: !(Maybe SHA256)
+    -- ^ Cryptographic hash of the archive file
+    --
+    -- @since 0.1.0.0
+  , raSize :: !(Maybe FileSize)
+    -- ^ Size of the archive file
+    --
+    -- @since 0.1.0.0
+  , raSubdir :: !Text
+    -- ^ Subdirectory within the archive to get the package from.
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Generic, Show, Eq, Ord, Typeable)
+
+instance NFData RawArchive
+
+-- | A package archive, could be from a URL or a local file path. Local file
+-- path archives are assumed to be unchanging over time, and so are allowed in
+-- custom snapshots.
+--
+-- @since 0.1.0.0
+data Archive = Archive
+  { archiveLocation :: !ArchiveLocation
+    -- ^ Location of the archive
+    --
+    -- @since 0.1.0.0
+  , archiveHash :: !SHA256
+    -- ^ Cryptographic hash of the archive file
+    --
+    -- @since 0.1.0.0
+  , archiveSize :: !FileSize
+    -- ^ Size of the archive file
+    --
+    -- @since 0.1.0.0
+  , archiveSubdir :: !Text
+    -- ^ Subdirectory within the archive to get the package from.
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Generic, Show, Eq, Ord, Typeable)
+
+instance NFData Archive
+
+-- | Convert archive to its "raw" equivalent.
+--
+-- @since 0.1.0.0
+toRawArchive :: Archive -> RawArchive
+toRawArchive archive =
+  RawArchive (archiveLocation archive) (Just $ archiveHash archive)
+             (Just $ archiveSize archive) (archiveSubdir archive)
+
+-- | The type of a source control repository.
+--
+-- @since 0.1.0.0
+data RepoType = RepoGit | RepoHg
+  deriving (Generic, Show, Eq, Ord, Typeable)
+
+instance NFData RepoType
+
+instance PersistField RepoType where
+  toPersistValue RepoGit = toPersistValue (1 :: Int32)
+  toPersistValue RepoHg = toPersistValue (2 :: Int32)
+  fromPersistValue v = do
+    i <- fromPersistValue v
+    case i :: Int32 of
+      1 -> pure RepoGit
+      2 -> pure RepoHg
+      _ -> Left $ fromString $ "Invalid RepoType: " ++ show i
+
+instance PersistFieldSql RepoType where
+  sqlType _ = SqlInt32
+
+-- | Information on packages stored in a source control repository.
+--
+-- @since 0.1.0.0
+data Repo = Repo
+  { repoUrl :: !Text
+    -- ^ Location of the repo
+    --
+    -- @since 0.1.0.0
+  , repoCommit :: !Text
+    -- ^ Commit to use from the repo. It's strongly recommended to use
+    -- a hash instead of a tag or branch name.
+    --
+    -- @since 0.1.0.0
+  , repoType :: !RepoType
+    -- ^ The type of the repo
+    --
+    -- @since 0.1.0.0
+  , repoSubdir :: !Text
+    -- ^ Subdirectory within the archive to get the package from.
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Generic, Eq, Ord, Typeable)
+
+instance NFData Repo
+
+instance Show Repo where
+  show = T.unpack . utf8BuilderToText . display
+
+instance Display Repo where
+  display (Repo url commit typ subdir) =
+    (case typ of
+       RepoGit -> "Git"
+       RepoHg -> "Mercurial") <>
+    " repo at " <>
+    display url <>
+    ", commit " <>
+    display commit <>
+    (if T.null subdir
+      then mempty
+      else " in subdirectory " <> display subdir)
+
+rToSimpleRepo :: Repo -> SimpleRepo
+rToSimpleRepo Repo {..} = SimpleRepo
+  { sRepoUrl = repoUrl
+  , sRepoCommit = repoCommit
+  , sRepoType = repoType
+  }
+
+data AggregateRepo = AggregateRepo
+  { aRepo :: !SimpleRepo
+  , aRepoSubdirs :: [(Text, RawPackageMetadata)]
+  }
+  deriving (Show, Generic, Eq, Ord, Typeable)
+
+-- | Group input repositories by non-subdir values.
+toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
+toAggregateRepos = mapMaybe toAggregateRepo . groupBy matchRepoExclSubdir
+ where
+  toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
+  toAggregateRepo [] = Nothing
+  toAggregateRepo xs@((repo, _):_) =
+    Just $ AggregateRepo (rToSimpleRepo repo) (fmap (first repoSubdir) xs)
+
+  matchRepoExclSubdir x1 x2 =
+    let (Repo url1 commit1 type1 _, _) = x1
+        (Repo url2 commit2 type2 _, _) = x2
+    in  (url1, commit1, type1) == (url2, commit2, type2)
+
+arToSimpleRepo :: AggregateRepo -> SimpleRepo
+arToSimpleRepo AggregateRepo {..} = aRepo
+
+-- | Repository without subdirectory information.
+--
+-- @since 0.5.3
+data SimpleRepo = SimpleRepo
+  { sRepoUrl :: !Text
+  , sRepoCommit :: !Text
+  , sRepoType :: !RepoType
+  }
+  deriving (Show, Generic, Eq, Ord, Typeable)
+
+instance Display SimpleRepo where
+  display (SimpleRepo url commit typ) =
+    (case typ of
+       RepoGit -> "Git"
+       RepoHg -> "Mercurial") <>
+    " repo at " <>
+    display url <>
+    ", commit " <>
+    display commit
+
+-- An unexported newtype wrapper to hang a 'FromJSON' instance off of. Contains
+-- a GitHub user and repo name separated by a forward slash, e.g. "foo/bar".
+newtype GitHubRepo = GitHubRepo Text
+
+instance FromJSON GitHubRepo where
+  parseJSON = withText "GitHubRepo" $ \s -> do
+    case T.split (== '/') s of
+      [x, y] | not (T.null x || T.null y) -> pure (GitHubRepo s)
+      _ -> fail "expecting \"user/repo\""
+
+-- | Configuration to securely download package metadata and contents. For most
+-- purposes, you'll want to use the default Hackage settings via
+-- @defaultPackageIndexConfig@.
+--
+-- /NOTE/ It's highly recommended to only use the official Hackage
+-- server or a mirror. See
+-- <https://github.com/commercialhaskell/stack/issues/4137>.
+--
+-- @since 0.6.0
+data PackageIndexConfig = PackageIndexConfig
+  { picDownloadPrefix :: !Text
+  , picHackageSecurityConfig :: !HackageSecurityConfig
+  }
+  deriving Show
+
+-- | If the @hackage-security@ key is absent from the JSON object, assigns
+-- default value 'defaultHackageSecurityConfig'.
+--
+-- @since 0.6.0
+instance FromJSON (WithJSONWarnings PackageIndexConfig) where
+  parseJSON = withObjectWarnings "PackageIndexConfig" $ \o -> do
+    picDownloadPrefix <- o ..: "download-prefix"
+    picHackageSecurityConfig <- jsonSubWarnings $
+      o ..:? "hackage-security" ..!= noJSONWarnings defaultHackageSecurityConfig
+    pure PackageIndexConfig {..}
+
+-- | Default 'HackageSecurityConfig' value using the official Hackage server.
+-- The value of the 'hscIgnoreExpiry' field is 'True'.
+--
+-- @since 0.7.0
+defaultHackageSecurityConfig :: HackageSecurityConfig
+defaultHackageSecurityConfig = HackageSecurityConfig
+  { hscKeyIds =
+      -- Key owners and public keys are provided as a convenience to readers.
+      -- The canonical source for this mapping data is the hackage-root-keys
+      -- repository and Hackage's root.json file.
+      --
+      -- Links:
+      --  * https://github.com/haskell-infra/hackage-root-keys
+      --  * https://hackage.haskell.org/root.json
+      -- Please consult root.json on Hackage to map key IDs to public keys,
+      -- and the hackage-root-keys repository to map public keys to their
+      -- owners.
+      [ -- Adam Gundry (uRPdSiL3/MNsk50z6NB55ABo0OrrNDXigtCul4vtzmw=)
+        "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"
+      , -- Gershom Bazerman (bYoUXXQ9TtX10UriaMiQtTccuXPGnmldP68djzZ7cLo=)
+        "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"
+      , -- John Wiegley (zazm5w480r+zPO6Z0+8fjGuxZtb9pAuoVmQ+VkuCvgU=)
+        "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"
+      , -- Norman Ramsey (ZI8di3a9Un0s2RBrt5GwVRvfOXVuywADfXGPZfkiDb0=)
+        "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
+      , -- Mathieu Boespflug (ydN1nGGQ79K1Q0nN+ul+Ln8MxikTB95w0YdGd3v3kmg=)
+        "be75553f3c7ba1dbe298da81f1d1b05c9d39dd8ed2616c9bddf1525ca8c03e48"
+      , -- Joachim Breitner (5iUgwqZCWrCJktqMx0bBMIuoIyT4A1RYGozzchRN9rA=)
+        "d26e46f3b631aae1433b89379a6c68bd417eb5d1c408f0643dcc07757fece522"
+      ]
+  , hscKeyThreshold = 3
+  , hscIgnoreExpiry = True
+  }
+
+-- | Configuration for Hackage Security to securely download package metadata
+-- and contents. For most purposes, you'll want to use the default Hackage
+-- settings via @defaultHackageSecurityConfig@.
+--
+-- /NOTE/ It's highly recommended to only use the official Hackage
+-- server or a mirror. See
+-- <https://github.com/commercialhaskell/stack/issues/4137>.
+--
+-- @since 0.6.0
+data HackageSecurityConfig = HackageSecurityConfig
+  { hscKeyIds :: ![Text]
+  , hscKeyThreshold :: !Int
+  , hscIgnoreExpiry :: !Bool
+  }
+  deriving Show
+
+-- | If the @ignore-expiry@ key is absent from the JSON object, assigns default
+-- value 'True'.
+--
+-- @since 0.1.1.0
+instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
+  parseJSON = withObjectWarnings "HackageSecurityConfig" $ \o -> do
+    hscKeyIds <- o ..: "keyids"
+    hscKeyThreshold <- o ..: "key-threshold"
+    hscIgnoreExpiry <- o ..:? "ignore-expiry" ..!= True
+    pure HackageSecurityConfig {..}
+
+-- | An environment which contains a 'PantryConfig'.
+--
+-- @since 0.1.0.0
+class HasPantryConfig env where
+  -- | Lens to get or set the 'PantryConfig'
+  --
+  -- @since 0.1.0.0
+  pantryConfigL :: Lens' env PantryConfig
+
+
+-- | File size in bytes
+--
+-- @since 0.1.0.0
+newtype FileSize = FileSize Word
+  deriving ( Show, Eq, Ord, Typeable, Generic, Display, Hashable, NFData
+           , PersistField, PersistFieldSql, ToJSON, FromJSON
+           )
+
+-- | A key for looking up a blob, which combines the SHA256 hash of the contents
+-- and the file size.
+--
+-- The file size may seem redundant with the hash. However, it is necessary for
+-- safely downloading blobs from an untrusted source. See
+-- <https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys>.
+--
+-- @since 0.1.0.0
+data BlobKey = BlobKey !SHA256 !FileSize
+  deriving (Eq, Ord, Typeable, Generic)
+
+instance NFData BlobKey
+
+instance Show BlobKey where
+  show = T.unpack . utf8BuilderToText . display
+
+instance Display BlobKey where
+  display (BlobKey sha size') = display sha <> "," <> display size'
+
+blobKeyPairs :: BlobKey -> [(AesonKey, Value)]
+blobKeyPairs (BlobKey sha size') =
+  [ "sha256" .= sha
+  , "size" .= size'
+  ]
+
+instance ToJSON BlobKey where
+  toJSON = object . blobKeyPairs
+
+instance FromJSON BlobKey where
+  parseJSON = withObject "BlobKey" $ \o -> BlobKey
+    <$> o .: "sha256"
+    <*> o .: "size"
+
+newtype PackageNameP = PackageNameP { unPackageNameP :: PackageName }
+  deriving (Eq, Ord, Show, Read, NFData)
+
+instance Display PackageNameP where
+  display = fromString . packageNameString . unPackageNameP
+
+instance PersistField PackageNameP where
+  toPersistValue (PackageNameP pn) = PersistText $ T.pack $ packageNameString pn
+  fromPersistValue v = do
+    str <- fromPersistValue v
+    case parsePackageName str of
+      Nothing -> Left $ "Invalid package name: " <> T.pack str
+      Just pn -> Right $ PackageNameP pn
+
+instance PersistFieldSql PackageNameP where
+  sqlType _ = SqlString
+
+instance ToJSON PackageNameP where
+  toJSON (PackageNameP pn) = String $ T.pack $ packageNameString pn
+
+instance FromJSON PackageNameP where
+  parseJSON =
+    withText "PackageNameP" $ pure . PackageNameP . mkPackageName . T.unpack
+
+instance ToJSONKey PackageNameP where
+  toJSONKey =
+    ToJSONKeyText
+      (fromString . packageNameString . unPackageNameP)
+      (unsafeToEncoding . getUtf8Builder . display)
+
+instance FromJSONKey PackageNameP where
+  fromJSONKey = FromJSONKeyText $ PackageNameP . mkPackageName . T.unpack
+
+newtype VersionP = VersionP { unVersionP :: Version }
+  deriving (Eq, Ord, Show, Read, NFData)
+
+instance PersistField VersionP where
+  toPersistValue (VersionP v) = PersistText $ T.pack $ versionString v
+  fromPersistValue v = do
+    str <- fromPersistValue v
+    case parseVersion str of
+      Nothing -> Left $ "Invalid version number: " <> T.pack str
+      Just ver -> Right $ VersionP ver
+
+instance PersistFieldSql VersionP where
+  sqlType _ = SqlString
+
+instance Display VersionP where
+  display (VersionP v) = fromString $ versionString v
+
+instance ToJSON VersionP where
+  toJSON (VersionP v) = String $ T.pack $ versionString v
+
+instance FromJSON VersionP where
+  parseJSON =
+    withText "VersionP" $
+    either (fail . displayException) (pure . VersionP) . parseVersionThrowing . T.unpack
+
+newtype ModuleNameP = ModuleNameP
+  { unModuleNameP :: ModuleName
+  }
+  deriving (Eq, Ord, Show, NFData)
+
+instance Display ModuleNameP where
+  display = fromString . moduleNameString . unModuleNameP
+
+instance PersistField ModuleNameP where
+  toPersistValue (ModuleNameP mn) = PersistText $ T.pack $ moduleNameString mn
+  fromPersistValue v = do
+    str <- fromPersistValue v
+    case parseModuleName str of
+      Nothing -> Left $ "Invalid module name: " <> T.pack str
+      Just pn -> Right $ ModuleNameP pn
+
+instance PersistFieldSql ModuleNameP where
+  sqlType _ = SqlString
+
+-- | How to choose a cabal file for a package from Hackage. This is to work with
+-- Hackage cabal file revisions, which makes @PackageIdentifier@ insufficient
+-- for specifying a package from Hackage.
+--
+-- @since 0.1.0.0
+data CabalFileInfo
+  = CFILatest
+    -- ^ Take the latest revision of the cabal file available. This
+    -- isn't reproducible at all, but the running assumption (not
+    -- necessarily true) is that cabal file revisions do not change
+    -- semantics of the build.
+    --
+    -- @since 0.1.0.0
+  | CFIHash !SHA256 !(Maybe FileSize)
+    -- ^ Identify by contents of the cabal file itself. Only reason for
+    -- @Maybe@ on @FileSize@ is for compatibility with input that
+    -- doesn't include the file size.
+    --
+    -- @since 0.1.0.0
+  | CFIRevision !Revision
+    -- ^ Identify by revision number, with 0 being the original and
+    -- counting upward. This relies on Hackage providing consistent
+    -- versioning. @CFIHash@ should be preferred wherever possible for
+    -- reproducibility.
+    --
+    -- @since 0.1.0.0
+  deriving (Generic, Show, Eq, Ord, Typeable)
+
+instance NFData CabalFileInfo
+
+instance Hashable CabalFileInfo
+
+instance Display CabalFileInfo where
+  display CFILatest = mempty
+  display (CFIHash hash' msize) =
+    "@sha256:" <> display hash' <> maybe mempty (\i -> "," <> display i) msize
+  display (CFIRevision rev) = "@rev:" <> display rev
+
+-- | A full specification for a package from Hackage, including the package
+-- name, version, and how to load up the correct cabal file revision.
+--
+-- @since 0.1.0.0
+data PackageIdentifierRevision
+  = PackageIdentifierRevision !PackageName !Version !CabalFileInfo
+  deriving (Generic, Eq, Ord, Typeable)
+
+instance NFData PackageIdentifierRevision
+
+instance Show PackageIdentifierRevision where
+  show = T.unpack . utf8BuilderToText . display
+
+instance Display PackageIdentifierRevision where
+  display (PackageIdentifierRevision name version cfi) =
+       fromString (packageNameString name)
+    <> "-"
+    <> fromString (versionString version)
+    <> display cfi
+
+instance ToJSON PackageIdentifierRevision where
+  toJSON = toJSON . utf8BuilderToText . display
+
+instance FromJSON PackageIdentifierRevision where
+  parseJSON = withText "PackageIdentifierRevision" $ \t ->
+    case parsePackageIdentifierRevision t of
+      Left e -> fail $ show e
+      Right pir -> pure pir
+
+-- | Parse a hackage text.
+--
+-- @since 0.1.0.0
+parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
+parseHackageText t =
+  either (\x -> error (show x) $ const $ Left $ PackageIdentifierRevisionParseFail t) Right $
+  explicitEitherParsec (hackageTextParsec <* Parse.eof) $
+  T.unpack t
+
+hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
+hackageTextParsec = do
+  ident <- packageIdentifierParsec
+  _ <- Parse.string "@sha256:"
+
+  shaT <- Parse.munch (/= ',')
+  sha <- either (const mzero) pure $ SHA256.fromHexText $ fromString shaT
+
+  _ <- Parse.char ','
+  size' <- Parse.integral -- FIXME probably need to handle overflow, since unfortunately Cabal doesn't
+  pure (ident, BlobKey sha (FileSize size'))
+
+splitColon :: Text -> Maybe (Text, Text)
+splitColon t' =
+  let (x, y) = T.break (== ':') t'
+  in  (x, ) <$> T.stripPrefix ":" y
+
+-- | Parse a 'PackageIdentifierRevision'
+--
+-- @since 0.1.0.0
+parsePackageIdentifierRevision ::
+     Text
+  -> Either PantryException PackageIdentifierRevision
+parsePackageIdentifierRevision t =
+  maybe (Left $ PackageIdentifierRevisionParseFail t) Right $ do
+    let (identT, cfiT) = T.break (== '@') t
+    PackageIdentifier name version <- parsePackageIdentifier $ T.unpack identT
+    cfi <-
+      case splitColon cfiT of
+        Just ("@sha256", shaSizeT) -> do
+          let (shaT, sizeT) = T.break (== ',') shaSizeT
+          sha <- either (const Nothing) Just $ SHA256.fromHexText shaT
+          msize <-
+            case T.stripPrefix "," sizeT of
+              Nothing -> Just Nothing
+              Just sizeT' ->
+                case decimal sizeT' of
+                  Right (size', "") -> Just $ Just $ FileSize size'
+                  _ -> Nothing
+          pure $ CFIHash sha msize
+        Just ("@rev", revT) ->
+          case decimal revT of
+            Right (rev, "") -> pure $ CFIRevision $ Revision rev
+            _ -> Nothing
+        Nothing -> pure CFILatest
+        _ -> Nothing
+    pure $ PackageIdentifierRevision name version cfi
+
+data Mismatch a = Mismatch
+  { mismatchExpected :: !a
+  , mismatchActual :: !a
+  }
+
+-- | Things that can go wrong in pantry. Note two things:
+--
+-- * Many other exception types may be thrown from underlying libraries. Pantry
+--   does not attempt to wrap these underlying exceptions.
+--
+-- * We may add more constructors to this data type in minor version bumps of
+--   pantry. This technically breaks the PVP. You should not be writing pattern
+--   matches against this type that expect total matching.
+--
+-- @since 0.1.0.0
+data PantryException
+  = PackageIdentifierRevisionParseFail !Text
+  | InvalidCabalFile
+      !(Either RawPackageLocationImmutable (Path Abs File))
+      !(Maybe Version)
+      ![PError]
+      ![PWarning]
+  | TreeWithoutCabalFile !RawPackageLocationImmutable
+  | TreeWithMultipleCabalFiles !RawPackageLocationImmutable ![SafeFilePath]
+  | MismatchedCabalName !(Path Abs File) !PackageName
+  | NoLocalPackageDirFound !(Path Abs Dir)
+  | NoCabalFileFound !(Path Abs Dir)
+  | MultipleCabalFilesFound !(Path Abs Dir) ![Path Abs File]
+  | InvalidWantedCompiler !Text
+  | InvalidSnapshotLocation !(Path Abs Dir) !Text
+  | InvalidOverrideCompiler !WantedCompiler !WantedCompiler
+  | InvalidFilePathSnapshot !Text
+  | InvalidSnapshot !RawSnapshotLocation !SomeException
+  | MismatchedPackageMetadata
+      !RawPackageLocationImmutable
+      !RawPackageMetadata
+      !(Maybe TreeKey)
+      !PackageIdentifier
+  | Non200ResponseStatus !Status
+  | InvalidBlobKey !(Mismatch BlobKey)
+  | Couldn'tParseSnapshot !RawSnapshotLocation !String
+  | WrongCabalFileName !RawPackageLocationImmutable !SafeFilePath !PackageName
+  | DownloadInvalidSHA256 !Text !(Mismatch SHA256)
+  | DownloadInvalidSize !Text !(Mismatch FileSize)
+  | DownloadTooLarge !Text !(Mismatch FileSize)
+  -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is
+  -- a lower bound on the size from the server.
+  | LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
+  | LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
+  | UnknownArchiveType !ArchiveLocation
+  | InvalidTarFileType !ArchiveLocation !FilePath !Tar.FileType
+  | UnsupportedTarball !ArchiveLocation !Text
+  | NoHackageCryptographicHash !PackageIdentifier
+  | FailedToCloneRepo !SimpleRepo
+  | TreeReferencesMissingBlob !RawPackageLocationImmutable !SafeFilePath !BlobKey
+  | CompletePackageMetadataMismatch !RawPackageLocationImmutable !PackageMetadata
+  | CRC32Mismatch !ArchiveLocation !FilePath !(Mismatch Word32)
+  | UnknownHackagePackage !PackageIdentifierRevision !FuzzyResults
+  | CannotCompleteRepoNonSHA1 !Repo
+  | MutablePackageLocationFromUrl !Text
+  | MismatchedCabalFileForHackage !PackageIdentifierRevision !(Mismatch PackageIdentifier)
+  | PackageNameParseFail !Text
+  | PackageVersionParseFail !Text
+  | InvalidCabalFilePath !(Path Abs File)
+  | DuplicatePackageNames !Utf8Builder ![(PackageName, [RawPackageLocationImmutable])]
+  | MigrationFailure !Text !(Path Abs File) !SomeException
+  | NoCasaConfig
+  | InvalidTreeFromCasa !BlobKey !ByteString
+  | ParseSnapNameException !Text
+  | HpackLibraryException !(Path Abs File) !String
+  | HpackExeException !FilePath !(Path Abs Dir) !SomeException
+  deriving Typeable
+
+instance Exception PantryException where
+
+instance Show PantryException where
+  show = T.unpack . utf8BuilderToText . display
+
+-- To support the Haskell Foundation's
+-- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry
+-- error messages generated by Pantry itself begin with an unique code in the
+-- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.
+-- The numbers are selected at random, not in sequence.
+--
+-- Prettier versions of these error messages are also provided. See the instance
+-- of Pretty.
+instance Display PantryException where
+  display NoCasaConfig =
+    "Error: [S-889]\n"
+    <> "The Pantry configuration has no Casa configuration."
+  display (InvalidTreeFromCasa blobKey _bs) =
+    "Error: [S-258]\n"
+    <> "Invalid tree from casa: "
+    <> display blobKey
+  display (PackageIdentifierRevisionParseFail text) =
+    "Error: [S-360]\n"
+    <> "Invalid package identifier (with optional revision): "
+    <> display text
+  display (InvalidCabalFile loc mversion errs warnings) =
+    "Error: [S-242]\n"
+    <> "Unable to parse cabal file from package "
+    <> either display (fromString . toFilePath) loc
+    <> "\n\n"
+    <> foldMap
+         ( \(PError pos msg) ->
+                 "- "
+              <> fromString (showPos pos)
+              <> ": "
+              <> fromString msg
+              <> "\n"
+         )
+         errs
+    <> foldMap
+         ( \(PWarning _ pos msg) ->
+                 "- "
+              <> fromString (showPos pos)
+              <> ": "
+              <> fromString msg
+              <> "\n"
+         )
+         warnings
+    <> ( case mversion of
+           Just version
+             | version > cabalSpecLatestVersion ->
+                    "\n\nThe cabal file uses the cabal specification version "
+                 <> fromString (versionString version)
+                 <> ", but we only support up to version "
+                 <> fromString (versionString cabalSpecLatestVersion)
+                 <> ".\nRecommended action: upgrade your build tool (e.g., `stack upgrade`)."
+           _ -> mempty
+       )
+  display (TreeWithoutCabalFile pl) =
+    "Error: [S-654]\n"
+    <> "No cabal file found for "
+    <> display pl
+  display (TreeWithMultipleCabalFiles pl sfps) =
+    "Error: [S-500]\n"
+    <> "Multiple cabal files found for "
+    <> display pl
+    <> ": "
+    <> fold (intersperse ", " (map display sfps))
+  display (MismatchedCabalName fp name) =
+    "Error: [S-910]\n"
+    <> "The Cabal file:\n"
+    <> fromString (toFilePath fp)
+    <> "\nis not named after the package that it defines.\n"
+    <> "Please rename the file to: "
+    <> fromString (packageNameString name)
+    <> ".cabal\n"
+    <> "Hackage rejects packages where the first part of the Cabal file name "
+    <> "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"
+    <> "The current entry points to "
+    <> fromString (toFilePath dir)
+    <> ",\nbut no such directory could be found. If, alternatively, a package\n"
+    <> "in the package index was intended, its name and version must be\n"
+    <> "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"
+    <> "The current entry points to "
+    <> fromString (toFilePath dir)
+    <> ",\nbut no .cabal or package.yaml file could be found there."
+  display (MultipleCabalFilesFound dir files) =
+    "Error: [S-368]\n"
+    <> "Multiple .cabal files found in directory "
+    <> fromString (toFilePath dir)
+    <> ":\n"
+    <> fold
+         ( intersperse
+             "\n"
+             (map (\x -> "- " <> fromString (toFilePath (filename x))) files)
+         )
+  display (InvalidWantedCompiler t) =
+    "Error: [S-204]\n"
+    <> "Invalid wanted compiler: "
+    <> display t
+  display (InvalidSnapshotLocation dir t) =
+    "Error: [S-935]\n"
+    <> "Invalid snapshot location "
+    <> displayShow t
+    <> " relative to directory "
+    <> displayShow (toFilePath dir)
+  display (InvalidOverrideCompiler x y) =
+    "Error: [S-287]\n"
+    <> "Specified compiler for a resolver ("
+    <> display x
+    <> "), but also specified an override compiler ("
+    <> display y
+    <> ")"
+  display (InvalidFilePathSnapshot t) =
+    "Error: [S-617]\n"
+    <> "Specified snapshot as file path with "
+    <> displayShow t
+    <> ", but not reading from a local file"
+  display (InvalidSnapshot loc err) =
+    "Error: [S-775]\n"
+    <> "Exception while reading snapshot from "
+    <> display loc
+    <> ":\n"
+    <> displayShow err
+  display (MismatchedPackageMetadata loc pm mtreeKey foundIdent) =
+    "Error: [S-427]\n"
+    <> "Mismatched package metadata for "
+    <> display loc
+    <> "\nFound: "
+    <> fromString (packageIdentifierString foundIdent)
+    <> ( case mtreeKey of
+           Nothing -> mempty
+           Just treeKey -> " with tree " <> display treeKey
+       )
+    <> "\nExpected: "
+    <> display pm
+  display (Non200ResponseStatus status) =
+    "Error: [S-571]\n"
+    <> "Unexpected non-200 HTTP status code: "
+    <> displayShow (statusCode status)
+  display (InvalidBlobKey Mismatch{..}) =
+    "Error: [S-236]\n"
+    <> "Invalid blob key found, expected: "
+    <> display mismatchExpected
+    <> ", actual: "
+    <> display mismatchActual
+  display (Couldn'tParseSnapshot sl err) =
+    "Error: [S-645]\n"
+    <> "Couldn't parse snapshot from "
+    <> display sl
+    <> ": "
+    <> fromString err
+  display (WrongCabalFileName pl sfp name) =
+    "Error: [S-575]\n"
+    <> "Wrong cabal file name for package "
+    <> display pl
+    <> "\nThe cabal file is named "
+    <> display sfp
+    <> ", but package name is "
+    <> fromString (packageNameString name)
+    <> "\nFor more information, see:\n  - https://github.com/commercialhaskell/stack/issues/317\n  -https://github.com/commercialhaskell/stack/issues/895"
+  display (DownloadInvalidSHA256 url Mismatch {..}) =
+    "Error: [S-394]\n"
+    <> "Mismatched SHA256 hash from "
+    <> display url
+    <> "\nExpected: "
+    <> display mismatchExpected
+    <> "\nActual:   "
+    <> display mismatchActual
+  display (DownloadInvalidSize url Mismatch {..}) =
+    "Error: [S-401]\n"
+    <> "Mismatched download size from "
+    <> display url
+    <> "\nExpected: "
+    <> display mismatchExpected
+    <> "\nActual:   "
+    <> display mismatchActual
+  display (DownloadTooLarge url Mismatch {..}) =
+    "Error: [S-113]\n"
+    <> "Download from "
+    <> display url
+    <> " was too large.\n"
+    <> "Expected: "
+    <> display mismatchExpected
+    <> ", stopped after receiving: "
+    <> display mismatchActual
+  display (LocalInvalidSHA256 path Mismatch {..}) =
+    "Error: [S-834]\n"
+    <> "Mismatched SHA256 hash from "
+    <> fromString (toFilePath path)
+    <> "\nExpected: "
+    <> display mismatchExpected
+    <> "\nActual:   "
+    <> display mismatchActual
+  display (LocalInvalidSize path Mismatch {..}) =
+    "Error: [S-713]\n"
+    <> "Mismatched file size from "
+    <> fromString (toFilePath path)
+    <> "\nExpected: "
+    <> display mismatchExpected
+    <> "\nActual:   "
+    <> display mismatchActual
+  display (UnknownArchiveType loc) =
+    "Error: [S-372]\n"
+    <> "Unable to determine archive type of: "
+    <> display loc
+  display (InvalidTarFileType loc fp x) =
+    "Error: [S-950]\n"
+    <> "Unsupported tar file type in archive "
+    <> display loc
+    <> " at file "
+    <> fromString fp
+    <> ": "
+    <> displayShow x
+  display (UnsupportedTarball loc err) =
+    "Error: [S-760]\n"
+    <> "Unsupported tarball from "
+    <> display loc
+    <> ": "
+    <> display err
+  display (NoHackageCryptographicHash ident) =
+    "Error: [S-922]\n"
+    <> "No cryptographic hash found for Hackage package "
+    <> fromString (packageIdentifierString ident)
+  display (FailedToCloneRepo repo) =
+    "Error: [S-109]\n"
+    <> "Failed to clone repo "
+    <> display repo
+  display (TreeReferencesMissingBlob loc sfp key) =
+    "Error: [S-237]\n"
+    <> "The package "
+    <> display loc
+    <> " needs blob "
+    <> display key
+    <> " for file path "
+    <> display sfp
+    <> ", but the blob is not available"
+  display (CompletePackageMetadataMismatch loc pm) =
+    "Error: [S-984]\n"
+    <> "When completing package metadata for "
+    <> display loc
+    <> ", some values changed in the new package metadata: "
+    <> display pm
+  display (CRC32Mismatch loc fp Mismatch {..}) =
+    "Error: [S-607]\n"
+    <> "CRC32 mismatch in ZIP file from "
+    <> display loc
+    <> " on internal file "
+    <> fromString fp
+    <> "\nExpected: "
+    <> display mismatchExpected
+    <> "\nActual:   "
+    <> display mismatchActual
+  display (UnknownHackagePackage pir fuzzy) =
+    "Error: [S-476]\n"
+    <> "Could not find "
+    <> display pir
+    <> " on Hackage"
+    <> displayFuzzy fuzzy
+  display (CannotCompleteRepoNonSHA1 repo) =
+    "Error: [S-112]\n"
+    <> "Cannot complete repo information for a non SHA1 commit due to non-reproducibility: "
+    <> display repo
+  display (MutablePackageLocationFromUrl t) =
+    "Error: [S-321]\n"
+    <> "Cannot refer to a mutable package location from a URL: "
+    <> display t
+  display (MismatchedCabalFileForHackage pir Mismatch{..}) =
+    "Error: [S-377]\n"
+    <> "When processing cabal file for Hackage package "
+    <> display pir
+    <> ":\nMismatched package identifier."
+    <> "\nExpected: "
+    <> fromString (packageIdentifierString mismatchExpected)
+    <> "\nActual:   "
+    <> fromString (packageIdentifierString mismatchActual)
+  display (PackageNameParseFail t) =
+    "Error: [S-580]\n"
+    <> "Invalid package name: "
+    <> display t
+  display (PackageVersionParseFail t) =
+    "Error: [S-479]\n"
+    <> "Invalid version: "
+    <> display t
+  display (InvalidCabalFilePath fp) =
+    "Error: [S-824]\n"
+    <> "File path contains a name which is not a valid package name: "
+    <> fromString (toFilePath fp)
+  display (DuplicatePackageNames source pairs') =
+    "Error: [S-674]\n"
+    <> "Duplicate package names ("
+    <> source
+    <> "):\n"
+    <> foldMap
+         ( \(name, locs) ->
+                fromString (packageNameString name)
+             <> ":\n"
+             <> foldMap (\loc -> "- " <> display loc <> "\n") locs
+         )
+         pairs'
+  display (MigrationFailure desc fp err) =
+    "Error: [S-536]\n"
+    <> "Encountered error while migrating database "
+    <> display desc
+    <> "\nlocated at "
+    <> fromString (toFilePath fp)
+    <> ":"
+    <> "\n    "
+    <> displayShow err
+  display (ParseSnapNameException t) =
+    "Error: [S-994]\n"
+     <> "Invalid snapshot name: "
+     <> display t
+  display (HpackLibraryException file err) =
+    "Error: [S-305]\n"
+    <> "Failed to generate a Cabal file using the Hpack library on file:\n"
+    <> fromString (toFilePath file)
+    <> "\n\n"
+    <> "The error encountered was:\n\n"
+    <> fromString err
+  display (HpackExeException fp dir err) =
+    "Error: [S-720]\n"
+    <> "Failed to generate a Cabal file using the Hpack executable:\n"
+    <> fromString fp
+    <> "in directory: "
+    <> fromString (toFilePath dir)
+    <> "\n\n"
+    <> "The error encountered was:\n\n"
+    <> fromString (show err)
+
+-- See also the instance of Display. Although prettier, these messages are
+-- intended to be substantively the same as the corresponding 'black and white'
+-- versions.
+instance Pretty PantryException where
+  pretty NoCasaConfig =
+    "[S-889]"
+    <> line
+    <> flow "The Pantry configuration has no Casa configuration."
+  pretty (InvalidTreeFromCasa blobKey _bs) =
+    "[S-258]"
+    <> line
+    <> fillSep
+         [ flow "Invalid tree from casa:"
+         , fromString . T.unpack $ textDisplay blobKey
+         ]
+  pretty (PackageIdentifierRevisionParseFail text) =
+    "[S-360]"
+    <> line
+    <> fillSep
+         [ flow "Invalid package identifier (with optional revision):"
+         , fromString $ T.unpack text
+         ]
+  pretty (InvalidCabalFile loc mversion errs warnings) =
+    "[S-242]"
+    <> line
+    <> fillSep
+         [ flow "Unable to parse Cabal file from package"
+         , either pretty pretty loc <> ":"
+         ]
+    <> line
+    <> bulletedList
+         ( map (\(PError pos msg) -> fillSep
+             [ fromString (showPos pos) <> ":"
+             , fromString msg
+             ])
+             errs
+         )
+    <> line
+    <> bulletedList
+         ( map (\(PWarning _ pos msg) -> fillSep
+             [ fromString (showPos pos) <> ":"
+             , fromString msg
+             ])
+             warnings
+         )
+    <> ( case mversion of
+           Just version | version > cabalSpecLatestVersion ->
+                line
+             <> fillSep
+                  [ flow "The Cabal file uses the Cabal specification version"
+                  , style Current (fromString $ versionString version) <> ","
+                  , flow "but we only support up to version"
+                  , fromString (versionString cabalSpecLatestVersion) <> "."
+                  , flow "Recommended action: upgrade your build tool"
+                  , parens (fillSep
+                      [ "e.g."
+                      , style Shell (flow "stack upgrade")
+                      ]) <> "."
+                  ]
+           _ -> mempty
+       )
+  pretty (TreeWithoutCabalFile loc) =
+    "[S-654]"
+    <> line
+    <> fillSep
+         [ flow "No Cabal file found for"
+         , pretty loc <> "."
+         ]
+  pretty (TreeWithMultipleCabalFiles loc sfps) =
+    "[S-500]"
+    <> line
+    <> fillSep
+         ( flow "Multiple Cabal files found for"
+         : (pretty loc <> ":")
+         : mkNarrativeList (Just File) False
+             (map (fromString . T.unpack . textDisplay) sfps :: [StyleDoc])
+         )
+  pretty (MismatchedCabalName fp name) =
+    "[S-910]"
+    <> line
+    <> fillSep
+         [ flow "The Cabal file"
+         , pretty fp
+         , flow "is not named after the package that it defines. Please rename"
+         , flow "the file to"
+         , style File (fromString $ packageNameString name <> ".cabal") <> "."
+         , flow "Hackage rejects packages where the first part of the Cabal"
+         , flow "file name is not the package name."
+         ]
+  pretty (NoLocalPackageDirFound dir) =
+    "[S-395]"
+    <> line
+    <> fillSep
+         [ flow "Stack looks for packages in the directories configured in the"
+         , style Shell "packages"
+         , "and"
+         , style Shell "extra-deps"
+         , flow "fields defined in your"
+         , style File "stack.yaml" <> "."
+         , flow "The current entry points to"
+         , pretty dir
+         , flow "but no such directory could be found. If, alternatively, a"
+         , flow "package in the package index was intended, its name and"
+         , flow "version must be specified as an extra-dep."
+         ]
+  pretty (NoCabalFileFound dir) =
+    "[S-636]"
+    <> line
+    <> fillSep
+         [ flow "Stack looks for packages in the directories configured in the"
+         , style Shell "packages"
+         , "and"
+         , style Shell "extra-deps"
+         , flow "fields defined in your"
+         , style File "stack.yaml" <> "."
+         , flow "The current entry points to"
+         , pretty dir
+         , flow "but no Cabal file or"
+         , style File "package.yaml"
+         , flow "could be found there."
+         ]
+  pretty (MultipleCabalFilesFound dir files) =
+    "[S-368]"
+    <> line
+    <> fillSep
+         ( flow "Multiple Cabal files found in directory"
+         : (pretty dir <> ":")
+         : mkNarrativeList (Just File) False
+             (map (pretty . filename) files)
+         )
+  pretty (InvalidWantedCompiler t) =
+    "[S-204]"
+    <> line
+    <> fillSep
+         [ flow "Invalid wanted compiler:"
+         , style Current (fromString $ T.unpack t) <> "."
+         ]
+  pretty (InvalidSnapshotLocation dir t) =
+    "[S-935]"
+    <> line
+    <> fillSep
+         [ flow "Invalid snapshot location"
+         , style Current (fromString $ T.unpack t)
+         , flow "relative to directory"
+         , pretty dir <> "."
+         ]
+  pretty (InvalidOverrideCompiler x y) =
+    "[S-287]"
+    <> line
+    <> fillSep
+         [ flow "Specified compiler for a resolver"
+         , parens (style Shell (fromString . T.unpack $ textDisplay x))
+         , flow "but also specified an override compiler"
+         , parens (style Shell (fromString . T.unpack $ textDisplay y)) <> "."
+         ]
+  pretty (InvalidFilePathSnapshot t) =
+    "[S-617]"
+    <> line
+    <> fillSep
+         [ flow "Specified snapshot as file path with"
+         , style File (fromString $ T.unpack t) <> ","
+         , flow "but not reading from a local file."
+         ]
+  pretty (InvalidSnapshot loc err) =
+    "[S-775]"
+    <> line
+    <> fillSep
+         [ flow "Exception while reading snapshot from"
+         , pretty loc <> ":"
+         ]
+    <> blankLine
+    <> string (displayException err)
+  pretty (MismatchedPackageMetadata loc pm mtreeKey foundIdent) =
+    "[S-427]"
+    <> line
+    <> fillSep
+         [ flow "Mismatched package metadata for"
+         , pretty loc <> "."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , let t = textDisplay pm
+           in  if T.null t
+                 then "nothing."
+                 else fromString $ T.unpack t <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Found:   "
+         , fromString $ packageIdentifierString foundIdent <> case mtreeKey of
+             Nothing -> "."
+             _ -> mempty
+         , case mtreeKey of
+             Nothing -> mempty
+             Just treeKey -> fillSep
+               [ "with tree"
+               , fromString . T.unpack $ textDisplay treeKey <> "."
+               ]
+         ])
+  pretty (Non200ResponseStatus status) =
+    "[S-571]"
+    <> line
+    <> fillSep
+         [ flow "Unexpected non-200 HTTP status code:"
+         , (fromString . show $ statusCode status) <> "."
+         ]
+  pretty (InvalidBlobKey Mismatch{..}) =
+    "[S-236]"
+    <> line
+    <> fillSep
+         [ flow "Invalid blob key found, expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> ","
+         , "actual:"
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ]
+  pretty (Couldn'tParseSnapshot sl err) =
+    "[S-645]"
+    <> line
+    <> fillSep
+         [ flow "Couldn't parse snapshot from"
+         , pretty sl <> ":"
+         ]
+    <> blankLine
+    <> string err
+  pretty (WrongCabalFileName loc sfp name) =
+    "[S-575]"
+    <> line
+    <> fillSep
+         [ flow "Wrong Cabal file name for package"
+         , pretty loc <> "."
+         , flow "The Cabal file is named"
+         , style File (fromString . T.unpack $ textDisplay sfp) <> ","
+         , flow "but package name is"
+         , fromString (packageNameString name) <> "."
+         , flow "For more information, see"
+         , style Url "https://github.com/commercialhaskell/stack/issues/317"
+         , "and"
+         , style Url "https://github.com/commercialhaskell/stack/issues/895" <> "."
+         ]
+  pretty (DownloadInvalidSHA256 url Mismatch {..}) =
+    "[S-394]"
+    <> line
+    <> fillSep
+         [ flow "Mismatched SHA256 hash from"
+         , style Url (fromString $ T.unpack url) <> "."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ])
+  pretty (DownloadInvalidSize url Mismatch {..}) =
+    "[S-401]"
+    <> line
+    <> fillSep
+         [ flow "Mismatched download size from"
+         , style Url (fromString $ T.unpack url) <> "."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ])
+  pretty (DownloadTooLarge url Mismatch {..}) =
+    "[S-113]"
+    <> line
+    <> fillSep
+         [ flow "Download from"
+         , style Url (fromString $ T.unpack url)
+         , flow "was too large. Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> ","
+         , flow "stopped after receiving:"
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ]
+  pretty (LocalInvalidSHA256 path Mismatch {..}) =
+    "[S-834]"
+    <> line
+    <> fillSep
+         [ flow "Mismatched SHA256 hash from"
+         , pretty path <> "."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ])
+  pretty (LocalInvalidSize path Mismatch {..}) =
+    "[S-713]"
+    <> line
+    <> fillSep
+         [ flow "Mismatched file size from"
+         , pretty path <> "."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ])
+  pretty (UnknownArchiveType loc) =
+    "[S-372]"
+    <> line
+    <> fillSep
+         [ flow "Unable to determine archive type of:"
+         , pretty loc <> "."
+         ]
+  pretty (InvalidTarFileType loc fp x) =
+    "[S-950]"
+    <> line
+    <> fillSep
+         [ flow "Unsupported tar file type in archive"
+         , pretty loc
+         , flow "at file"
+         , style File (fromString fp) <> ":"
+         , fromString $ show x <> "."
+         ]
+  pretty (UnsupportedTarball loc err) =
+    "[S-760]"
+    <> line
+    <> fillSep
+         [ flow "Unsupported tarball from"
+         , pretty loc <> ":"
+         ]
+    <> blankLine
+    <> string (T.unpack err)
+  pretty (NoHackageCryptographicHash ident) =
+    "[S-922]"
+    <> line
+    <> fillSep
+         [ flow "No cryptographic hash found for Hackage package"
+         , fromString (packageIdentifierString ident) <> "."
+         ]
+  pretty (FailedToCloneRepo repo) =
+    "[S-109]"
+    <> line
+    <> fillSep
+         [ flow "Failed to clone repository"
+         , fromString . T.unpack $ textDisplay repo
+         ]
+  pretty (TreeReferencesMissingBlob loc sfp key) =
+    "[S-237]"
+    <> line
+    <> fillSep
+         [ flow "The package"
+         , pretty loc
+         , flow "needs blob"
+         , fromString . T.unpack $ textDisplay key
+         , flow "for file path"
+         , style File (fromString . T.unpack $ textDisplay sfp) <> ","
+         , flow "but the blob is not available."
+         ]
+  pretty (CompletePackageMetadataMismatch loc pm) =
+    "[S-984]"
+    <> line
+    <> fillSep
+         [ flow "When completing package metadata for"
+         , pretty loc <> ","
+         , flow "some values changed in the new package metadata:"
+         , fromString . T.unpack $ textDisplay pm <> "."
+         ]
+  pretty (CRC32Mismatch loc fp Mismatch {..}) =
+    "[S-607]"
+    <> line
+    <> fillSep
+         [ flow "CRC32 mismatch in Zip file from"
+         , pretty loc
+         , flow "on internal file"
+         , style File (fromString fp)
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString . T.unpack $ textDisplay mismatchActual <> "."
+         ])
+  pretty (UnknownHackagePackage pir fuzzy) =
+    "[S-476]"
+    <> line
+    <> fillSep
+         [ flow "Could not find"
+         , style Error (fromString . T.unpack $ textDisplay pir)
+         , flow "on Hackage."
+         ]
+    <> prettyFuzzy fuzzy
+  pretty (CannotCompleteRepoNonSHA1 repo) =
+    "[S-112]"
+    <> line
+    <> fillSep
+         [ flow "Cannot complete repo information for a non SHA1 commit due to"
+         , "non-reproducibility:"
+         , fromString . T.unpack $ textDisplay repo <> "."
+         ]
+  pretty (MutablePackageLocationFromUrl t) =
+    "[S-321]"
+    <> line
+    <> fillSep
+         [ flow "Cannot refer to a mutable package location from a URL:"
+         , style Url (fromString $ T.unpack t) <> "."
+         ]
+  pretty (MismatchedCabalFileForHackage pir Mismatch{..}) =
+    "[S-377]"
+    <> line
+    <> fillSep
+         [ flow "When processing Cabal file for Hackage package"
+         , fromString . T.unpack $ textDisplay pir <> ","
+         , flow "mismatched package identifier."
+         ]
+    <> blankLine
+    <> hang 10 (fillSep
+         [ "Expected:"
+         , fromString (packageIdentifierString mismatchExpected) <> "."
+         ])
+    <> line
+    <> hang 10 (fillSep
+         [ "Actual:  "
+         , fromString (packageIdentifierString mismatchActual) <> "."
+         ])
+  pretty (PackageNameParseFail t) =
+    "[S-580]"
+    <> line
+    <> fillSep
+         [ flow "Invalid package name:"
+         , fromString $ T.unpack t <> "."
+         ]
+  pretty (PackageVersionParseFail t) =
+    "[S-479]"
+    <> line
+    <> fillSep
+         [ flow "Invalid version:"
+         , fromString $ T.unpack t <> "."
+         ]
+  pretty (InvalidCabalFilePath fp) =
+    "[S-824]"
+    <> line
+    <> fillSep
+         [ flow "File path contains a name which is not a valid package name:"
+         , pretty fp <> "."
+         ]
+  pretty (DuplicatePackageNames source pairs') =
+    "[S-674]"
+    <> line
+    <> fillSep
+         [ flow "Duplicate package names"
+         , parens (fromString . T.unpack $ textDisplay source) <> ":"
+         ]
+    <> line
+    <> foldMap
+         ( \(name, locs) ->
+                fromString (packageNameString name) <> ":"
+             <> line
+             <> bulletedList (map pretty locs)
+             <> line
+         )
+         pairs'
+  pretty (MigrationFailure desc fp err) =
+    "[S-536]"
+    <> line
+    <> fillSep
+         [ flow "Encountered error while migrating database"
+         , fromString $ T.unpack desc
+         , flow "located at"
+         , pretty fp <> ":"
+         ]
+    <> blankLine
+    <> string (displayException err)
+  pretty (ParseSnapNameException t) =
+    "[S-994]"
+    <> line
+    <> fillSep
+         [ flow "Invalid snapshot name:"
+         , fromString $ T.unpack t <> "."
+         ]
+  pretty (HpackLibraryException file err) =
+    "[S-305]"
+    <> line
+    <> fillSep
+         [ flow "Failed to generate a Cabal file using the Hpack library on"
+         , "file:"
+         , pretty file <> "."
+         , flow "The error encountered was:"
+         ]
+    <> blankLine
+    <> string err
+  pretty (HpackExeException fp dir err) =
+    "[S-720]"
+    <> line
+    <> fillSep
+         [ flow "Failed to generate a Cabal file using the Hpack executable:"
+         , style File (fromString fp)
+         , flow "in directory:"
+         , pretty dir <> "."
+         , flow "The error encountered was:"
+         ]
+    <> blankLine
+    <> string (displayException err)
+
+blankLine :: StyleDoc
+blankLine = line <> line
+
+data FuzzyResults
+  = FRNameNotFound ![PackageName]
+  | FRVersionNotFound !(NonEmpty PackageIdentifierRevision)
+  | FRRevisionNotFound !(NonEmpty PackageIdentifierRevision)
+
+displayFuzzy :: FuzzyResults -> Utf8Builder
+displayFuzzy (FRNameNotFound names) =
+  case NE.nonEmpty names of
+    Nothing -> ""
+    Just names' ->
+      "\nPerhaps you meant " <>
+      orSeparated (NE.map (fromString . packageNameString) names') <>
+      "?"
+displayFuzzy (FRVersionNotFound pirs) =
+  "\nPossible candidates: " <>
+  commaSeparated (NE.map display pirs) <>
+  "."
+displayFuzzy (FRRevisionNotFound pirs) =
+  "\nThe specified revision was not found.\nPossible candidates: " <>
+  commaSeparated (NE.map display pirs) <>
+  "."
+
+prettyFuzzy :: FuzzyResults -> StyleDoc
+prettyFuzzy (FRNameNotFound names) =
+  case NE.nonEmpty names of
+    Nothing -> mempty
+    Just names' ->
+         line
+      <> fillSep
+           ( flow "Perhaps you meant one of"
+           : mkNarrativeList Nothing False
+               (NE.toList $ NE.map (fromString . packageNameString) names' :: [StyleDoc])
+           )
+prettyFuzzy (FRVersionNotFound pirs) =
+     line
+  <> fillSep
+       ( flow "Possible candidates:"
+       : mkNarrativeList Nothing False
+           (NE.toList $ NE.map (fromString . T.unpack . textDisplay) pirs :: [StyleDoc])
+       )
+prettyFuzzy (FRRevisionNotFound pirs) =
+     line
+  <> fillSep
+       ( flow "The specified revision was not found. Possible candidates:"
+       : mkNarrativeList Nothing False
+           (NE.toList $ NE.map (fromString . T.unpack . textDisplay) pirs :: [StyleDoc])
+       )
+
+orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
+orSeparated xs
+  | NE.length xs == 1 = NE.head xs
+  | NE.length xs == 2 = NE.head xs <> " or " <> NE.last xs
+  | otherwise = fold (intersperse ", " (NE.init xs)) <> ", or " <> NE.last xs
+
+commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
+commaSeparated = fold . NE.intersperse ", "
+
+cabalSpecLatestVersion :: Version
+cabalSpecLatestVersion = mkVersion $ cabalSpecToVersionDigits cabalSpecLatest
+
+#if !MIN_VERSION_Cabal(3,4,0)
+cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
+cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]
+cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]
+cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]
+cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]
+cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]
+cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]
+cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]
+cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]
+cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]
+cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]
+cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]
+cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]
+cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]
+cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]
+cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]
+#endif
+
+data BuildFile
+  = BFCabal !SafeFilePath !TreeEntry
+  | BFHpack !TreeEntry
+    -- We don't need SafeFilePath for Hpack since it has to be package.yaml file
+  deriving (Show, Eq)
+
+data FileType = FTNormal | FTExecutable
+  deriving (Show, Eq, Enum, Bounded, Ord)
+
+instance PersistField FileType where
+  toPersistValue FTNormal = PersistInt64 1
+  toPersistValue FTExecutable = PersistInt64 2
+
+  fromPersistValue v = do
+    i <- fromPersistValue v
+    case i :: Int64 of
+      1 -> Right FTNormal
+      2 -> Right FTExecutable
+      _ -> Left $ "Invalid FileType: " <> tshow i
+
+instance PersistFieldSql FileType where
+  sqlType _ = SqlInt32
+
+data TreeEntry = TreeEntry
+  { teBlob :: !BlobKey
+  , teType :: !FileType
+  }
+  deriving (Show, Eq, Ord)
+
+newtype SafeFilePath = SafeFilePath Text
+  deriving (Show, Eq, Ord, Display)
+
+instance PersistField SafeFilePath where
+  toPersistValue = toPersistValue . unSafeFilePath
+  fromPersistValue v = do
+    t <- fromPersistValue v
+    maybe (Left $ "Invalid SafeFilePath: " <> t) Right $ mkSafeFilePath t
+
+instance PersistFieldSql SafeFilePath where
+  sqlType _ = SqlString
+
+unSafeFilePath :: SafeFilePath -> Text
+unSafeFilePath (SafeFilePath t) = t
+
+safeFilePathToPath :: (MonadThrow m) => Path Abs Dir -> SafeFilePath -> m (Path Abs File)
+safeFilePathToPath dir (SafeFilePath path) = do
+  fpath <- parseRelFile (T.unpack path)
+  pure $ dir </> fpath
+
+mkSafeFilePath :: Text -> Maybe SafeFilePath
+mkSafeFilePath t = do
+  guard $ not $ "\\" `T.isInfixOf` t
+  guard $ not $ "//" `T.isInfixOf` t
+  guard $ not $ "\n" `T.isInfixOf` t
+  guard $ not $ "\0" `T.isInfixOf` t
+
+  (c, _) <- T.uncons t
+  guard $ c /= '/'
+
+  guard $ (not . any (T.all (== '.'))) $ T.split (== '/') t
+
+  Just $ SafeFilePath t
+
+-- | SafeFilePath for `package.yaml` file.
+hpackSafeFilePath :: SafeFilePath
+hpackSafeFilePath =
+    let fpath = mkSafeFilePath (T.pack Hpack.packageConfig)
+    in case fpath of
+         Nothing -> error $
+           "hpackSafeFilePath: Not able to encode " <> Hpack.packageConfig
+         Just sfp -> sfp
+
+-- | The hash of the binary representation of a 'Tree'.
+--
+-- @since 0.1.0.0
+newtype TreeKey = TreeKey BlobKey
+  deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON, NFData, Display)
+
+-- | Represents the contents of a tree, which is a mapping from
+-- relative file paths to 'TreeEntry's.
+--
+-- @since 0.1.0.0
+newtype Tree
+  = TreeMap (Map SafeFilePath TreeEntry)
+  -- In the future, consider allowing more lax parsing
+  -- See: https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys
+  -- TreeTarball !PackageTarball
+  deriving (Show, Eq, Ord)
+
+renderTree :: Tree -> ByteString
+renderTree = BL.toStrict . toLazyByteString . go
+ where
+  go :: Tree -> Builder
+  go (TreeMap m) = "map:" <> Map.foldMapWithKey goEntry m
+
+  goEntry sfp (TreeEntry (BlobKey sha (FileSize size')) ft) =
+    netstring (unSafeFilePath sfp) <>
+    byteString (SHA256.toRaw sha) <>
+    netword size' <>
+    (case ft of
+      FTNormal -> "N"
+      FTExecutable -> "X")
+
+netstring :: Text -> Builder
+netstring t =
+  let bs = encodeUtf8 t
+  in  netword (fromIntegral (B.length bs)) <> byteString bs
+
+netword :: Word -> Builder
+netword w = wordDec w <> ":"
+
+parseTreeM :: MonadThrow m => (BlobKey, ByteString) -> m (TreeKey, Tree)
+parseTreeM (blobKey, blob) =
+  case parseTree blob of
+    Nothing -> throwM (InvalidTreeFromCasa blobKey blob)
+    Just tree -> pure (TreeKey blobKey, tree)
+
+parseTree :: ByteString -> Maybe Tree
+parseTree bs1 = do
+  tree <- parseTree' bs1
+  let bs2 = renderTree tree
+  guard $ bs1 == bs2
+  Just tree
+
+parseTree' :: ByteString -> Maybe Tree
+parseTree' bs0 = do
+  entriesBS <- B.stripPrefix "map:" bs0
+  TreeMap <$> loop Map.empty entriesBS
+ where
+  loop !m bs1
+    | B.null bs1 = pure m
+    | otherwise = do
+        (sfpBS, bs2) <- takeNetstring bs1
+        sfp <-
+          case decodeUtf8' sfpBS of
+            Left _ -> Nothing
+            Right sfpT -> mkSafeFilePath sfpT
+        (sha, bs3) <- takeSha bs2
+        (size', bs4) <- takeNetword bs3
+        (typeW, bs5) <- B.uncons bs4
+        ft <-
+          case typeW of
+            78 -> Just FTNormal -- 'N'
+            88 -> Just FTExecutable -- 'X'
+            _ -> Nothing
+        let entry = TreeEntry (BlobKey sha (FileSize (fromIntegral size'))) ft
+        loop (Map.insert sfp entry m) bs5
+
+  takeNetstring bs1 = do
+    (size', bs2) <- takeNetword bs1
+    guard $ B.length bs2 >= size'
+    Just $ B.splitAt size' bs2
+
+  takeSha bs = do
+    let (x, y) = B.splitAt 32 bs
+    x' <- either (const Nothing) Just (SHA256.fromRaw x)
+    Just (x', y)
+
+  takeNetword =
+    go 0
+   where
+    go !accum bs = do
+      (next, rest) <- B.uncons bs
+      if
+        | next == 58 -> pure (accum, rest) -- ':'
+        | next >= 48 && next <= 57 ->
+            go
+              (accum * 10 + fromIntegral (next - 48))
+              rest
+        | otherwise -> Nothing
+
+    {-
+data PackageTarball = PackageTarball
+  { ptBlob :: !BlobKey
+  -- ^ Contains the tarball itself
+  , ptCabal :: !BlobKey
+  -- ^ Contains the cabal file contents
+  , ptSubdir :: !FilePath
+  -- ^ Subdir containing the files we want for this package.
+  --
+  -- There must be precisely one file with a @.cabal@ file extension
+  -- located there. Thanks to Hackage revisions, its contents will be
+  -- overwritten by the value of @ptCabal@.
+  }
+  deriving Show
+    -}
+
+-- | This is almost a copy of Cabal's parser for package identifiers,
+-- the main difference is in the fact that Stack requires version to be
+-- present while Cabal uses "null version" as a default value
+--
+-- @since 0.1.0.0
+parsePackageIdentifier :: String -> Maybe PackageIdentifier
+parsePackageIdentifier = either (const Nothing) Just . explicitEitherParsec (packageIdentifierParsec <* Parse.eof)
+
+packageIdentifierParsec :: ParsecParser PackageIdentifier
+packageIdentifierParsec = do
+  ident@(PackageIdentifier _ v) <- parsec
+
+  -- version is a required component of a package identifier for Stack
+  guard (v /= nullVersion)
+
+  pure ident
+
+-- | Parse a package name from a 'String'.
+--
+-- @since 0.1.0.0
+parsePackageName :: String -> Maybe PackageName
+parsePackageName = Distribution.Text.simpleParse
+
+-- | Parse a package name from a 'String' throwing on failure
+--
+-- @since 0.1.0.0
+parsePackageNameThrowing :: MonadThrow m => String -> m PackageName
+parsePackageNameThrowing str =
+  case parsePackageName str of
+    Nothing -> throwM $ PackageNameParseFail $ T.pack str
+    Just pn -> pure pn
+
+-- | Parse a version from a 'String'.
+--
+-- @since 0.1.0.0
+parseVersion :: String -> Maybe Version
+parseVersion = Distribution.Text.simpleParse
+
+-- | Parse a package version from a 'String' throwing on failure
+--
+-- @since 0.1.0.0
+parseVersionThrowing :: MonadThrow m => String -> m Version
+parseVersionThrowing str =
+  case parseVersion str of
+    Nothing -> throwM $ PackageVersionParseFail $ T.pack str
+    Just v -> pure v
+
+-- | Parse a version range from a 'String'.
+--
+-- @since 0.1.0.0
+parseVersionRange :: String -> Maybe VersionRange
+parseVersionRange = Distribution.Text.simpleParse
+
+-- | Parse a module name from a 'String'.
+--
+-- @since 0.1.0.0
+parseModuleName :: String -> Maybe ModuleName
+parseModuleName = Distribution.Text.simpleParse
+
+-- | Parse a flag name from a 'String'.
+--
+-- @since 0.1.0.0
+parseFlagName :: String -> Maybe FlagName
+parseFlagName = Distribution.Text.simpleParse
+
+-- | Render a package name as a 'String'.
+--
+-- @since 0.1.0.0
+packageNameString :: PackageName -> String
+packageNameString = unPackageName
+
+-- | Render a package identifier as a 'String'.
+--
+-- @since 0.1.0.0
+packageIdentifierString :: PackageIdentifier -> String
+packageIdentifierString = Distribution.Text.display
+
+-- | Render a version as a 'String'.
+--
+-- @since 0.1.0.0
+versionString :: Version -> String
+versionString = Distribution.Text.display
+
+-- | Render a flag name as a 'String'.
+--
+-- @since 0.1.0.0
+flagNameString :: FlagName -> String
+flagNameString = unFlagName
+
+-- | Render a module name as a 'String'.
+--
+-- @since 0.1.0.0
+moduleNameString :: ModuleName -> String
+moduleNameString = Distribution.Text.display
+
+data OptionalSubdirs
+  = OSSubdirs !(NonEmpty Text)
+  | OSPackageMetadata !Text !RawPackageMetadata
+  -- ^ subdirectory and package metadata
+  deriving (Show, Eq, Generic)
+
+instance NFData OptionalSubdirs
+
+-- | Metadata provided by a config file for archives and repos. This information
+-- can be used for optimized lookups of information like package identifiers, or
+-- for validating that the user configuration has the expected information.
+--
+-- @since 0.1.0.0
+data RawPackageMetadata = RawPackageMetadata
+  { rpmName :: !(Maybe PackageName)
+    -- ^ Package name in the cabal file
+    --
+    -- @since 0.1.0.0
+  , rpmVersion :: !(Maybe Version)
+    -- ^ Package version in the cabal file
+    --
+    -- @since 0.1.0.0
+  , rpmTreeKey :: !(Maybe TreeKey)
+    -- ^ Tree key of the loaded up package
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Show, Eq, Ord, Generic, Typeable)
+
+instance NFData RawPackageMetadata
+
+instance Display RawPackageMetadata where
+  display rpm = fold $ intersperse ", " $ catMaybes
+    [ (\name -> "name == " <> fromString (packageNameString name)) <$> rpmName rpm
+    , (\version -> "version == " <> fromString (versionString version)) <$> rpmVersion rpm
+    , (\tree -> "tree == " <> display tree) <$> rpmTreeKey rpm
+    ]
+
+-- | Exact metadata specifying concrete package
+--
+-- @since 0.1.0.0
+data PackageMetadata = PackageMetadata
+  { pmIdent :: !PackageIdentifier
+    -- ^ Package identifier in the cabal file
+    --
+    -- @since 0.1.0.0
+  , pmTreeKey :: !TreeKey
+    -- ^ Tree key of the loaded up package
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Show, Eq, Ord, Generic, Typeable)
+
+-- i PackageMetadata
+instance NFData PackageMetadata
+
+instance Display PackageMetadata where
+  display pm = fold $ intersperse ", "
+    [ "ident == " <> fromString (packageIdentifierString $ pmIdent pm)
+    , "tree == " <> display (pmTreeKey pm)
+    ]
+
+parsePackageMetadata :: Object -> WarningParser PackageMetadata
+parsePackageMetadata o = do
+  _oldCabalFile :: Maybe BlobKey <- o ..:? "cabal-file"
+  pantryTree :: BlobKey <- o ..: "pantry-tree"
+  CabalString pkgName <- o ..: "name"
+  CabalString pkgVersion <- o ..: "version"
+  let pmTreeKey = TreeKey pantryTree
+      pmIdent = PackageIdentifier {..}
+  pure PackageMetadata {..}
+
+
+-- | Convert package metadata to its "raw" equivalent.
+--
+-- @since 0.1.0.0
+toRawPM :: PackageMetadata -> RawPackageMetadata
+toRawPM pm = RawPackageMetadata (Just name) (Just version) (Just $ pmTreeKey pm)
+ where
+  PackageIdentifier name version = pmIdent pm
+
+-- | File path relative to the configuration file it was parsed from
+--
+-- @since 0.1.0.0
+newtype RelFilePath = RelFilePath Text
+  deriving (Show, ToJSON, FromJSON, Eq, Ord, Generic, Typeable, NFData, Display)
+
+-- | Location that an archive is stored at
+--
+-- @since 0.1.0.0
+data ArchiveLocation
+  = ALUrl !Text
+    -- ^ Archive stored at an HTTP(S) URL
+    --
+    -- @since 0.1.0.0
+  | ALFilePath !(ResolvedPath File)
+    -- ^ Archive stored at a local file path
+    --
+    -- @since 0.1.0.0
+  deriving (Show, Eq, Ord, Generic, Typeable)
+
+instance NFData ArchiveLocation
+
+instance Display ArchiveLocation where
+  display (ALUrl url) = display url
+  display (ALFilePath resolved) =
+    fromString $ toFilePath $ resolvedAbsolute resolved
+
+instance Pretty ArchiveLocation where
+  pretty (ALUrl url) = style Url (fromString $ T.unpack url)
+  pretty (ALFilePath resolved) = pretty $ resolvedAbsolute resolved
+
+parseArchiveLocationObject ::
+     Object
+  -> WarningParser (Unresolved ArchiveLocation)
+parseArchiveLocationObject o =
+      ((o ..: "url") >>= either (fail . T.unpack) pure . validateUrl)
+  <|> ((o ..: "filepath") >>= either (fail . T.unpack) pure . validateFilePath)
+  <|> ((o ..: "archive") >>= either (fail . T.unpack) pure . parseArchiveLocationText)
+  <|> ((o ..: "location") >>= either (fail . T.unpack) pure . parseArchiveLocationText)
+
+parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
+parseArchiveLocationText t =
+  case validateUrl t of
+    Left e1 ->
+      case validateFilePath t of
+        Left e2 -> Left $ T.unlines
+          [ "Invalid archive location, neither a URL nor a file path"
+          , "  URL error: " <> e1
+          , "  File path error: " <> e2
+          ]
+        Right x -> Right x
+    Right x -> Right x
+
+validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
+validateUrl t =
+  case parseRequest $ T.unpack t of
+    Left _ -> Left $ "Could not parse URL: " <> t
+    Right _ -> pure $ pure $ ALUrl t
+
+validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
+validateFilePath t =
+  if any (`T.isSuffixOf` t) (T.words ".zip .tar .tar.gz")
+    then pure $ Unresolved $ \case
+      Nothing -> throwIO $ InvalidFilePathSnapshot t
+      Just dir -> do
+        abs' <- resolveFile dir $ T.unpack t
+        pure $ ALFilePath $ ResolvedPath (RelFilePath t) abs'
+    else Left $ "Does not have an archive file extension: " <> t
+
+instance ToJSON RawPackageLocation where
+  toJSON (RPLImmutable rpli) = toJSON rpli
+  toJSON (RPLMutable resolved) = toJSON (resolvedRelative resolved)
+
+instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))) where
+  parseJSON v =
+    (fmap . fmap . fmap . fmap) RPLImmutable (parseJSON v) <|>
+    (noJSONWarnings . mkMutable <$> parseJSON v)
+   where
+    mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
+    mkMutable t = Unresolved $ \mdir -> do
+      case mdir of
+        Nothing -> throwIO $ MutablePackageLocationFromUrl t
+        Just dir -> do
+          abs' <- resolveDir dir $ T.unpack t
+          pure $ pure $ RPLMutable $ ResolvedPath (RelFilePath t) abs'
+
+instance ToJSON RawPackageLocationImmutable where
+  toJSON (RPLIHackage pir mtree) = object $
+    ("hackage" .= pir) : maybe [] (\tree -> ["pantry-tree" .= tree]) mtree
+  toJSON (RPLIArchive (RawArchive loc msha msize subdir) rpm) = object $ concat
+    [ case loc of
+        ALUrl url -> ["url" .= url]
+        ALFilePath resolved -> ["filepath" .= resolvedRelative resolved]
+    , maybe [] (\sha -> ["sha256" .= sha]) msha
+    , maybe [] (\size' -> ["size" .= size']) msize
+    , [ "subdir" .= subdir | not (T.null subdir) ]
+    , rpmToPairs rpm
+    ]
+  toJSON (RPLIRepo (Repo url commit typ subdir) rpm) = object $ concat
+    [ [ urlKey .= url
+      , "commit" .= commit
+      ]
+    , ["subdir" .= subdir | not (T.null subdir) ]
+    , rpmToPairs rpm
+    ]
+   where
+    urlKey =
+      case typ of
+        RepoGit -> "git"
+        RepoHg  -> "hg"
+
+rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
+rpmToPairs (RawPackageMetadata mname mversion mtree) = concat
+  [ maybe [] (\name -> ["name" .= CabalString name]) mname
+  , maybe [] (\version -> ["version" .= CabalString version]) mversion
+  , maybe [] (\tree -> ["pantry-tree" .= tree]) mtree
+  ]
+
+instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where
+  parseJSON v =
+        repoObject v
+    <|> archiveObject v
+    <|> hackageObject v
+    <|> github v
+    <|> fail ("Could not parse a UnresolvedPackageLocationImmutable from: " ++ show v)
+   where
+    repoObject ::
+         Value
+      -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
+    repoObject =
+      withObjectWarnings "UnresolvedPackageLocationImmutable.PLIRepo" $ \o -> do
+        pm <- parsePackageMetadata o
+        repoSubdir <- o ..:? "subdir" ..!= ""
+        repoCommit <- o ..: "commit"
+        (repoType, repoUrl) <-
+            (o ..: "git" >>= \url -> pure (RepoGit, url)) <|>
+            (o ..: "hg" >>= \url -> pure (RepoHg, url))
+        pure $ pure $ PLIRepo Repo {..} pm
+
+    archiveObject =
+      withObjectWarnings "UnresolvedPackageLocationImmutable.PLIArchive" $ \o -> do
+        pm <- parsePackageMetadata o
+        Unresolved mkArchiveLocation <- parseArchiveLocationObject o
+        archiveHash <- o ..: "sha256"
+        archiveSize <- o ..: "size"
+        archiveSubdir <- o ..:? "subdir" ..!= ""
+        pure $ Unresolved $ \mdir -> do
+          archiveLocation <- mkArchiveLocation mdir
+          pure $ PLIArchive Archive {..} pm
+
+    hackageObject =
+      withObjectWarnings "UnresolvedPackagelocationimmutable.PLIHackage (Object)" $ \o -> do
+        treeKey <- o ..: "pantry-tree"
+        htxt <- o ..: "hackage"
+        case parseHackageText htxt of
+          Left e -> fail $ show e
+          Right (pkgIdentifier, blobKey) ->
+            pure $ pure $ PLIHackage pkgIdentifier blobKey (TreeKey treeKey)
+
+    github =
+      withObjectWarnings "UnresolvedPackagelocationimmutable.PLIArchive:github" (\o -> do
+        pm <- parsePackageMetadata o
+        GitHubRepo ghRepo <- o ..: "github"
+        commit <- o ..: "commit"
+        let archiveLocation = ALUrl $ T.concat
+              [ "https://github.com/"
+              , ghRepo
+              , "/archive/"
+              , commit
+              , ".tar.gz"
+              ]
+        archiveHash <- o ..: "sha256"
+        archiveSize <- o ..: "size"
+        archiveSubdir <- o ..:? "subdir" ..!= ""
+        pure $ pure $ PLIArchive Archive {..} pm)
+
+instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable))) where
+  parseJSON v =
+        http v
+    <|> hackageText v
+    <|> hackageObject v
+    <|> repo v
+    <|> archiveObject v
+    <|> github v
+    <|> fail ("Could not parse a UnresolvedRawPackageLocationImmutable from: " ++ show v)
+   where
+    http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
+    http = withText "UnresolvedPackageLocationImmutable.RPLIArchive (Text)" $ \t ->
+      case parseArchiveLocationText t of
+        Left _ -> fail $ "Invalid archive location: " ++ T.unpack t
+        Right (Unresolved mkArchiveLocation) ->
+          pure $ noJSONWarnings $ Unresolved $ \mdir -> do
+            raLocation <- mkArchiveLocation mdir
+            let raHash = Nothing
+                raSize = Nothing
+                raSubdir = T.empty
+            pure $ pure $ RPLIArchive RawArchive {..} rpmEmpty
+
+    hackageText = withText "UnresolvedPackageLocationImmutable.UPLIHackage (Text)" $ \t ->
+      case parsePackageIdentifierRevision t of
+        Left e -> fail $ show e
+        Right pir -> pure $ noJSONWarnings $ pure $ pure $ RPLIHackage pir Nothing
+
+    hackageObject = withObjectWarnings "UnresolvedPackageLocationImmutable.UPLIHackage" $ \o -> pure . pure <$> (RPLIHackage
+      <$> o ..: "hackage"
+      <*> o ..:? "pantry-tree")
+
+    optionalSubdirs :: Object -> WarningParser OptionalSubdirs
+    optionalSubdirs o =
+      -- if subdirs exists, it needs to be valid
+      case HM.lookup "subdirs" o of
+        Just v' -> do
+          tellJSONField "subdirs"
+          subdirs <- lift $ parseJSON v'
+          case NE.nonEmpty subdirs of
+            Nothing -> fail "Invalid empty subdirs"
+            Just x -> pure $ OSSubdirs x
+        Nothing -> OSPackageMetadata
+          <$> o ..:? "subdir" ..!= T.empty
+          <*> (   rawPackageMetadataHelper
+              <$> (fmap unCabalString <$> (o ..:? "name"))
+              <*> (fmap unCabalString <$> (o ..:? "version"))
+              <*> o ..:? "pantry-tree"
+              <*> o ..:? "cabal-file"
+              )
+
+    rawPackageMetadataHelper ::
+         Maybe PackageName
+      -> Maybe Version
+      -> Maybe TreeKey
+      -> Maybe BlobKey
+      -> RawPackageMetadata
+    rawPackageMetadataHelper name version pantryTree _ignoredCabalFile =
+      RawPackageMetadata name version pantryTree
+
+    repo = withObjectWarnings "UnresolvedPackageLocationImmutable.UPLIRepo" $ \o -> do
+      (repoType, repoUrl) <-
+        ((RepoGit, ) <$> o ..: "git") <|>
+        ((RepoHg, ) <$> o ..: "hg")
+      repoCommit <- o ..: "commit"
+      os <- optionalSubdirs o
+      pure $ pure $ NE.map (\(repoSubdir, pm) -> RPLIRepo Repo {..} pm) (osToRpms os)
+
+    archiveObject = withObjectWarnings "UnresolvedPackageLocationImmutable.RPLIArchive" $ \o -> do
+      Unresolved mkArchiveLocation <- parseArchiveLocationObject o
+      raHash <- o ..:? "sha256"
+      raSize <- o ..:? "size"
+      os <- optionalSubdirs o
+      pure $ Unresolved $ \mdir -> do
+        raLocation <- mkArchiveLocation mdir
+        pure $ NE.map (\(raSubdir, pm) -> RPLIArchive RawArchive {..} pm) (osToRpms os)
+
+    github = withObjectWarnings "PLArchive:github" $ \o -> do
+      GitHubRepo ghRepo <- o ..: "github"
+      commit <- o ..: "commit"
+      let raLocation = ALUrl $ T.concat
+            [ "https://github.com/"
+            , ghRepo
+            , "/archive/"
+            , commit
+            , ".tar.gz"
+            ]
+      raHash <- o ..:? "sha256"
+      raSize <- o ..:? "size"
+      os <- optionalSubdirs o
+      pure $ pure $
+        NE.map (\(raSubdir, pm) -> RPLIArchive RawArchive {..} pm) (osToRpms os)
+
+-- | Returns pairs of subdirectory and 'PackageMetadata'.
+osToRpms :: OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
+osToRpms (OSSubdirs subdirs) = NE.map (, rpmEmpty) subdirs
+osToRpms (OSPackageMetadata subdir rpm) = pure (subdir, rpm)
+
+rpmEmpty :: RawPackageMetadata
+rpmEmpty = RawPackageMetadata Nothing Nothing Nothing
+
+-- | Newtype wrapper for easier JSON integration with Cabal types.
+--
+-- @since 0.1.0.0
+newtype CabalString a = CabalString { unCabalString :: a }
+  deriving (Show, Eq, Ord, Typeable)
+
+-- I'd like to use coerce here, but can't due to roles. unsafeCoerce
+-- could work, but let's avoid unsafe code.
+
+-- | Wrap the keys in a 'Map' with a 'CabalString' to get a 'ToJSON'
+-- instance.
+--
+-- @since 0.1.0.0
+toCabalStringMap :: Map a v -> Map (CabalString a) v
+toCabalStringMap = Map.mapKeysMonotonic CabalString
+
+-- | Unwrap the 'CabalString' from the keys in a 'Map' to use a
+-- 'FromJSON' instance.
+--
+-- @since 0.1.0.0
+unCabalStringMap :: Map (CabalString a) v -> Map a v
+unCabalStringMap = Map.mapKeysMonotonic unCabalString
+
+instance Distribution.Pretty.Pretty a => ToJSON (CabalString a) where
+  toJSON = toJSON . Distribution.Text.display . unCabalString
+
+instance Distribution.Pretty.Pretty a => ToJSONKey (CabalString a) where
+  toJSONKey = toJSONKeyText $ T.pack . Distribution.Text.display . unCabalString
+
+instance forall a. IsCabalString a => FromJSON (CabalString a) where
+  parseJSON = withText name $ \t ->
+    case cabalStringParser $ T.unpack t of
+      Nothing -> fail $ "Invalid " ++ name ++ ": " ++ T.unpack t
+      Just x -> pure $ CabalString x
+   where
+    name = cabalStringName (Nothing :: Maybe a)
+
+instance forall a. IsCabalString a => FromJSONKey (CabalString a) where
+  fromJSONKey =
+    FromJSONKeyTextParser $ \t ->
+    case cabalStringParser $ T.unpack t of
+      Nothing -> fail $ "Invalid " ++ name ++ ": " ++ T.unpack t
+      Just x -> pure $ CabalString x
+   where
+    name = cabalStringName (Nothing :: Maybe a)
+
+class IsCabalString a where
+  cabalStringName :: proxy a -> String
+  cabalStringParser :: String -> Maybe a
+
+instance IsCabalString PackageName where
+  cabalStringName _ = "package name"
+  cabalStringParser = parsePackageName
+
+instance IsCabalString Version where
+  cabalStringName _ = "version"
+  cabalStringParser = parseVersion
+
+instance IsCabalString VersionRange where
+  cabalStringName _ = "version range"
+  cabalStringParser = parseVersionRange
+
+instance IsCabalString PackageIdentifier where
+  cabalStringName _ = "package identifier"
+  cabalStringParser = parsePackageIdentifier
+
+instance IsCabalString FlagName where
+  cabalStringName _ = "flag name"
+  cabalStringParser = parseFlagName
+
+-- | What to use for running hpack
+--
+-- @since 0.1.0.0
+data HpackExecutable
+  = HpackBundled
+    -- ^ Compiled in library
+  | HpackCommand !FilePath
+    -- ^ Executable at the provided path
+  deriving (Show, Read, Eq, Ord)
+
+
+-- | Which compiler a snapshot wants to use. The build tool may elect to do some
+-- fuzzy matching of versions (e.g., allowing different patch versions).
+--
+-- @since 0.1.0.0
+data WantedCompiler
+  = WCGhc !Version
+  | WCGhcGit !Text !Text
+  | WCGhcjs
+      !Version
+      !Version
+    -- ^ GHCJS version followed by GHC version
+  deriving (Show, Eq, Ord, Generic)
+
+instance NFData WantedCompiler
+
+instance Display WantedCompiler where
+  display (WCGhc vghc) = "ghc-" <> fromString (versionString vghc)
+  display (WCGhcjs vghcjs vghc) =
+       "ghcjs-"
+    <> fromString (versionString vghcjs)
+    <> "_ghc-" <> fromString (versionString vghc)
+  display (WCGhcGit commit flavour) =
+    "ghc-git-" <> display commit <> "-" <> display flavour
+
+instance ToJSON WantedCompiler where
+  toJSON = toJSON . utf8BuilderToText . display
+
+instance FromJSON WantedCompiler where
+  parseJSON =
+    withText "WantedCompiler" $ either (fail . show) pure . parseWantedCompiler
+
+instance FromJSONKey WantedCompiler where
+  fromJSONKey =
+    FromJSONKeyTextParser $ \t ->
+    case parseWantedCompiler t of
+      Left e -> fail $ "Invalid WantedCompiler " ++ show t ++ ": " ++ show e
+      Right x -> pure x
+
+-- | Parse a 'Text' into a 'WantedCompiler' value.
+--
+-- @since 0.1.0.0
+parseWantedCompiler :: Text -> Either PantryException WantedCompiler
+parseWantedCompiler t0 = maybe (Left $ InvalidWantedCompiler t0) Right $
+  case T.stripPrefix "ghcjs-" t0 of
+    Just t1 -> parseGhcjs t1
+    Nothing -> case T.stripPrefix "ghc-git-" t0 of
+       Just t1 -> parseGhcGit t1
+       Nothing -> T.stripPrefix "ghc-" t0 >>= parseGhc
+ where
+  parseGhcjs t1 = do
+    let (ghcjsVT, t2) = T.break (== '_') t1
+    ghcjsV <- parseVersion $ T.unpack ghcjsVT
+    ghcVT <- T.stripPrefix "_ghc-" t2
+    ghcV <- parseVersion $ T.unpack ghcVT
+    pure $ WCGhcjs ghcjsV ghcV
+  parseGhcGit t1 = do
+    let (commit, flavour) = T.break (== '-') t1
+    pure $ WCGhcGit commit (T.drop 1 flavour)
+  parseGhc = fmap WCGhc . parseVersion . T.unpack
+
+instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLocation)) where
+  parseJSON v = text v <|> obj v
+   where
+    text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
+    text =
+      withText "UnresolvedSnapshotLocation (Text)" $
+        pure . noJSONWarnings . parseRawSnapshotLocation
+
+    obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
+    obj = withObjectWarnings "UnresolvedSnapshotLocation (Object)" $ \o ->
+      (pure . RSLCompiler <$> o ..: "compiler") <|>
+      ((\x y -> pure $ RSLUrl x y) <$> o ..: "url" <*> blobKey o) <|>
+      (parseRawSnapshotLocationPath <$> o ..: "filepath")
+
+    blobKey o = do
+      msha <- o ..:? "sha256"
+      msize <- o ..:? "size"
+      case (msha, msize) of
+        (Nothing, Nothing) -> pure Nothing
+        (Just sha, Just size') -> pure $ Just $ BlobKey sha size'
+        (Just _sha, Nothing) -> fail "You must also specify the file size"
+        (Nothing, Just _) -> fail "You must also specify the file's SHA256"
+
+instance Display SnapshotLocation where
+  display (SLCompiler compiler) = display compiler
+  display (SLUrl url blob) = display url <> " (" <> display blob <> ")"
+  display (SLFilePath resolved) = display (resolvedRelative resolved)
+
+-- | Parse a 'Text' into an 'Unresolved' 'RawSnapshotLocation'.
+--
+-- @since 0.1.0.0
+parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
+parseRawSnapshotLocation t0 = fromMaybe (parseRawSnapshotLocationPath t0) $
+  either (const Nothing) (Just . pure . RSLCompiler) (parseWantedCompiler t0) <|>
+  (pure . RSLSynonym <$> parseSnapName t0) <|>
+  parseGitHub <|>
+  parseUrl
+ where
+  parseGitHub = do
+    t1 <- T.stripPrefix "github:" t0
+    let (user, t2) = T.break (== '/') t1
+    t3 <- T.stripPrefix "/" t2
+    let (repo, t4) = T.break (== ':') t3
+    path <- T.stripPrefix ":" t4
+    Just $ pure $ githubSnapshotLocation user repo path
+
+  parseUrl = parseRequest (T.unpack t0) $> pure (RSLUrl t0 Nothing)
+
+parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
+parseRawSnapshotLocationPath t =
+  Unresolved $ \case
+    Nothing -> throwIO $ InvalidFilePathSnapshot t
+    Just dir -> do
+      abs' <- resolveFile dir (T.unpack t) `catchAny` \_ -> throwIO (InvalidSnapshotLocation dir t)
+      pure $ RSLFilePath $ ResolvedPath (RelFilePath t) abs'
+
+githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
+githubSnapshotLocation user repo path =
+  let url = T.concat
+        [ "https://raw.githubusercontent.com/"
+        , user
+        , "/"
+        , repo
+        , "/master/"
+        , path
+        ]
+  in  RSLUrl url Nothing
+
+defUser :: Text
+defUser = "commercialhaskell"
+
+defRepo :: Text
+defRepo = "stackage-snapshots"
+
+-- | Default location of snapshot synonyms, i.e. commercialhaskell's GitHub
+-- repository.
+--
+-- @since 0.5.0.0
+defaultSnapshotLocation ::
+     SnapName
+  -> RawSnapshotLocation
+defaultSnapshotLocation (LTS x y) =
+  githubSnapshotLocation defUser defRepo $
+  utf8BuilderToText $
+  "lts/" <> display x <> "/" <> display y <> ".yaml"
+defaultSnapshotLocation (Nightly date) =
+     githubSnapshotLocation defUser defRepo
+  $  utf8BuilderToText
+  $  "nightly/"
+  <> display year
+  <> "/"
+  <> display month
+  <> "/"
+  <> display day
+  <> ".yaml"
+ where
+  (year, month, day) = toGregorian date
+
+-- | A snapshot synonym. It is expanded according to the field
+-- 'snapshotLocation' of a 'PantryConfig'.
+--
+-- @ since 0.5.0.0
+data SnapName
+    = LTS
+        !Int -- ^ Major version
+        !Int -- ^ Minor version
+      -- ^ LTS Haskell snapshot, displayed as @"lts-maj.min"@.
+      --
+      -- @since 0.5.0.0
+    | Nightly !Day
+      -- ^ Stackage Nightly snapshot, displayed as @"nighly-YYYY-MM-DD"@.
+      --
+      -- @since 0.5.0.0
+    deriving (Eq, Ord, Generic)
+
+instance NFData SnapName
+
+instance Display SnapName where
+  display (LTS x y) = "lts-" <> display x <> "." <> display y
+  display (Nightly date) = "nightly-" <> displayShow date
+
+instance Show SnapName where
+  show = T.unpack . utf8BuilderToText . display
+
+instance ToJSON SnapName where
+  toJSON syn = String $ utf8BuilderToText $ display syn
+
+-- | Parse the short representation of a 'SnapName'.
+--
+-- @since 0.5.0.0
+parseSnapName :: MonadThrow m => Text -> m SnapName
+parseSnapName t0 =
+  case lts <|> nightly of
+    Nothing -> throwM $ ParseSnapNameException t0
+    Just sn -> pure sn
+ where
+  lts = do
+    t1 <- T.stripPrefix "lts-" t0
+    Right (x, t2) <- Just $ decimal t1
+    t3 <- T.stripPrefix "." t2
+    Right (y, "") <- Just $ decimal t3
+    pure $ LTS x y
+  nightly = do
+    t1 <- T.stripPrefix "nightly-" t0
+    Nightly <$> readMaybe (T.unpack t1)
+
+-- | Where to load a snapshot from in raw form (RSUrl could have a missing
+-- BlobKey)
+--
+-- @since 0.1.0.0
+data RawSnapshotLocation
+  = RSLCompiler !WantedCompiler
+    -- ^ Don't use an actual snapshot, just a version of the compiler with its
+    -- shipped packages.
+    --
+    -- @since 0.1.0.0
+  | RSLUrl !Text !(Maybe BlobKey)
+    -- ^ Download the snapshot from the given URL. The optional 'BlobKey' is
+    -- used for reproducibility.
+    --
+    -- @since 0.1.0.0
+  | RSLFilePath !(ResolvedPath File)
+    -- ^ Snapshot at a local file path.
+    --
+    -- @since 0.1.0.0
+  | RSLSynonym !SnapName
+    -- ^ Snapshot synonym (LTS/Nightly).
+    --
+    -- @since 0.5.0.0
+  deriving (Show, Eq, Ord, Generic)
+
+instance NFData RawSnapshotLocation
+
+instance Display RawSnapshotLocation where
+  display (RSLCompiler compiler) = display compiler
+  display (RSLUrl url Nothing) = display url
+  display (RSLUrl url (Just blob)) = display url <> " (" <> display blob <> ")"
+  display (RSLFilePath resolved) = display (resolvedRelative resolved)
+  display (RSLSynonym syn) = display syn
+
+instance Pretty RawSnapshotLocation where
+  pretty (RSLCompiler compiler) = fromString . T.unpack $ textDisplay compiler
+  pretty (RSLUrl url Nothing) = style Url (fromString $ T.unpack url)
+  pretty (RSLUrl url (Just blob)) = fillSep
+    [ style Url (fromString $ T.unpack  url)
+    , parens (fromString . T.unpack $ textDisplay blob)
+    ]
+  pretty (RSLFilePath resolved) =
+    style File (fromString . T.unpack $ textDisplay (resolvedRelative resolved))
+  pretty (RSLSynonym syn) =
+    style Shell (fromString . T.unpack $ textDisplay syn)
+
+instance ToJSON RawSnapshotLocation where
+  toJSON (RSLCompiler compiler) = object ["compiler" .= compiler]
+  toJSON (RSLUrl url mblob) = object
+    $ "url" .= url
+    : maybe [] blobKeyPairs mblob
+  toJSON (RSLFilePath resolved) =
+    object ["filepath" .= resolvedRelative resolved]
+  toJSON (RSLSynonym syn) = toJSON syn
+
+-- | Where to load a snapshot from.
+--
+-- @since 0.1.0.0
+data SnapshotLocation
+  = SLCompiler !WantedCompiler
+    -- ^ Don't use an actual snapshot, just a version of the compiler
+    -- with its shipped packages.
+    --
+    -- @since 0.1.0.0
+  | SLUrl !Text !BlobKey
+    -- ^ Download the snapshot from the given URL. The optional
+    -- 'BlobKey' is used for reproducibility.
+    --
+    -- @since 0.1.0.0
+  | SLFilePath !(ResolvedPath File)
+    -- ^ Snapshot at a local file path.
+    --
+    -- @since 0.1.0.0
+  deriving (Show, Eq, Ord, Generic)
+
+instance NFData SnapshotLocation
+
+instance ToJSON SnapshotLocation where
+  toJSON sl = toJSON (toRawSL sl)
+
+instance FromJSON (WithJSONWarnings (Unresolved SnapshotLocation)) where
+  parseJSON v = file v <|> url v <|> compiler v
+   where
+    file = withObjectWarnings "SLFilepath" $ \o -> do
+      ufp <- o ..: "filepath"
+      pure $ Unresolved $ \case
+        Nothing -> throwIO $ InvalidFilePathSnapshot ufp
+        Just dir -> do
+          absolute <- resolveFile dir (T.unpack ufp)
+          let fp = ResolvedPath (RelFilePath ufp) absolute
+          pure $ SLFilePath fp
+    url = withObjectWarnings "SLUrl" $ \o -> do
+      url' <- o ..: "url"
+      sha <- o ..: "sha256"
+      size <- o ..: "size"
+      pure $ Unresolved $ \_ -> pure $ SLUrl url' (BlobKey sha size)
+    compiler = withObjectWarnings "SLCompiler" $ \o -> do
+      c <- o ..: "compiler"
+      pure $ Unresolved $ \_ -> pure $ SLCompiler c
+
+-- | Convert snapshot location to its "raw" equivalent.
+--
+-- @since 0.1.0.0
+toRawSL :: SnapshotLocation -> RawSnapshotLocation
+toRawSL (SLCompiler c) = RSLCompiler c
+toRawSL (SLUrl url blob) = RSLUrl url (Just blob)
+toRawSL (SLFilePath fp) = RSLFilePath fp
+
+-- | A flattened representation of all the layers in a snapshot.
+--
+-- @since 0.1.0.0
+data RawSnapshot = RawSnapshot
+  { rsCompiler :: !WantedCompiler
+    -- ^ The compiler wanted for this snapshot.
+  , rsPackages :: !(Map PackageName RawSnapshotPackage)
+    -- ^ Packages available in this snapshot for installation. This will be
+    -- applied on top of any globally available packages.
+  , rsDrop :: !(Set PackageName)
+    -- ^ Global packages that should be dropped/ignored.
+  }
+
+-- | A flattened representation of all the layers in a snapshot.
+--
+-- @since 0.1.0.0
+data Snapshot = Snapshot
+  { snapshotCompiler :: !WantedCompiler
+    -- ^ The compiler wanted for this snapshot.
+  , snapshotPackages :: !(Map PackageName SnapshotPackage)
+    -- ^ Packages available in this snapshot for installation. This will be
+    -- applied on top of any globally available packages.
+  , snapshotDrop :: !(Set PackageName)
+    -- ^ Global packages that should be dropped/ignored.
+  }
+
+-- | Settings for a package found in a snapshot.
+--
+-- @since 0.1.0.0
+data RawSnapshotPackage = RawSnapshotPackage
+  { rspLocation :: !RawPackageLocationImmutable
+    -- ^ Where to get the package from
+  , rspFlags :: !(Map FlagName Bool)
+    -- ^ Same as 'slFlags'
+  , rspHidden :: !Bool
+    -- ^ Same as 'slHidden'
+  , rspGhcOptions :: ![Text]
+    -- ^ Same as 'slGhcOptions'
+  }
+
+-- | Settings for a package found in a snapshot.
+--
+-- @since 0.1.0.0
+data SnapshotPackage = SnapshotPackage
+  { spLocation :: !PackageLocationImmutable
+    -- ^ Where to get the package from
+  , spFlags :: !(Map FlagName Bool)
+    -- ^ Same as 'slFlags'
+  , spHidden :: !Bool
+    -- ^ Same as 'slHidden'
+  , spGhcOptions :: ![Text]
+    -- ^ Same as 'slGhcOptions'
+  }
+  deriving Show
+
+-- | A single layer of a snapshot, i.e. a specific YAML configuration file.
+--
+-- @since 0.1.0.0
+data RawSnapshotLayer = RawSnapshotLayer
+  { rslParent :: !RawSnapshotLocation
+    -- ^ The sl to extend from. This is either a specific compiler, or a
+    -- @SnapshotLocation@ which gives us more information (like packages).
+    -- Ultimately, we'll end up with a @CompilerVersion@.
+    --
+    -- @since 0.1.0.0
+  , rslCompiler :: !(Maybe WantedCompiler)
+    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if
+    -- using 'SLCompiler'.
+    --
+    -- @since 0.1.0.0
+  , rslLocations :: ![RawPackageLocationImmutable]
+    -- ^ Where to grab all of the packages from.
+    --
+    -- @since 0.1.0.0
+  , rslDropPackages :: !(Set PackageName)
+    -- ^ Packages present in the parent which should not be included here.
+    --
+    -- @since 0.1.0.0
+  , rslFlags :: !(Map PackageName (Map FlagName Bool))
+    -- ^ Flag values to override from the defaults
+    --
+    -- @since 0.1.0.0
+  , rslHidden :: !(Map PackageName Bool)
+    -- ^ Packages which should be hidden when registering. This will affect, for
+    -- example, the import parser in the script command. We use a 'Map' instead
+    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.
+    --
+    -- @since 0.1.0.0
+  , rslGhcOptions :: !(Map PackageName [Text])
+    -- ^ GHC options per package
+    --
+    -- @since 0.1.0.0
+  , rslPublishTime :: !(Maybe UTCTime)
+    -- ^ See 'slPublishTime'
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Show, Eq, Generic)
+
+instance NFData RawSnapshotLayer
+
+instance ToJSON RawSnapshotLayer where
+  toJSON rsnap = object $ concat
+    [ ["resolver" .= rslParent rsnap]
+    , maybe [] (\compiler -> ["compiler" .= compiler]) (rslCompiler rsnap)
+    , ["packages" .= rslLocations rsnap]
+    , [ "drop-packages" .= Set.map CabalString (rslDropPackages rsnap)
+      | not (Set.null (rslDropPackages rsnap))
+      ]
+    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap (rslFlags rsnap))
+      | not(Map.null (rslFlags rsnap))
+      ]
+    , [ "hidden" .= toCabalStringMap (rslHidden rsnap)
+      | not (Map.null (rslHidden rsnap))
+      ]
+    , [ "ghc-options" .= toCabalStringMap (rslGhcOptions rsnap)
+      | not (Map.null (rslGhcOptions rsnap))
+      ]
+    , maybe [] (\time -> ["publish-time" .= time]) (rslPublishTime rsnap)
+    ]
+
+instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
+  parseJSON = withObjectWarnings "Snapshot" $ \o -> do
+    _ :: Maybe Text <- o ..:? "name" -- avoid warnings for old snapshot format
+    mcompiler <- o ..:? "compiler"
+    mresolver <- jsonSubWarningsT $ o ...:? ["snapshot", "resolver"]
+    unresolvedSnapshotParent <-
+      case (mcompiler, mresolver) of
+        (Nothing, Nothing) -> fail "Snapshot must have either resolver or compiler"
+        (Just compiler, Nothing) -> pure $ pure (RSLCompiler compiler, Nothing)
+        (_, Just (Unresolved usl)) -> pure $ Unresolved $ \mdir -> do
+          sl <- usl mdir
+          case (sl, mcompiler) of
+            (RSLCompiler c1, Just c2) -> throwIO $ InvalidOverrideCompiler c1 c2
+            _ -> pure (sl, mcompiler)
+
+    unresolvedLocs <- jsonSubWarningsT (o ..:? "packages" ..!= [])
+    rslDropPackages <- Set.map unCabalString <$> (o ..:? "drop-packages" ..!= Set.empty)
+    rslFlags <- unCabalStringMap . fmap unCabalStringMap <$> (o ..:? "flags" ..!= Map.empty)
+    rslHidden <- unCabalStringMap <$> (o ..:? "hidden" ..!= Map.empty)
+    rslGhcOptions <- unCabalStringMap <$> (o ..:? "ghc-options" ..!= Map.empty)
+    rslPublishTime <- o ..:? "publish-time"
+    pure $ (\rslLocations (rslParent, rslCompiler) -> RawSnapshotLayer {..})
+      <$> (concatMap NE.toList <$> sequenceA unresolvedLocs)
+      <*> unresolvedSnapshotParent
+
+-- | A single layer of a snapshot, i.e. a specific YAML configuration file.
+--
+-- @since 0.1.0.0
+data SnapshotLayer = SnapshotLayer
+  { slParent :: !SnapshotLocation
+    -- ^ The sl to extend from. This is either a specific compiler, or a
+    -- @SnapshotLocation@ which gives us more information (like packages).
+    -- Ultimately, we'll end up with a @CompilerVersion@.
+    --
+    -- @since 0.1.0.0
+  , slCompiler :: !(Maybe WantedCompiler)
+    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if
+    -- using 'SLCompiler'.
+    --
+    -- @since 0.1.0.0
+  , slLocations :: ![PackageLocationImmutable]
+    -- ^ Where to grab all of the packages from.
+    --
+    -- @since 0.1.0.0
+  , slDropPackages :: !(Set PackageName)
+    -- ^ Packages present in the parent which should not be included here.
+    --
+    -- @since 0.1.0.0
+  , slFlags :: !(Map PackageName (Map FlagName Bool))
+    -- ^ Flag values to override from the defaults
+    --
+    -- @since 0.1.0.0
+  , slHidden :: !(Map PackageName Bool)
+    -- ^ Packages which should be hidden when registering. This will affect, for
+    -- example, the import parser in the script command. We use a 'Map' instead
+    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.
+    --
+    -- @since 0.1.0.0
+  , slGhcOptions :: !(Map PackageName [Text])
+    -- ^ GHC options per package
+    --
+    -- @since 0.1.0.0
+  , slPublishTime :: !(Maybe UTCTime)
+    -- ^ Publication timestamp for this snapshot. This field is optional, and is
+    -- for informational purposes only.
+    --
+    -- @since 0.1.0.0
+  }
+  deriving (Show, Eq, Generic)
+
+instance ToJSON SnapshotLayer where
+  toJSON snap = object $ concat
+    [ ["resolver" .= slParent snap]
+    , maybe [] (\compiler -> ["compiler" .= compiler]) (slCompiler snap)
+    , ["packages" .= slLocations snap]
+    , [ "drop-packages" .= Set.map CabalString (slDropPackages snap)
+      | not (Set.null (slDropPackages snap))
+      ]
+    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap (slFlags snap))
+      | not (Map.null (slFlags snap))
+      ]
+    , [ "hidden" .= toCabalStringMap (slHidden snap)
+      | not (Map.null (slHidden snap))
+      ]
+    , [ "ghc-options" .= toCabalStringMap (slGhcOptions snap)
+      | not (Map.null (slGhcOptions snap))
+      ]
+    , maybe [] (\time -> ["publish-time" .= time]) (slPublishTime snap)
+    ]
+
+-- | Convert snapshot layer into its "raw" equivalent.
+--
+-- @since 0.1.0.0
+toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
+toRawSnapshotLayer sl = RawSnapshotLayer
+  { rslParent = toRawSL (slParent sl)
+  , rslCompiler = slCompiler sl
+  , rslLocations = map toRawPLI (slLocations sl)
+  , rslDropPackages = slDropPackages sl
+  , rslFlags = slFlags sl
+  , rslHidden = slHidden sl
+  , rslGhcOptions = slGhcOptions sl
+  , rslPublishTime = slPublishTime sl
+  }
+
+-- | An arbitrary hash for a snapshot, used for finding module names in a
+-- snapshot. Mostly intended for Stack's usage.
+--
+-- @since 0.1.0.0
+newtype SnapshotCacheHash = SnapshotCacheHash { unSnapshotCacheHash :: SHA256}
+  deriving (Show)
+
+-- | Get the path to the global hints cache file
+getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
+getGlobalHintsFile = do
+  root <- view $ pantryConfigL.to pcRootDir
+  globalHintsRelFile <- parseRelFile "global-hints-cache.yaml"
+  pure $ root </> globalHintsRelFile
+
+-- | Creates BlobKey for an input ByteString
+--
+-- @since 0.1.0.0
+bsToBlobKey :: ByteString -> BlobKey
+bsToBlobKey bs =
+  BlobKey (SHA256.hashBytes bs) (FileSize (fromIntegral (B.length bs)))
+
+-- | Warn if the package uses 'PCHpack'.
+--
+-- @since 0.4.0.0
+warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()
+warnMissingCabalFile loc =
+  logWarn $
+       "DEPRECATED: The package at "
+    <> display loc
+    <> " does not include a cabal file.\n"
+    <> "Instead, it includes an hpack package.yaml file for generating a cabal file.\n"
+    <> "This usage is deprecated; please see "
+    <> "https://github.com/commercialhaskell/stack/issues/5210.\n"
+    <> "Support for this workflow will be removed in the future.\n"

@@ -1,275 +1,354 @@-cabal-version: 1.12
---- This file has been generated from package.yaml by hpack version 0.35.2.------ see: https://github.com/sol/hpack--name:           pantry-version:        0.8.3-synopsis:       Content addressable Haskell package management-description:    Please see the README on GitHub at <https://github.com/commercialhaskell/pantry#readme>-category:       Development-homepage:       https://github.com/commercialhaskell/pantry#readme-bug-reports:    https://github.com/commercialhaskell/pantry/issues-author:         Michael Snoyman-maintainer:     michael@snoyman.com-copyright:      2018-2022 FP Complete-license:        BSD3-license-file:   LICENSE-build-type:     Simple-extra-source-files:-    README.md-    ChangeLog.md-    attic/hpack-0.1.2.3.tar.gz-    attic/package-0.1.2.3.tar.gz-    attic/symlink-to-dir.tar.gz--source-repository head-  type: git-  location: https://github.com/commercialhaskell/pantry--flag test-pretty-exceptions-  description: Build an executable to test pretty exceptions-  manual: False-  default: False--library-  exposed-modules:-      Pantry-      Pantry.SHA256-      Pantry.Internal-      Pantry.Internal.StaticBytes-      Pantry.Internal.Stackage-      Pantry.Internal.Companion-      Pantry.Internal.AesonExtended-  other-modules:-      Hackage.Security.Client.Repository.HttpLib.HttpClient-      Pantry.Archive-      Pantry.HTTP-      Pantry.HPack-      Pantry.Hackage-      Pantry.Repo-      Pantry.SQLite-      Pantry.Storage-      Pantry.Casa-      Pantry.Tree-      Pantry.Types-  hs-source-dirs:-      src/-  ghc-options: -Wall-  build-depends:-      Cabal >=3 && <3.11-    , aeson-    , ansi-terminal-    , base >=4.10 && <5-    , bytestring-    , casa-client-    , casa-types-    , conduit-    , conduit-extra-    , containers-    , cryptonite-    , cryptonite-conduit-    , digest-    , filelock-    , generic-deriving-    , hackage-security-    , hpack >=0.35.1-    , http-client-    , http-client-tls-    , http-conduit-    , http-download-    , http-types-    , memory-    , mtl-    , network-uri-    , path-    , path-io-    , persistent-    , persistent-sqlite >=2.9.3-    , persistent-template-    , primitive-    , resourcet-    , rio-    , rio-orphans-    , rio-prettyprint-    , tar-conduit-    , text-    , text-metrics-    , time-    , transformers-    , unix-compat-    , unliftio-    , unordered-containers-    , vector-    , yaml-    , zip-archive-  default-language: Haskell2010-  if impl(ghc >= 9.4.5) && os(windows)-    build-depends:-        network >=3.1.2.9-  if os(windows)-    other-modules:-        System.IsWindows-    hs-source-dirs:-        src/windows/-  else-    other-modules:-        System.IsWindows-    hs-source-dirs:-        src/unix/--executable test-pretty-exceptions-  main-is: Main.hs-  other-modules:-      Paths_pantry-  hs-source-dirs:-      app/test-pretty-exceptions-  ghc-options: -Wall-  build-depends:-      Cabal >=3 && <3.11-    , aeson-    , ansi-terminal-    , base >=4.10 && <5-    , bytestring-    , casa-client-    , casa-types-    , conduit-    , conduit-extra-    , containers-    , cryptonite-    , cryptonite-conduit-    , digest-    , filelock-    , generic-deriving-    , hackage-security-    , hpack >=0.35.1-    , http-client-    , http-client-tls-    , http-conduit-    , http-download-    , http-types-    , memory-    , mtl-    , network-uri-    , optparse-applicative-    , pantry-    , path-    , path-io-    , persistent-    , persistent-sqlite >=2.9.3-    , persistent-template-    , primitive-    , resourcet-    , rio-    , rio-orphans-    , rio-prettyprint-    , tar-conduit-    , text-    , text-metrics-    , time-    , transformers-    , unix-compat-    , unliftio-    , unordered-containers-    , vector-    , yaml-    , zip-archive-  default-language: Haskell2010-  if impl(ghc >= 9.4.5) && os(windows)-    build-depends:-        network >=3.1.2.9-  if !flag(test-pretty-exceptions)-    buildable: False-  if os(windows)-    other-modules:-        PathAbsExamples-        System.Terminal-    hs-source-dirs:-        app/test-pretty-exceptions/windows/-    build-depends:-        Win32-      , process-  else-    other-modules:-        PathAbsExamples-        System.Terminal-    hs-source-dirs:-        app/test-pretty-exceptions/unix/--test-suite spec-  type: exitcode-stdio-1.0-  main-is: Spec.hs-  other-modules:-      Pantry.ArchiveSpec-      Pantry.BuildPlanSpec-      Pantry.CabalSpec-      Pantry.CasaSpec-      Pantry.FileSpec-      Pantry.GlobalHintsSpec-      Pantry.HackageSpec-      Pantry.Internal.StaticBytesSpec-      Pantry.InternalSpec-      Pantry.TreeSpec-      Pantry.TypesSpec-      Paths_pantry-  hs-source-dirs:-      test-  ghc-options: -Wall-  build-depends:-      Cabal >=3 && <3.11-    , QuickCheck-    , aeson-    , ansi-terminal-    , base >=4.10 && <5-    , bytestring-    , casa-client-    , casa-types-    , conduit-    , conduit-extra-    , containers-    , cryptonite-    , cryptonite-conduit-    , digest-    , exceptions-    , filelock-    , generic-deriving-    , hackage-security-    , hedgehog-    , hpack >=0.35.1-    , hspec-    , http-client-    , http-client-tls-    , http-conduit-    , http-download-    , http-types-    , memory-    , mtl-    , network-uri-    , pantry-    , path-    , path-io-    , persistent-    , persistent-sqlite >=2.9.3-    , persistent-template-    , primitive-    , raw-strings-qq-    , resourcet-    , rio-    , rio-orphans-    , rio-prettyprint-    , tar-conduit-    , text-    , text-metrics-    , time-    , transformers-    , unix-compat-    , unliftio-    , unordered-containers-    , vector-    , yaml-    , zip-archive-  default-language: Haskell2010-  if impl(ghc >= 9.4.5) && os(windows)-    build-depends:-        network >=3.1.2.9+cabal-version: 2.0
+
+-- This file has been generated from package.yaml by hpack version 0.35.2.
+--
+-- see: https://github.com/sol/hpack
+
+name:           pantry
+version:        0.9.0
+synopsis:       Content addressable Haskell package management
+description:    Please see the README on GitHub at <https://github.com/commercialhaskell/pantry#readme>
+category:       Development
+homepage:       https://github.com/commercialhaskell/pantry#readme
+bug-reports:    https://github.com/commercialhaskell/pantry/issues
+author:         Michael Snoyman
+maintainer:     michael@snoyman.com
+copyright:      2018-2022 FP Complete
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+    attic/hpack-0.1.2.3.tar.gz
+    attic/package-0.1.2.3.tar.gz
+    attic/symlink-to-dir.tar.gz
+
+source-repository head
+  type: git
+  location: https://github.com/commercialhaskell/pantry
+
+flag test-pretty-exceptions
+  description: Build an executable to test pretty exceptions
+  manual: False
+  default: False
+
+library
+  exposed-modules:
+      Pantry
+      Pantry.Internal.Stackage
+  other-modules:
+      Hackage.Security.Client.Repository.HttpLib.HttpClient
+      Pantry.Archive
+      Pantry.HTTP
+      Pantry.Hackage
+      Pantry.Repo
+      Pantry.Storage
+      Pantry.Casa
+      Pantry.Tree
+  reexported-modules:
+      Pantry.SHA256
+  hs-source-dirs:
+      src/
+  ghc-options: -Wall
+  build-depends:
+      Cabal >=3 && <3.11
+    , aeson
+    , aeson-warning-parser
+    , ansi-terminal
+    , base >=4.10 && <5
+    , bytestring
+    , casa-client
+    , casa-types
+    , companion
+    , conduit
+    , conduit-extra
+    , containers
+    , cryptonite
+    , cryptonite-conduit
+    , digest
+    , filelock
+    , generic-deriving
+    , hackage-security
+    , hpack >=0.35.1
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , http-download
+    , http-types
+    , internal
+    , memory
+    , mtl
+    , network-uri
+    , path
+    , path-io
+    , persistent
+    , persistent-sqlite >=2.9.3
+    , persistent-template
+    , primitive
+    , resourcet
+    , rio
+    , rio-orphans
+    , rio-prettyprint
+    , static-bytes
+    , tar-conduit
+    , text
+    , text-metrics
+    , time
+    , transformers
+    , unix-compat
+    , unliftio
+    , unordered-containers
+    , vector
+    , yaml
+    , zip-archive
+  default-language: Haskell2010
+  if impl(ghc >= 9.4.5) && os(windows)
+    build-depends:
+        network >=3.1.2.9
+  if os(windows)
+    other-modules:
+        System.IsWindows
+    hs-source-dirs:
+        src/windows/
+  else
+    other-modules:
+        System.IsWindows
+    hs-source-dirs:
+        src/unix/
+
+library internal
+  exposed-modules:
+      Pantry.HPack
+      Pantry.Internal
+      Pantry.SHA256
+      Pantry.SQLite
+      Pantry.Types
+  other-modules:
+      Paths_pantry
+  autogen-modules:
+      Paths_pantry
+  hs-source-dirs:
+      int/
+  ghc-options: -Wall
+  build-depends:
+      Cabal >=3 && <3.11
+    , aeson
+    , aeson-warning-parser
+    , ansi-terminal
+    , base >=4.10 && <5
+    , bytestring
+    , casa-client
+    , casa-types
+    , companion
+    , conduit
+    , conduit-extra
+    , containers
+    , cryptonite
+    , cryptonite-conduit
+    , digest
+    , filelock
+    , generic-deriving
+    , hackage-security
+    , hpack >=0.35.1
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , http-download
+    , http-types
+    , memory
+    , mtl
+    , network-uri
+    , path
+    , path-io
+    , persistent
+    , persistent-sqlite >=2.9.3
+    , persistent-template
+    , primitive
+    , resourcet
+    , rio
+    , rio-orphans
+    , rio-prettyprint
+    , static-bytes
+    , tar-conduit
+    , text
+    , text-metrics
+    , time
+    , transformers
+    , unix-compat
+    , unliftio
+    , unordered-containers
+    , vector
+    , yaml
+    , zip-archive
+  default-language: Haskell2010
+  if impl(ghc >= 9.4.5) && os(windows)
+    build-depends:
+        network >=3.1.2.9
+
+executable test-pretty-exceptions
+  main-is: Main.hs
+  other-modules:
+      Paths_pantry
+  autogen-modules:
+      Paths_pantry
+  hs-source-dirs:
+      app/test-pretty-exceptions
+  ghc-options: -Wall
+  build-depends:
+      Cabal >=3 && <3.11
+    , aeson
+    , aeson-warning-parser
+    , ansi-terminal
+    , base >=4.10 && <5
+    , bytestring
+    , casa-client
+    , casa-types
+    , companion
+    , conduit
+    , conduit-extra
+    , containers
+    , cryptonite
+    , cryptonite-conduit
+    , digest
+    , filelock
+    , generic-deriving
+    , hackage-security
+    , hpack >=0.35.1
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , http-download
+    , http-types
+    , memory
+    , mtl
+    , network-uri
+    , optparse-applicative
+    , pantry
+    , path
+    , path-io
+    , persistent
+    , persistent-sqlite >=2.9.3
+    , persistent-template
+    , primitive
+    , resourcet
+    , rio
+    , rio-orphans
+    , rio-prettyprint
+    , static-bytes
+    , tar-conduit
+    , text
+    , text-metrics
+    , time
+    , transformers
+    , unix-compat
+    , unliftio
+    , unordered-containers
+    , vector
+    , yaml
+    , zip-archive
+  default-language: Haskell2010
+  if impl(ghc >= 9.4.5) && os(windows)
+    build-depends:
+        network >=3.1.2.9
+  if !flag(test-pretty-exceptions)
+    buildable: False
+  if os(windows)
+    other-modules:
+        PathAbsExamples
+        System.Terminal
+    hs-source-dirs:
+        app/test-pretty-exceptions/windows/
+    build-depends:
+        Win32
+      , process
+  else
+    other-modules:
+        PathAbsExamples
+        System.Terminal
+    hs-source-dirs:
+        app/test-pretty-exceptions/unix/
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Pantry.ArchiveSpec
+      Pantry.BuildPlanSpec
+      Pantry.CabalSpec
+      Pantry.CasaSpec
+      Pantry.FileSpec
+      Pantry.GlobalHintsSpec
+      Pantry.HackageSpec
+      Pantry.InternalSpec
+      Pantry.TreeSpec
+      Pantry.TypesSpec
+      Paths_pantry
+  autogen-modules:
+      Paths_pantry
+  hs-source-dirs:
+      test
+  ghc-options: -Wall
+  build-tool-depends:
+      hspec-discover:hspec-discover
+  build-depends:
+      Cabal >=3 && <3.11
+    , QuickCheck
+    , aeson
+    , aeson-warning-parser
+    , ansi-terminal
+    , base >=4.10 && <5
+    , bytestring
+    , casa-client
+    , casa-types
+    , companion
+    , conduit
+    , conduit-extra
+    , containers
+    , cryptonite
+    , cryptonite-conduit
+    , digest
+    , exceptions
+    , filelock
+    , generic-deriving
+    , hackage-security
+    , hedgehog
+    , hpack >=0.35.1
+    , hspec
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , http-download
+    , http-types
+    , internal
+    , memory
+    , mtl
+    , network-uri
+    , pantry
+    , path
+    , path-io
+    , persistent
+    , persistent-sqlite >=2.9.3
+    , persistent-template
+    , primitive
+    , raw-strings-qq
+    , resourcet
+    , rio
+    , rio-orphans
+    , rio-prettyprint
+    , static-bytes
+    , tar-conduit
+    , text
+    , text-metrics
+    , time
+    , transformers
+    , unix-compat
+    , unliftio
+    , unordered-containers
+    , vector
+    , yaml
+    , zip-archive
+  default-language: Haskell2010
+  if impl(ghc >= 9.4.5) && os(windows)
+    build-depends:
+        network >=3.1.2.9

@@ -199,7 +199,8 @@ import           Conduit
 import           Control.Arrow ( right )
 import           Control.Monad.State.Strict ( State, execState, get, modify' )
-import           Data.Aeson.Types ( parseEither )
+import           Data.Aeson.Types ( Value, parseEither )
+import           Data.Aeson.WarningParser ( WithJSONWarnings (..) )
 #if !MIN_VERSION_rio(0,1,17)
 import           Data.Bifunctor ( bimap )
 #endif
@@ -222,7 +223,6 @@ import           Pantry.Casa
 import           Pantry.HTTP
 import           Pantry.Hackage
-import           Pantry.Internal.AesonExtended ( Value, WithJSONWarnings (..) )
 import           Pantry.Repo
 import qualified Pantry.SHA256 as SHA256
 import           Pantry.Storage hiding

@@ -1,81 +0,0 @@-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Pantry.HPack
-  ( hpack
-  , hpackVersion
-  ) where
-
-import qualified Data.ByteString.Lazy.Char8 as BL
-import           Data.Char ( isDigit, isSpace )
-import qualified Hpack
-import qualified Hpack.Config as Hpack
-import           Pantry.Types
-import           Path
-                   ( Abs, Dir, Path, (</>), filename, parseRelFile, toFilePath )
-import           Path.IO ( doesFileExist )
-import           RIO
-import           RIO.Process
-
-hpackVersion ::
-     (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => RIO env Version
-hpackVersion = do
-  he <- view $ pantryConfigL.to pcHpackExecutable
-  case he of
-    HpackBundled -> do
-      let bundledHpackVersion :: String = VERSION_hpack
-      parseVersionThrowing bundledHpackVersion
-    HpackCommand command -> do
-      version <- BL.unpack <$> proc command ["--version"] readProcessStdout_
-      let version' = dropWhile (not . isDigit) version
-          version'' = filter (not . isSpace) version'
-      parseVersionThrowing version''
-
--- | Generate .cabal file from package.yaml, if necessary.
-hpack ::
-     (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => Path Abs Dir
-  -> RIO env ()
-hpack pkgDir = do
-  packageConfigRelFile <- parseRelFile Hpack.packageConfig
-  let hpackFile = pkgDir Path.</> packageConfigRelFile
-  whenM (doesFileExist hpackFile) $ do
-    logDebug $ "Running hpack on " <> fromString (toFilePath hpackFile)
-    he <- view $ pantryConfigL.to pcHpackExecutable
-    case he of
-      HpackBundled -> do
-        r <- liftIO $ Hpack.hpackResult $ Hpack.setProgramName "stack" $
-          Hpack.setTarget (toFilePath hpackFile) Hpack.defaultOptions
-        forM_ (Hpack.resultWarnings r) (logWarn . fromString)
-        let cabalFile = fromString . Hpack.resultCabalFile $ r
-        case Hpack.resultStatus r of
-          Hpack.Generated -> logDebug $
-               "hpack generated a modified version of "
-            <> cabalFile
-          Hpack.OutputUnchanged -> logDebug $
-               "hpack output unchanged in "
-            <> cabalFile
-          Hpack.AlreadyGeneratedByNewerHpack -> logWarn $
-               cabalFile
-            <> " was generated with a newer version of hpack. Ignoring "
-            <> fromString (toFilePath hpackFile)
-            <> " in favor of the Cabal file.\n"
-            <> "Either please upgrade and try again or, if you want to use the "
-            <> fromString (toFilePath (filename hpackFile))
-            <> " file instead of the Cabal file,\n"
-            <> "then please delete the Cabal file."
-          Hpack.ExistingCabalFileWasModifiedManually -> logWarn $
-               cabalFile
-            <> " was modified manually. Ignoring "
-            <> fromString (toFilePath hpackFile)
-            <> " in favor of the Cabal file.\n"
-            <> "If you want to use the "
-            <> fromString (toFilePath (filename hpackFile))
-            <> " file instead of the Cabal file,\n"
-            <> "then please delete the Cabal file."
-      HpackCommand command ->
-        withWorkingDir (toFilePath pkgDir) $
-        proc command [] runProcess_

@@ -1,85 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
--- | Exposed for testing, do not use!
-module Pantry.Internal
-  ( parseTree
-  , renderTree
-  , Tree (..)
-  , TreeEntry (..)
-  , FileType(..)
-  , mkSafeFilePath
-  , pcHpackExecutable
-  , normalizeParents
-  , makeTarRelative
-  , getGlobalHintsFile
-  , hpackVersion
-  , Storage
-  , initStorage
-  , withStorage_
-  ) where
-
-import           Control.Exception ( assert )
-import           Data.Maybe ( fromMaybe )
-import qualified Data.Text as T
-import           Pantry.HPack ( hpackVersion )
-import           Pantry.SQLite ( initStorage )
-import           Pantry.Types
-
--- | Like @System.FilePath.normalise@, however:
---
--- * Only works on relative paths, absolute paths fail
---
--- * Strips trailing slashes
---
--- * Only works on forward slashes, even on Windows
---
--- * Normalizes parent dirs @foo/../@ get stripped
---
--- * Cannot begin with a parent directory (@../@)
---
--- * Spelled like an American, sorry
-normalizeParents ::
-     FilePath
-  -> Either String FilePath
-normalizeParents "" = Left "empty file path"
-normalizeParents ('/':_) = Left "absolute path"
-normalizeParents ('.':'.':'/':_) = Left "absolute path"
-normalizeParents fp = do
-  -- Strip a single trailing, but not multiple
-  let t0 = T.pack fp
-      t = fromMaybe t0 $ T.stripSuffix "/" t0
-  case T.unsnoc t of
-    Just (_, '/') -> Left "multiple trailing slashes"
-    _ -> Right ()
-
-  let c1 = T.split (== '/') t
-
-  case reverse c1 of
-    ".":_ -> Left "last component is a single dot"
-    _ -> Right ()
-
-  let c2 = filter (\x -> not (T.null x || x == ".")) c1
-
-  let loop [] routput = reverse routput
-      loop ("..":rest) (_:routput) = loop rest routput
-      loop (x:xs) routput = loop xs (x:routput)
-
-  case loop c2 [] of
-    [] -> Left "no non-empty components"
-    c' -> Right $ T.unpack $ T.intercalate "/" c'
-
--- | Following tar file rules (Unix file paths only), make the second file
--- relative to the first file.
-makeTarRelative ::
-     FilePath -- ^ base file
-  -> FilePath -- ^ relative part
-  -> Either String FilePath
-makeTarRelative _ ('/':_) = Left "absolute path found"
-makeTarRelative base rel =
-  case reverse base of
-    [] -> Left "cannot have empty base"
-    '/':_ -> Left "base cannot be a directory"
-    _:rest -> Right $
-      case dropWhile (/= '/') rest of
-        '/':rest' -> reverse rest' ++ '/' : rel
-        rest' -> assert (null rest') rel

@@ -1,268 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
-
--- | Extensions to Aeson parsing of objects. This module is intended for
--- internal use by Pantry and Stack only. The intention is to fully remove this
--- module in the future. /DO NOT RELY ON IT/.
-module Pantry.Internal.AesonExtended
-  ( module Export
-    -- * Extended failure messages
-  , (.:)
-  , (.:?)
-    -- * JSON Parser that emits warnings
-  , JSONWarning (..)
-  , WarningParser
-  , WithJSONWarnings (..)
-  , withObjectWarnings
-  , jsonSubWarnings
-  , jsonSubWarningsT
-  , jsonSubWarningsTT
-  , logJSONWarnings
-  , noJSONWarnings
-  , tellJSONField
-  , unWarningParser
-  , (..:)
-  , (...:)
-  , (..:?)
-  , (...:?)
-  , (..!=)
-  ) where
-
-import           Control.Monad.Trans.Writer.Strict
-                   ( WriterT, mapWriterT, runWriterT, tell )
-import           Data.Aeson as Export hiding ( (.:), (.:?) )
-import qualified Data.Aeson as A
-import           Data.Aeson.Types hiding ( (.:), (.:?) )
-import qualified Data.Set as Set
-import           Data.Text ( unpack )
-import qualified Data.Text as T
-import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
-import           RIO
-import           RIO.PrettyPrint.StylesUpdate ( StylesUpdate )
-
-#if MIN_VERSION_aeson(2, 0, 0)
-import qualified Data.Aeson.Key
-import qualified Data.Aeson.KeyMap as HashMap
-
-keyToText :: Data.Aeson.Key.Key -> Text
-keyToText = Data.Aeson.Key.toText
-
-textToKey :: Text -> Data.Aeson.Key.Key
-textToKey = Data.Aeson.Key.fromText
-#else
-import qualified Data.HashMap.Strict as HashMap
-
-keyToText :: Text -> Text
-keyToText = id
-
-textToKey :: Text -> Text
-textToKey = id
-#endif
-
--- | Extends @.:@ warning to include field name.
-(.:) :: FromJSON a => Object -> Text -> Parser a
-(.:) o p = modifyFailure
-  (("failed to parse field '" <> unpack p <> "': ") <>)
-  (o A..: textToKey p)
-{-# INLINE (.:) #-}
-
--- | Extends @.:?@ warning to include field name.
-(.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a)
-(.:?) o p = modifyFailure
-  (("failed to parse field '" <> unpack p <> "': ") <>)
-  (o A..:? textToKey p)
-{-# INLINE (.:?) #-}
-
--- | 'WarningParser' version of @.:@.
-(..:) ::
-     FromJSON a
-  => Object
-  -> Text
-  -> WarningParser a
-o ..: k = tellJSONField k >> lift (o .: k)
-
--- | 'WarningParser' version of @.:?@.
-(..:?) ::
-     FromJSON a
-  => Object
-  -> Text
-  -> WarningParser (Maybe a)
-o ..:? k = tellJSONField k >> lift (o .:? k)
-
--- | 'WarningParser' version of @.!=@.
-(..!=) :: WarningParser (Maybe a) -> a -> WarningParser a
-wp ..!= d =
-  flip mapWriterT wp $
-  \p -> do
-    a <- fmap snd p
-    fmap (, a) (fmap fst p .!= d)
-
-presentCount :: Object -> [Text] -> Int
-presentCount o = length . filter (\x -> HashMap.member (textToKey x) o)
-
--- | Synonym version of @..:@.
-(...:) :: FromJSON a => Object -> [Text] -> WarningParser a
-_ ...: [] = fail "failed to find an empty key"
-o ...: ss@(key:_) = apply
- where
-  pc = presentCount o ss
-  apply | pc == 0   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "keys " ++ show ss ++ " not present"
-        | pc >  1   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "two or more synonym keys " ++
-                        show ss ++ " present"
-        | otherwise = asum $ map (o..:) ss
-
--- | Synonym version of @..:?@.
-(...:?) :: FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
-_ ...:? [] = fail "failed to find an empty key"
-o ...:? ss@(key:_) = apply
- where
-  pc = presentCount o ss
-  apply | pc == 0   = pure Nothing
-        | pc >  1   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "two or more synonym keys " ++
-                        show ss ++ " present"
-        | otherwise = asum $ map (o..:) ss
-
--- | Tell warning parser about an expected field, so it doesn't warn about it.
-tellJSONField :: Text -> WarningParser ()
-tellJSONField key = tell (mempty { wpmExpectedFields = Set.singleton key})
-
--- | 'WarningParser' version of 'withObject'.
-withObjectWarnings ::
-     String
-  -> (Object -> WarningParser a)
-  -> Value
-  -> Parser (WithJSONWarnings a)
-withObjectWarnings expected f =
-  withObject expected $
-  \obj -> do
-    (a,w) <- runWriterT (f obj)
-    let unrecognizedFields =
-          Set.toList
-            ( Set.difference
-                (Set.fromList (map keyToText (HashMap.keys obj)))
-                (wpmExpectedFields w)
-            )
-    pure
-      ( WithJSONWarnings a
-          ( wpmWarnings w ++
-            case unrecognizedFields of
-                [] -> []
-                _ -> [JSONUnrecognizedFields expected unrecognizedFields]
-          )
-      )
-
--- | Convert a 'WarningParser' to a 'Parser'.
-unWarningParser :: WarningParser a -> Parser a
-unWarningParser wp = do
-  (a,_) <- runWriterT wp
-  pure a
-
--- | Log JSON warnings.
-logJSONWarnings ::
-     (MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m)
-  => FilePath
-  -> [JSONWarning]
-  -> m ()
-logJSONWarnings fp =
-  mapM_ (\w -> logWarn ("Warning: " <> fromString fp <> ": " <> displayShow w))
-
--- | Handle warnings in a sub-object.
-jsonSubWarnings :: WarningParser (WithJSONWarnings a) -> WarningParser a
-jsonSubWarnings f = do
-  WithJSONWarnings result warnings <- f
-  tell
-    ( mempty
-        { wpmWarnings = warnings
-        }
-    )
-  pure result
-
--- | Handle warnings in a @Traversable@ of sub-objects.
-jsonSubWarningsT ::
-     Traversable t
-  => WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
-jsonSubWarningsT f =
-  mapM (jsonSubWarnings . pure) =<< f
-
--- | Handle warnings in a @Maybe Traversable@ of sub-objects.
-jsonSubWarningsTT ::
-     (Traversable t, Traversable u)
-  => WarningParser (u (t (WithJSONWarnings a)))
-  -> WarningParser (u (t a))
-jsonSubWarningsTT f =
-  mapM (jsonSubWarningsT . pure) =<< f
-
--- Parsed JSON value without any warnings
-noJSONWarnings :: a -> WithJSONWarnings a
-noJSONWarnings v = WithJSONWarnings v []
-
--- | JSON parser that warns about unexpected fields in objects.
-type WarningParser a = WriterT WarningParserMonoid Parser a
-
--- | Monoid used by 'WarningParser' to track expected fields and warnings.
-data WarningParserMonoid = WarningParserMonoid
-  { wpmExpectedFields :: !(Set Text)
-  , wpmWarnings :: [JSONWarning]
-  } deriving Generic
-
-instance Semigroup WarningParserMonoid where
-  (<>) = mappenddefault
-
-instance Monoid WarningParserMonoid where
-  mempty = memptydefault
-  mappend = (<>)
-
-instance IsString WarningParserMonoid where
-  fromString s = mempty { wpmWarnings = [fromString s] }
-
--- Parsed JSON value with its warnings
-data WithJSONWarnings a = WithJSONWarnings a [JSONWarning]
-  deriving (Eq, Generic, Show)
-
-instance Functor WithJSONWarnings where
-  fmap f (WithJSONWarnings x w) = WithJSONWarnings (f x) w
-
-instance Monoid a => Semigroup (WithJSONWarnings a) where
-  (<>) = mappenddefault
-
-instance Monoid a => Monoid (WithJSONWarnings a) where
-  mempty = memptydefault
-  mappend = (<>)
-
--- | Warning output from 'WarningParser'.
-data JSONWarning
-  = JSONUnrecognizedFields String [Text]
-  | JSONGeneralWarning !Text
-  deriving Eq
-
-instance Show JSONWarning where
-  show = T.unpack . utf8BuilderToText . display
-
-instance Display JSONWarning where
-  display (JSONUnrecognizedFields obj [field]) =
-    "Unrecognized field in " <> fromString obj <> ": " <> display field
-  display (JSONUnrecognizedFields obj fields) =
-       "Unrecognized fields in "
-    <> fromString obj
-    <> ": "
-    <> display (T.intercalate ", " fields)
-  display (JSONGeneralWarning t) = display t
-
-instance IsString JSONWarning where
-  fromString = JSONGeneralWarning . T.pack
-
-instance FromJSON (WithJSONWarnings StylesUpdate) where
-  parseJSON v = noJSONWarnings <$> parseJSON v

@@ -1,80 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RankNTypes        #-}
-
--- | Companion threads, such as for printing messages saying we're still busy.
--- Ultimately this could be put into its own package. This is a non-standard API
--- for use by Pantry and Stack, please /DO NOT DEPEND ON IT/.
-module Pantry.Internal.Companion
-  ( withCompanion
-  , onCompanionDone
-  , Companion
-  , Delay
-  , StopCompanion
-  ) where
-
-import           RIO
-
--- | A companion thread which can perform arbitrary actions as well as delay
-type Companion m = Delay -> m ()
-
--- | Delay the given number of microseconds. If 'StopCompanion' is triggered
--- before the timer completes, a 'CompanionDone' exception will be thrown (which
--- is caught internally by 'withCompanion').
-type Delay = forall mio. MonadIO mio => Int -> mio ()
-
--- | Tell the 'Companion' to stop. The next time 'Delay' is called, or if a
--- 'Delay' is currently blocking, the 'Companion' thread will exit with a
--- 'CompanionDone' exception.
-type StopCompanion m = m ()
-
--- | When a delay was interrupted because we're told to stop, perform this
--- action.
-onCompanionDone
-  :: MonadUnliftIO m
-  => m () -- ^ the delay
-  -> m () -- ^ action to perform
-  -> m ()
-onCompanionDone theDelay theAction =
-  theDelay `withException` \CompanionDone -> theAction
-
--- | Internal exception used by 'withCompanion' to allow short-circuiting of the
--- 'Companion'. Should not be used outside of this module.
-data CompanionDone = CompanionDone
-  deriving (Show, Typeable)
-
-instance Exception CompanionDone
-
--- | Keep running the 'Companion' action until either the inner action completes
--- or calls the 'StopCompanion' action. This can be used to give the user status
--- information while running a long running operations.
-withCompanion ::
-     forall m a. MonadUnliftIO m
-  => Companion m
-  -> (StopCompanion m -> m a)
-  -> m a
-withCompanion companion inner = do
-  -- Variable to indicate 'Delay'ing should result in a 'CompanionDone'
-  -- exception.
-  shouldStopVar <- newTVarIO False
-  let -- Relatively simple: set shouldStopVar to True
-      stopCompanion = atomically $ writeTVar shouldStopVar True
-
-      delay :: Delay
-      delay usec = do
-        -- Register a delay with the runtime system
-        delayDoneVar <- registerDelay usec
-        join $ atomically $
-          -- Delay has triggered, keep going
-          (pure () <$ (readTVar delayDoneVar >>= checkSTM)) <|>
-          -- Time to stop the companion, throw a 'CompanionDone' exception
-          -- immediately
-          (throwIO CompanionDone <$ (readTVar shouldStopVar >>= checkSTM))
-
-  -- Run the 'Companion' and inner action together
-  runConcurrently $
-    -- Ignore a 'CompanionDone' exception from the companion, that's expected
-    -- behavior
-    Concurrently (companion delay `catch` \CompanionDone -> pure ()) *>
-    -- Run the inner action, giving it the 'StopCompanion' action, and
-    -- ensuring it is called regardless of exceptions.
-    Concurrently (inner stopCompanion `finally` stopCompanion)

@@ -1,244 +0,0 @@-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE DeriveAnyClass      #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators       #-}
-
--- | This is an unstable API, exposed only for testing. Relying on
--- this may break your code! Caveat emptor.
---
--- This module can (and perhaps should) be separate into its own
--- package, it's generally useful.
-module Pantry.Internal.StaticBytes
-  ( Bytes8
-  , Bytes16
-  , Bytes32
-  , Bytes64
-  , Bytes128
-  , DynamicBytes
-  , StaticBytes
-  , StaticBytesException (..)
-  , toStaticExact
-  , toStaticPad
-  , toStaticTruncate
-  , toStaticPadTruncate
-  , fromStatic
-  ) where
-
-import           Data.Bits
-import           Data.ByteArray
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Internal as B
-import qualified Data.Primitive.ByteArray as BA
-import qualified Data.Vector.Primitive as VP
-import qualified Data.Vector.Storable as VS
-import qualified Data.Vector.Unboxed as VU
-import qualified Data.Vector.Unboxed.Base as VU
-import           Foreign.ForeignPtr
-import           Foreign.Ptr
-import           Foreign.Storable
-import           RIO hiding ( words )
-import           System.IO.Unsafe ( unsafePerformIO )
-
-newtype Bytes8 = Bytes8 Word64
-  deriving (Eq, Ord, Generic, NFData, Hashable, Data)
-
-instance Show Bytes8 where
-  show (Bytes8 w) = show (fromWordsD 8 [w] :: B.ByteString)
-
-data Bytes16 = Bytes16 !Bytes8 !Bytes8
-  deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data)
-
-data Bytes32 = Bytes32 !Bytes16 !Bytes16
-  deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data)
-
-data Bytes64 = Bytes64 !Bytes32 !Bytes32
-  deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data)
-
-data Bytes128 = Bytes128 !Bytes64 !Bytes64
-  deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data)
-
-data StaticBytesException
-  = NotEnoughBytes
-  | TooManyBytes
-  deriving (Show, Eq, Typeable)
-
-instance Exception StaticBytesException
-
--- All lengths below are given in bytes
-
-class DynamicBytes dbytes where
-  lengthD :: dbytes -> Int
-  -- | Yeah, it looks terrible to use a list here, but fusion should kick in
-  withPeekD :: dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
-  -- | May throw a runtime exception if invariants are violated!
-  fromWordsD :: Int -> [Word64] -> dbytes
-
-fromWordsForeign ::
-     (ForeignPtr a -> Int -> b)
-  -> Int
-  -> [Word64]
-  -> b
-fromWordsForeign wrapper len words0 = unsafePerformIO $ do
-  fptr <- B.mallocByteString len
-  withForeignPtr fptr $ \ptr -> do
-    let loop _ [] = pure ()
-        loop off (w:ws) = do
-          pokeElemOff (castPtr ptr) off w
-          loop (off + 1) ws
-    loop 0 words0
-  pure $ wrapper fptr len
-
-withPeekForeign ::
-     (ForeignPtr a, Int, Int)
-  -> ((Int -> IO Word64) -> IO b)
-  -> IO b
-withPeekForeign (fptr, off, len) inner =
-  withForeignPtr fptr $ \ptr -> do
-    let f off'
-          | off' >= len = pure 0
-          | off' + 8 > len = do
-              let loop w64 i
-                    | off' + i >= len = pure w64
-                    | otherwise = do
-                        w8 :: Word8 <- peekByteOff ptr (off + off' + i)
-                        let w64' = shiftL (fromIntegral w8) (i * 8) .|. w64
-                        loop w64' (i + 1)
-              loop 0 0
-          | otherwise = peekByteOff ptr (off + off')
-    inner f
-
-instance DynamicBytes B.ByteString where
-  lengthD = B.length
-  fromWordsD = fromWordsForeign (`B.fromForeignPtr` 0)
-  withPeekD = withPeekForeign . B.toForeignPtr
-
-instance word8 ~ Word8 => DynamicBytes (VS.Vector word8) where
-  lengthD = VS.length
-  fromWordsD = fromWordsForeign VS.unsafeFromForeignPtr0
-  withPeekD = withPeekForeign . VS.unsafeToForeignPtr
-
-instance word8 ~ Word8 => DynamicBytes (VP.Vector word8) where
-  lengthD = VP.length
-  fromWordsD len words0 = unsafePerformIO $ do
-    ba <- BA.newByteArray len
-    let loop _ [] =
-          VP.Vector 0 len <$> BA.unsafeFreezeByteArray ba
-        loop i (w:ws) = do
-          BA.writeByteArray ba i w
-          loop (i + 1) ws
-    loop 0 words0
-  withPeekD (VP.Vector off len ba) inner = do
-    let f off'
-          | off' >= len = pure 0
-          | off' + 8 > len = do
-              let loop w64 i
-                    | off' + i >= len = pure w64
-                    | otherwise = do
-                        let w8 :: Word8 = BA.indexByteArray ba (off + off' + i)
-                        let w64' = shiftL (fromIntegral w8) (i * 8) .|. w64
-                        loop w64' (i + 1)
-              loop 0 0
-          | otherwise = pure $ BA.indexByteArray ba (off + (off' `div` 8))
-    inner f
-
-instance word8 ~ Word8 => DynamicBytes (VU.Vector word8) where
-  lengthD = VU.length
-  fromWordsD len words = VU.V_Word8 (fromWordsD len words)
-  withPeekD (VU.V_Word8 v) = withPeekD v
-
-class StaticBytes sbytes where
-  lengthS :: proxy sbytes -> Int -- use type level literals instead?
-  -- difference list
-  toWordsS :: sbytes -> [Word64] -> [Word64]
-  usePeekS :: Int -> (Int -> IO Word64) -> IO sbytes
-
-instance StaticBytes Bytes8 where
-  lengthS _ = 8
-  toWordsS (Bytes8 w) = (w:)
-  usePeekS off f = Bytes8 <$> f off
-
-instance StaticBytes Bytes16 where
-  lengthS _ = 16
-  toWordsS (Bytes16 b1 b2) = toWordsS b1 . toWordsS b2
-  usePeekS off f = Bytes16 <$> usePeekS off f <*> usePeekS (off + 8) f
-
-instance StaticBytes Bytes32 where
-  lengthS _ = 32
-  toWordsS (Bytes32 b1 b2) = toWordsS b1 . toWordsS b2
-  usePeekS off f = Bytes32 <$> usePeekS off f <*> usePeekS (off + 16) f
-
-instance StaticBytes Bytes64 where
-  lengthS _ = 64
-  toWordsS (Bytes64 b1 b2) = toWordsS b1 . toWordsS b2
-  usePeekS off f = Bytes64 <$> usePeekS off f <*> usePeekS (off + 32) f
-
-instance StaticBytes Bytes128 where
-  lengthS _ = 128
-  toWordsS (Bytes128 b1 b2) = toWordsS b1 . toWordsS b2
-  usePeekS off f = Bytes128 <$> usePeekS off f <*> usePeekS (off + 64) f
-
-instance ByteArrayAccess Bytes8 where
-  length _ = 8
-  withByteArray = withByteArrayS
-
-instance ByteArrayAccess Bytes16 where
-  length _ = 16
-  withByteArray = withByteArrayS
-
-instance ByteArrayAccess Bytes32 where
-  length _ = 32
-  withByteArray = withByteArrayS
-
-instance ByteArrayAccess Bytes64 where
-  length _ = 64
-  withByteArray = withByteArrayS
-
-instance ByteArrayAccess Bytes128 where
-  length _ = 128
-  withByteArray = withByteArrayS
-
-withByteArrayS :: StaticBytes sbytes => sbytes -> (Ptr p -> IO a) -> IO a
-withByteArrayS sbytes = withByteArray (fromStatic sbytes :: ByteString)
-
-toStaticExact ::
-     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
-  => dbytes
-  -> Either StaticBytesException sbytes
-toStaticExact dbytes =
-  case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of
-    LT -> Left NotEnoughBytes
-    GT -> Left TooManyBytes
-    EQ -> Right (toStaticPadTruncate dbytes)
-
-toStaticPad ::
-     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
-  => dbytes
-  -> Either StaticBytesException sbytes
-toStaticPad dbytes =
-  case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of
-    GT -> Left TooManyBytes
-    _  -> Right (toStaticPadTruncate dbytes)
-
-toStaticTruncate ::
-     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
-  => dbytes
-  -> Either StaticBytesException sbytes
-toStaticTruncate dbytes =
-  case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of
-    LT -> Left NotEnoughBytes
-    _  -> Right (toStaticPadTruncate dbytes)
-
-toStaticPadTruncate ::
-     (DynamicBytes dbytes, StaticBytes sbytes)
-  => dbytes
-  -> sbytes
-toStaticPadTruncate dbytes = unsafePerformIO (withPeekD dbytes (usePeekS 0))
-
-fromStatic ::
-     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
-  => sbytes
-  -> dbytes
-fromStatic = fromWordsD (lengthS (Nothing :: Maybe sbytes)) . ($ []) . toWordsS

@@ -1,197 +0,0 @@-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-
--- | Provides a data type ('SHA256') for efficient memory representation of a
--- sha-256 hash value, together with helper functions for converting to and from
--- that value. This module is intended to be imported qualified as @SHA256@.
---
--- Some nomenclature:
---
--- * Hashing calculates a new hash value from some input. @from@ takes a value
---   that represents an existing hash.
---
--- * Raw means a raw binary representation of the hash value, without any hex
---   encoding.
---
--- * Text always uses lower case hex encoding
---
--- @since 0.1.0.0
-module Pantry.SHA256
-  ( -- * Types
-    SHA256
-  , SHA256Exception (..)
-    -- * Hashing
-  , hashFile
-  , hashBytes
-  , hashLazyBytes
-  , sinkHash
-    -- * Convert from a hash representation
-  , fromHexText
-  , fromHexBytes
-  , fromDigest
-  , fromRaw
-    -- * Convert to a hash representation
-  , toHexText
-  , toHexBytes
-  , toRaw
-  ) where
-
-import           Conduit
-import qualified Crypto.Hash as Hash ( Digest, SHA256, hash, hashlazy )
-import qualified Crypto.Hash.Conduit as Hash ( hashFile, sinkHash )
-import           Data.Aeson
-import qualified Data.ByteArray
-import qualified Data.ByteArray.Encoding as Mem
-import           Database.Persist.Sql
-import           Pantry.Internal.StaticBytes
-import           RIO
-import qualified RIO.Text as T
-
--- | A SHA256 hash, stored in a static size for more efficient
--- memory representation.
---
--- @since 0.1.0.0
-newtype SHA256 = SHA256 Bytes32
-  deriving (Generic, Eq, NFData, Data, Typeable, Ord, Hashable)
-
--- | Exceptions which can occur in this module
---
--- @since 0.1.0.0
-data SHA256Exception
-  = InvalidByteCount !ByteString !StaticBytesException
-  | InvalidHexBytes !ByteString !Text
-  deriving (Typeable)
-
--- | Generate a 'SHA256' value by hashing the contents of a file.
---
--- @since 0.1.0.0
-hashFile :: MonadIO m => FilePath -> m SHA256
-hashFile fp = fromDigest <$> Hash.hashFile fp
-
--- | Generate a 'SHA256' value by hashing a @ByteString@.
---
--- @since 0.1.0.0
-hashBytes :: ByteString -> SHA256
-hashBytes = fromDigest . Hash.hash
-
--- | Generate a 'SHA256' value by hashing a lazy @ByteString@.
---
--- @since 0.1.0.0
-hashLazyBytes :: LByteString -> SHA256
-hashLazyBytes = fromDigest . Hash.hashlazy
-
--- | Generate a 'SHA256' value by hashing the contents of a stream.
---
--- @since 0.1.0.0
-sinkHash :: Monad m => ConduitT ByteString o m SHA256
-sinkHash = fromDigest <$> Hash.sinkHash
-
--- | Convert a base16-encoded 'Text' value containing a hash into a 'SHA256'.
---
--- @since 0.1.0.0
-fromHexText :: Text -> Either SHA256Exception SHA256
-fromHexText = fromHexBytes . encodeUtf8
-
--- | Convert a base16-encoded 'ByteString' value containing a hash into a
--- 'SHA256'.
---
--- @since 0.1.0.0
-fromHexBytes :: ByteString -> Either SHA256Exception SHA256
-fromHexBytes hexBS = do
-  mapLeft (InvalidHexBytes hexBS . T.pack) (Mem.convertFromBase Mem.Base16 hexBS) >>= fromRaw
-
--- | Convert a 'Hash.Digest' into a 'SHA256'
---
--- @since 0.1.0.0
-fromDigest :: Hash.Digest Hash.SHA256 -> SHA256
-fromDigest digest =
-  case toStaticExact (Data.ByteArray.convert digest :: ByteString) of
-    Left e -> error $ "Impossible failure in fromDigest: " ++ show (digest, e)
-    Right x -> SHA256 x
-
--- | Convert a raw representation of a hash into a 'SHA256'.
---
--- @since 0.1.0.0
-fromRaw :: ByteString -> Either SHA256Exception SHA256
-fromRaw bs =
-  either (Left . InvalidByteCount bs) (Right . SHA256) (toStaticExact bs)
-
--- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
---
--- @since 0.1.0.0
-toHexText :: SHA256 -> Text
-toHexText ss =
-  case decodeUtf8' $ toHexBytes ss of
-    Left e ->
-      error $ "Impossible failure in staticSHA256ToText: " ++ show (ss, e)
-    Right t -> t
-
--- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
---
--- @since 0.1.0.0
-toHexBytes :: SHA256 -> ByteString
-toHexBytes (SHA256 x) = Mem.convertToBase Mem.Base16 x
-
--- | Convert a 'SHA256' into a raw binary representation.
---
--- @since 0.1.0.0
-toRaw :: SHA256 -> ByteString
-toRaw (SHA256 x) = Data.ByteArray.convert x
-
--- Instances
-
-instance Show SHA256 where
-  show s = "SHA256 " ++ show (toHexText s)
-
-instance PersistField SHA256 where
-  toPersistValue = PersistByteString . toRaw
-  fromPersistValue (PersistByteString bs) =
-    case toStaticExact bs of
-      Left e -> Left $ tshow e
-      Right ss -> pure $ SHA256 ss
-  fromPersistValue x = Left $ "Unexpected value: " <> tshow x
-
-instance PersistFieldSql SHA256 where
-  sqlType _ = SqlBlob
-
-instance Display SHA256 where
-  display = displayBytesUtf8 . toHexBytes
-
-instance ToJSON SHA256 where
-  toJSON = toJSON . toHexText
-instance FromJSON SHA256 where
-  parseJSON = withText "SHA256" $ \t ->
-    case fromHexText t of
-      Right x -> pure x
-      Left e -> fail $ concat
-        [ "Invalid SHA256 "
-        , show t
-        , ": "
-        , show e
-        ]
-
-instance Exception SHA256Exception
-instance Show SHA256Exception where
-  show = T.unpack . utf8BuilderToText . display
-
--- To support the Haskell Foundation's
--- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry
--- error messages generated by Pantry itself begin with an unique code in the
--- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.
--- The numbers are selected at random, not in sequence.
-instance Display SHA256Exception where
-  display (InvalidByteCount bs sbe) =
-    "Error: [S-161]\n"
-    <> "Invalid byte count creating a SHA256 from "
-    <> displayShow bs
-    <> ": "
-    <> displayShow sbe
-  display (InvalidHexBytes bs t) =
-    "Error: [S-165]\n"
-    <> "Invalid hex bytes creating a SHA256: "
-    <> displayShow bs
-    <> ": "
-    <> display t

@@ -1,115 +0,0 @@-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Pantry.SQLite
-  ( Storage (..)
-  , initStorage
-  ) where
-
-import           Database.Persist.Sqlite
-import           Pantry.Internal.Companion
-import           Pantry.Types
-                   ( PantryException (MigrationFailure), Storage (..) )
-import           Path ( Abs, File, Path, parent, toFilePath )
-import           Path.IO ( ensureDir )
-import           RIO hiding ( FilePath )
-import           RIO.Orphans ()
-import           System.FileLock
-                   ( SharedExclusive (..), withFileLock, withTryFileLock )
-
-initStorage ::
-     HasLogFunc env
-  => Text
-  -> Migration
-  -> Path Abs File -- ^ storage file
-  -> (Storage -> RIO env a)
-  -> RIO env a
-initStorage description migration fp inner = do
-  ensureDir $ parent fp
-
-  migrates <- withWriteLock (display description) fp $ wrapMigrationFailure $
-    withSqliteConnInfo (sqinfo True) $ runSqlConn $
-    runMigrationSilent migration
-  forM_ migrates $ \mig -> logDebug $ "Migration executed: " <> display mig
-
-  -- Make a single connection to the SQLite database and wrap it in an MVar for
-  -- the entire execution context. Previously we used a resource pool of size
-  -- 1, but (1) there's no advantage to that, and (2) it had a _very_ weird
-  -- interaction with Docker on OS X where when resource-pool's reaper would
-  -- trigger, it would somehow cause the Stack process inside the container to
-  -- die with a SIGBUS. Definitely an interesting thing worth following up
-  -- on...
-  withSqliteConnInfo (sqinfo False) $ \conn0 -> do
-    connVar <- newMVar conn0
-    inner $ Storage
-      -- NOTE: Currently, we take a write lock on every action. This is
-      -- a bit heavyweight, but it avoids the SQLITE_BUSY errors
-      -- reported in
-      -- <https://github.com/commercialhaskell/stack/issues/4471>
-      -- completely. We can investigate more elegant solutions in the
-      -- future, such as separate read and write actions or introducing
-      -- smarter retry logic.
-      { withStorage_ = \action -> withMVar connVar $ \conn ->
-                       withWriteLock (display description) fp $
-                       runSqlConn action conn
-      , withWriteLock_ = id
-      }
- where
-  wrapMigrationFailure = handleAny (throwIO . MigrationFailure description fp)
-
-  sqinfo isMigration
-    = set extraPragmas ["PRAGMA busy_timeout=2000;"]
-    $ set walEnabled False
-
-    -- When doing a migration, we want to disable foreign key checking, since
-    -- the order in which tables are created by the migration scripts may not
-    -- respect foreign keys. The rest of the time: enforce those foreign keys.
-    $ set fkEnabled (not isMigration)
-
-    $ mkSqliteConnectionInfo (fromString $ toFilePath fp)
-
--- | Ensure that only one process is trying to write to the database at a time.
--- See https://github.com/commercialhaskell/stack/issues/4471 and comments
--- above.
-withWriteLock ::
-     HasLogFunc env
-  => Utf8Builder -- ^ database description, for lock messages
-  -> Path Abs File -- ^ SQLite database file
-  -> RIO env a
-  -> RIO env a
-withWriteLock desc dbFile inner = do
-  let lockFile = toFilePath dbFile ++ ".pantry-write-lock"
-  withRunInIO $ \run -> do
-    mres <- withTryFileLock lockFile Exclusive $ const $ run inner
-    case mres of
-      Just res -> pure res
-      Nothing -> do
-        let complainer :: Companion IO
-            complainer delay = run $ do
-              -- Wait five seconds before giving the first message to
-              -- avoid spamming the user for uninteresting file locks
-              delay $ 5 * 1000 * 1000 -- 5 seconds
-              logInfo $
-                   "Unable to get a write lock on the "
-                <> desc
-                <> " database, waiting..."
-
-              -- Now loop printing a message every 1 minute
-              forever $ do
-                delay (60 * 1000 * 1000) -- 1 minute
-                  `onCompanionDone` logInfo
-                    (  "Acquired the "
-                    <> desc
-                    <> " database write lock"
-                    )
-                logWarn
-                  (  "Still waiting on the "
-                  <> desc
-                  <> " database write lock..."
-                  )
-        withCompanion complainer $ \stopComplaining ->
-          withFileLock lockFile Exclusive $ const $ do
-            stopComplaining
-            run inner

@@ -1,3320 +0,0 @@-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE BangPatterns               #-}
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE MultiWayIf                 #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TupleSections              #-}
-
-module Pantry.Types
-  ( PantryConfig (..)
-  , PackageIndexConfig (..)
-  , HackageSecurityConfig (..)
-  , defaultHackageSecurityConfig
-  , Storage (..)
-  , HasPantryConfig (..)
-  , BlobKey (..)
-  , PackageName
-  , Version
-  , PackageIdentifier (..)
-  , Revision (..)
-  , ModuleName
-  , CabalFileInfo (..)
-  , PrintWarnings (..)
-  , PackageNameP (..)
-  , VersionP (..)
-  , ModuleNameP (..)
-  , PackageIdentifierRevision (..)
-  , pirForHash
-  , FileType (..)
-  , BuildFile (..)
-  , FileSize (..)
-  , TreeEntry (..)
-  , SafeFilePath
-  , unSafeFilePath
-  , mkSafeFilePath
-  , safeFilePathToPath
-  , hpackSafeFilePath
-  , TreeKey (..)
-  , Tree (..)
-  , renderTree
-  , parseTree
-  , parseTreeM
-  , SHA256
-  , Unresolved
-  , resolvePaths
-  , Package (..)
-  , PackageCabal (..)
-  , PHpack (..)
-  -- , PackageTarball (..)
-  , RawPackageLocation (..)
-  , PackageLocation (..)
-  , toRawPL
-  , RawPackageLocationImmutable (..)
-  , PackageLocationImmutable (..)
-  , toRawPLI
-  , RawArchive (..)
-  , Archive (..)
-  , toRawArchive
-  , Repo (..)
-  , AggregateRepo (..)
-  , SimpleRepo (..)
-  , toAggregateRepos
-  , rToSimpleRepo
-  , arToSimpleRepo
-  , RepoType (..)
-  , parsePackageIdentifier
-  , parsePackageName
-  , parsePackageNameThrowing
-  , parseFlagName
-  , parseVersion
-  , parseVersionThrowing
-  , packageIdentifierString
-  , packageNameString
-  , flagNameString
-  , versionString
-  , moduleNameString
-  , OptionalSubdirs (..)
-  , ArchiveLocation (..)
-  , RelFilePath (..)
-  , CabalString (..)
-  , toCabalStringMap
-  , unCabalStringMap
-  , parsePackageIdentifierRevision
-  , Mismatch (..)
-  , PantryException (..)
-  , FuzzyResults (..)
-  , ResolvedPath (..)
-  , HpackExecutable (..)
-  , WantedCompiler (..)
-  --, resolveSnapshotLocation
-  , snapshotLocation
-  , defaultSnapshotLocation
-  , SnapName (..)
-  , parseSnapName
-  , RawSnapshotLocation (..)
-  , SnapshotLocation (..)
-  , toRawSL
-  , parseHackageText
-  , parseRawSnapshotLocation
-  , RawSnapshotLayer (..)
-  , SnapshotLayer (..)
-  , toRawSnapshotLayer
-  , RawSnapshot (..)
-  , Snapshot (..)
-  , RawSnapshotPackage (..)
-  , SnapshotPackage (..)
-  , parseWantedCompiler
-  , RawPackageMetadata (..)
-  , PackageMetadata (..)
-  , toRawPM
-  , cabalFileName
-  , SnapshotCacheHash (..)
-  , getGlobalHintsFile
-  , bsToBlobKey
-  , warnMissingCabalFile
-  , connRDBMS
-  ) where
-
-import           Casa.Client ( CasaRepoPrefix )
-import           Data.Aeson.Encoding.Internal ( unsafeToEncoding )
-import           Data.Aeson.Types ( Parser, toJSONKeyText )
-import           Data.ByteString.Builder
-                   ( byteString, toLazyByteString, wordDec )
-import qualified Data.List.NonEmpty as NE
-import           Data.Text.Read ( decimal )
-import           Distribution.CabalSpecVersion ( cabalSpecLatest )
-#if MIN_VERSION_Cabal(3,4,0)
-import           Distribution.CabalSpecVersion ( cabalSpecToVersionDigits )
-#else
-import           Distribution.CabalSpecVersion ( CabalSpecVersion (..) )
-#endif
-import           Distribution.ModuleName ( ModuleName )
-import           Distribution.PackageDescription
-                   ( FlagName, GenericPackageDescription, unFlagName )
-import           Distribution.Parsec
-                   ( PError (..), PWarning (..), ParsecParser
-                   , explicitEitherParsec, parsec, showPos
-                   )
-import qualified Distribution.Pretty
-import qualified Distribution.Text
-import           Distribution.Types.PackageId ( PackageIdentifier (..) )
-import           Distribution.Types.PackageName
-                   ( PackageName, mkPackageName, unPackageName )
-import           Distribution.Types.Version ( Version, mkVersion, nullVersion )
-import           Distribution.Types.VersionRange ( VersionRange )
-import qualified Data.Conduit.Tar as Tar
-import qualified Data.Map.Strict as Map ( mapKeysMonotonic )
-import           Database.Persist
-import           Database.Persist.Sql
-#if MIN_VERSION_persistent(2, 13, 0)
-import           Database.Persist.SqlBackend.Internal ( connRDBMS )
-#endif
-import qualified Distribution.Compat.CharParsing as Parse
-import qualified Hpack.Config as Hpack
-import           Network.HTTP.Client ( parseRequest )
-import           Network.HTTP.Types ( Status, statusCode )
-import           Pantry.Internal.AesonExtended
-                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
-                   , Object, ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..)
-                   , Value (..), WarningParser, WithJSONWarnings, (..:), (..:?)
-                   , (..!=), (.=), (.:), (...:?), jsonSubWarnings
-                   , jsonSubWarningsT, noJSONWarnings, object, tellJSONField
-                   , withObject, withObjectWarnings, withText
-                   )
-import           Pantry.SHA256 ( SHA256 )
-import qualified Pantry.SHA256 as SHA256
-import           Path
-                   ( Abs, Dir, File, Path, (</>), filename, parseRelFile
-                   , toFilePath
-                   )
-import           Path.IO ( resolveDir, resolveFile )
-import qualified RIO.Set as Set
-import           RIO
-import qualified RIO.ByteString as B
-import qualified RIO.ByteString.Lazy as BL
-import           RIO.List ( groupBy, intersperse )
-import qualified RIO.Text as T
-import           RIO.Time ( Day, UTCTime, toGregorian )
-import qualified RIO.Map as Map
-import           RIO.PrettyPrint
-                   ( bulletedList, fillSep, flow, hang, line, mkNarrativeList
-                   , parens, string, style
-                   )
-import           RIO.PrettyPrint.Types ( Style (..) )
-import           Text.PrettyPrint.Leijen.Extended ( Pretty (..), StyleDoc )
-
-#if MIN_VERSION_aeson(2, 0, 0)
-import qualified Data.Aeson.KeyMap as HM
-import qualified Data.Aeson.Key
-
-type AesonKey = Data.Aeson.Key.Key
-#else
-import qualified RIO.HashMap as HM
-
-type AesonKey = Text
-#endif
-
--- | Parsed tree with more information on the Haskell package it contains.
---
--- @since 0.1.0.0
-data Package = Package
-  { packageTreeKey :: !TreeKey
-    -- ^ The 'TreeKey' containing this package.
-    --
-    -- This is a hash of the binary representation of 'packageTree'.
-    --
-    -- @since 0.1.0.0
-  , packageTree :: !Tree
-    -- ^ The 'Tree' containing this package.
-    --
-    -- @since 0.1.0.0
-  , packageCabalEntry :: !PackageCabal
-    -- ^ Information on the cabal file inside this package.
-    --
-    -- @since 0.1.0.0
-  , packageIdent :: !PackageIdentifier
-    -- ^ The package name and version in this package.
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Show, Eq, Ord)
-
-data PHpack = PHpack
-  { phOriginal :: !TreeEntry
-    -- ^ Original hpack file
-  , phGenerated :: !TreeEntry
-    -- ^ Generated Cabal file
-  , phVersion :: !Version
-    -- ^ Version of Hpack used
-  }
-  deriving (Show, Eq, Ord)
-
-data PackageCabal
-  = PCCabalFile !TreeEntry -- ^ TreeEntry of Cabal file
-  | PCHpack !PHpack
-  deriving (Show, Eq, Ord)
-
-cabalFileName :: PackageName -> SafeFilePath
-cabalFileName name =
-  case mkSafeFilePath $ T.pack (packageNameString name) <> ".cabal" of
-    Nothing -> error $ "cabalFileName: failed for " ++ show name
-    Just sfp -> sfp
-
--- | The revision number of a package from Hackage, counting upwards from 0 (the
--- original cabal file).
---
--- See caveats on 'CFIRevision'.
---
--- @since 0.1.0.0
-newtype Revision = Revision Word
-  deriving (Generic, Show, Eq, NFData, Data, Typeable, Ord, Hashable, Display, PersistField, PersistFieldSql)
-
--- | 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.
-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
-  }
-
--- | Configuration value used by the entire pantry package. Create one using
--- 'withPantryConfig' or 'withPantryConfig''. See also 'PantryApp' for a
--- convenience approach to using pantry.
---
--- @since 0.1.0.0
-data PantryConfig = PantryConfig
-  { pcPackageIndex :: !PackageIndexConfig
-  , pcHpackExecutable :: !HpackExecutable
-  , pcRootDir :: !(Path Abs Dir)
-  , pcStorage :: !Storage
-  , pcUpdateRef :: !(MVar Bool)
-    -- ^ Want to try updating the index once during a single run for missing
-    -- package identifiers. We also want to ensure we only update once at a
-    -- time. Start at @True@.
-  , pcParsedCabalFilesRawImmutable ::
-      !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
-    -- ^ Cache of previously parsed cabal files, to save on slow parsing time.
-  , pcParsedCabalFilesMutable ::
-      !( IORef
-           ( Map
-             (Path Abs Dir)
-             ( PrintWarnings -> IO GenericPackageDescription
-             , PackageName
-             , Path Abs File
-             )
-           )
-       )
-    -- ^ Cache for mutable packages. We want to allow for an optimization:
-    -- deferring parsing of the 'GenericPackageDescription' until its actually
-    -- needed. Therefore, we keep the filepath and the 'PackageName' derived
-    -- from that filepath. When the @IO GenericPackageDescription@ is run, it
-    -- will ensure that the @PackageName@ matches the value inside the cabal
-    -- file, and print out any warnings that still need to be printed.
-  , pcConnectionCount :: !Int
-    -- ^ concurrently open downloads
-  , pcCasaConfig :: !(Maybe (CasaRepoPrefix, Int))
-    -- ^ Optionally, the Casa pull URL e.g. @https://casa.fpcomplete.com@ and
-    -- the maximum number of Casa keys to pull per request.
-  , pcSnapshotLocation :: SnapName -> RawSnapshotLocation
-    -- ^ The location of snapshot synonyms
-  }
-
--- | Get the location of a snapshot synonym from the 'PantryConfig'.
---
--- @since 0.5.0.0
-snapshotLocation ::
-     HasPantryConfig env
-  => SnapName
-  -> RIO env RawSnapshotLocation
-snapshotLocation name = do
-  loc <- view $ pantryConfigL.to pcSnapshotLocation
-  pure $ loc name
-
--- | Should we print warnings when loading a cabal file?
---
--- @since 0.1.0.0
-data PrintWarnings = YesPrintWarnings | NoPrintWarnings
-
--- | Wraps a value which potentially contains relative paths. Needs to be
--- provided with a base directory to resolve these paths.
---
--- Unwrap this using 'resolvePaths'.
---
--- @since 0.1.0.0
-newtype Unresolved a = Unresolved (Maybe (Path Abs Dir) -> IO a)
-  deriving Functor
-
-instance Applicative Unresolved where
-  pure = Unresolved . const . pure
-  Unresolved f <*> Unresolved x = Unresolved $ \mdir -> f mdir <*> x mdir
-
--- | Resolve all of the file paths in an 'Unresolved' relative to the given
--- directory.
---
--- @since 0.1.0.0
-resolvePaths ::
-     MonadIO m
-  => Maybe (Path Abs Dir) -- ^ directory to use for relative paths
-  -> Unresolved a
-  -> m a
-resolvePaths mdir (Unresolved f) = liftIO (f mdir)
-
--- | A combination of the relative path provided in a config file, together with
--- the resolved absolute path.
---
--- @since 0.1.0.0
-data ResolvedPath t = ResolvedPath
-  { resolvedRelative :: !RelFilePath
-    -- ^ Original value parsed from a config file.
-  , resolvedAbsolute :: !(Path Abs t)
-    -- ^ Absolute path resolved against base directory loaded from.
-  }
-  deriving (Show, Eq, Generic, Ord)
-
-instance NFData (ResolvedPath t)
-
--- | Location to load a package from. Can either be immutable (see
--- 'PackageLocationImmutable') or a local directory which is expected to change
--- over time. Raw version doesn't include exact package version (e.g. could
--- refer to the latest revision on Hackage)
---
--- @since 0.1.0.0
-data RawPackageLocation
-  = RPLImmutable !RawPackageLocationImmutable
-  | RPLMutable !(ResolvedPath Dir)
-  deriving (Show, Eq, Generic)
-
-instance NFData RawPackageLocation
-
--- | Location to load a package from. Can either be immutable (see
--- 'PackageLocationImmutable') or a local directory which is expected to change
--- over time.
---
--- @since 0.1.0.0
-data PackageLocation
-  = PLImmutable !PackageLocationImmutable
-  | PLMutable !(ResolvedPath Dir)
-  deriving (Show, Eq, Generic)
-
-instance NFData PackageLocation
-
-instance Display PackageLocation where
-  display (PLImmutable loc) = display loc
-  display (PLMutable fp) = fromString $ toFilePath $ resolvedAbsolute fp
-
--- | Convert `PackageLocation` to its "raw" equivalent
---
--- @since 0.1.0.0
-toRawPL :: PackageLocation -> RawPackageLocation
-toRawPL (PLImmutable im) = RPLImmutable (toRawPLI im)
-toRawPL (PLMutable m) = RPLMutable m
-
--- | Location for remote packages or archives assumed to be immutable.
--- as user specifies it i.e. not an exact location
---
--- @since 0.1.0.0
-data RawPackageLocationImmutable
-  = RPLIHackage !PackageIdentifierRevision !(Maybe TreeKey)
-  | RPLIArchive !RawArchive !RawPackageMetadata
-  | RPLIRepo    !Repo !RawPackageMetadata
-  deriving (Show, Eq, Ord, Generic)
-
-instance NFData RawPackageLocationImmutable
-
-instance Display RawPackageLocationImmutable where
-  display (RPLIHackage pir _tree) = display pir <> " (from Hackage)"
-  display (RPLIArchive archive _pm) =
-    "Archive from " <> display (raLocation archive) <>
-    (if T.null $ raSubdir archive
-       then mempty
-       else " in subdir " <> display (raSubdir archive))
-  display (RPLIRepo repo _pm) =
-    "Repo from " <> display (repoUrl repo) <>
-    ", commit " <> display (repoCommit repo) <>
-    (if T.null $ repoSubdir repo
-       then mempty
-       else " in subdir " <> display (repoSubdir repo))
-
-instance Pretty RawPackageLocationImmutable where
-  pretty (RPLIHackage pir _tree) = fillSep
-    [ fromString . T.unpack $ textDisplay pir
-    , parens (flow "from Hackage")
-    ]
-  pretty (RPLIArchive archive _pm) = fillSep
-    [ flow "Archive from"
-    , pretty (raLocation archive)
-    , if T.null $ raSubdir archive
-        then mempty
-        else fillSep
-          [ flow "in subdir"
-          , style Dir (fromString $ T.unpack (raSubdir archive))
-          ]
-    ]
-  pretty (RPLIRepo repo _pm) = fillSep
-    [ flow "Repo from"
-    , style Url (fromString $ T.unpack (repoUrl repo)) <> ","
-    , "commit"
-    , fromString $ T.unpack (repoCommit repo)
-    , if T.null $ repoSubdir repo
-        then mempty
-        else fillSep
-          [ flow "in subdir"
-          , style Dir (fromString $ T.unpack (repoSubdir repo))
-          ]
-    ]
-
--- | Location for remote packages or archives assumed to be immutable.
---
--- @since 0.1.0.0
-data PackageLocationImmutable
-  = PLIHackage !PackageIdentifier !BlobKey !TreeKey
-  | PLIArchive !Archive !PackageMetadata
-  | PLIRepo    !Repo !PackageMetadata
-  deriving (Generic, Show, Eq, Ord, Typeable)
-
-instance NFData PackageLocationImmutable
-
-instance Display PackageLocationImmutable where
-  display (PLIHackage ident _cabalHash _tree) =
-    fromString (packageNameString $ pkgName ident) <> " (from Hackage)"
-  display (PLIArchive archive _pm) =
-    "Archive from " <> display (archiveLocation archive) <>
-    (if T.null $ archiveSubdir archive
-       then mempty
-       else " in subdir " <> display (archiveSubdir archive))
-  display (PLIRepo repo _pm) =
-    "Repo from " <> display (repoUrl repo) <>
-    ", commit " <> display (repoCommit repo) <>
-    (if T.null $ repoSubdir repo
-       then mempty
-       else " in subdir " <> display (repoSubdir repo))
-
-instance ToJSON PackageLocationImmutable where
-  toJSON = toJSON . toRawPLI
-
--- | Package identifier and revision with a specified cabal file hash
---
--- @since 0.1.0.0
-pirForHash :: PackageIdentifier -> BlobKey -> PackageIdentifierRevision
-pirForHash (PackageIdentifier name ver) (BlobKey sha size') =
-  let cfi = CFIHash sha (Just size')
-  in PackageIdentifierRevision name ver cfi
-
--- | Convert `PackageLocationImmutable` to its "raw" equivalent
---
--- @since 0.1.0.0
-toRawPLI :: PackageLocationImmutable -> RawPackageLocationImmutable
-toRawPLI (PLIHackage ident cfKey treeKey) =
-  RPLIHackage (pirForHash ident cfKey) (Just treeKey)
-toRawPLI (PLIArchive archive pm) =
-  RPLIArchive (toRawArchive archive) (toRawPM pm)
-toRawPLI (PLIRepo repo pm) = RPLIRepo repo (toRawPM pm)
-
--- | A raw package archive, specified by a user, could have no
--- hash and file size information.
---
--- @since 0.1.0.0
-data RawArchive = RawArchive
-  { raLocation :: !ArchiveLocation
-    -- ^ Location of the archive
-    --
-    -- @since 0.1.0.0
-  , raHash :: !(Maybe SHA256)
-    -- ^ Cryptographic hash of the archive file
-    --
-    -- @since 0.1.0.0
-  , raSize :: !(Maybe FileSize)
-    -- ^ Size of the archive file
-    --
-    -- @since 0.1.0.0
-  , raSubdir :: !Text
-    -- ^ Subdirectory within the archive to get the package from.
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Generic, Show, Eq, Ord, Typeable)
-
-instance NFData RawArchive
-
--- | A package archive, could be from a URL or a local file path. Local file
--- path archives are assumed to be unchanging over time, and so are allowed in
--- custom snapshots.
---
--- @since 0.1.0.0
-data Archive = Archive
-  { archiveLocation :: !ArchiveLocation
-    -- ^ Location of the archive
-    --
-    -- @since 0.1.0.0
-  , archiveHash :: !SHA256
-    -- ^ Cryptographic hash of the archive file
-    --
-    -- @since 0.1.0.0
-  , archiveSize :: !FileSize
-    -- ^ Size of the archive file
-    --
-    -- @since 0.1.0.0
-  , archiveSubdir :: !Text
-    -- ^ Subdirectory within the archive to get the package from.
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Generic, Show, Eq, Ord, Typeable)
-
-instance NFData Archive
-
--- | Convert archive to its "raw" equivalent.
---
--- @since 0.1.0.0
-toRawArchive :: Archive -> RawArchive
-toRawArchive archive =
-  RawArchive (archiveLocation archive) (Just $ archiveHash archive)
-             (Just $ archiveSize archive) (archiveSubdir archive)
-
--- | The type of a source control repository.
---
--- @since 0.1.0.0
-data RepoType = RepoGit | RepoHg
-  deriving (Generic, Show, Eq, Ord, Typeable)
-
-instance NFData RepoType
-
-instance PersistField RepoType where
-  toPersistValue RepoGit = toPersistValue (1 :: Int32)
-  toPersistValue RepoHg = toPersistValue (2 :: Int32)
-  fromPersistValue v = do
-    i <- fromPersistValue v
-    case i :: Int32 of
-      1 -> pure RepoGit
-      2 -> pure RepoHg
-      _ -> Left $ fromString $ "Invalid RepoType: " ++ show i
-
-instance PersistFieldSql RepoType where
-  sqlType _ = SqlInt32
-
--- | Information on packages stored in a source control repository.
---
--- @since 0.1.0.0
-data Repo = Repo
-  { repoUrl :: !Text
-    -- ^ Location of the repo
-    --
-    -- @since 0.1.0.0
-  , repoCommit :: !Text
-    -- ^ Commit to use from the repo. It's strongly recommended to use
-    -- a hash instead of a tag or branch name.
-    --
-    -- @since 0.1.0.0
-  , repoType :: !RepoType
-    -- ^ The type of the repo
-    --
-    -- @since 0.1.0.0
-  , repoSubdir :: !Text
-    -- ^ Subdirectory within the archive to get the package from.
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Generic, Eq, Ord, Typeable)
-
-instance NFData Repo
-
-instance Show Repo where
-  show = T.unpack . utf8BuilderToText . display
-
-instance Display Repo where
-  display (Repo url commit typ subdir) =
-    (case typ of
-       RepoGit -> "Git"
-       RepoHg -> "Mercurial") <>
-    " repo at " <>
-    display url <>
-    ", commit " <>
-    display commit <>
-    (if T.null subdir
-      then mempty
-      else " in subdirectory " <> display subdir)
-
-rToSimpleRepo :: Repo -> SimpleRepo
-rToSimpleRepo Repo {..} = SimpleRepo
-  { sRepoUrl = repoUrl
-  , sRepoCommit = repoCommit
-  , sRepoType = repoType
-  }
-
-data AggregateRepo = AggregateRepo
-  { aRepo :: !SimpleRepo
-  , aRepoSubdirs :: [(Text, RawPackageMetadata)]
-  }
-  deriving (Show, Generic, Eq, Ord, Typeable)
-
--- | Group input repositories by non-subdir values.
-toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
-toAggregateRepos = mapMaybe toAggregateRepo . groupBy matchRepoExclSubdir
- where
-  toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
-  toAggregateRepo [] = Nothing
-  toAggregateRepo xs@((repo, _):_) =
-    Just $ AggregateRepo (rToSimpleRepo repo) (fmap (first repoSubdir) xs)
-
-  matchRepoExclSubdir x1 x2 =
-    let (Repo url1 commit1 type1 _, _) = x1
-        (Repo url2 commit2 type2 _, _) = x2
-    in  (url1, commit1, type1) == (url2, commit2, type2)
-
-arToSimpleRepo :: AggregateRepo -> SimpleRepo
-arToSimpleRepo AggregateRepo {..} = aRepo
-
--- | Repository without subdirectory information.
---
--- @since 0.5.3
-data SimpleRepo = SimpleRepo
-  { sRepoUrl :: !Text
-  , sRepoCommit :: !Text
-  , sRepoType :: !RepoType
-  }
-  deriving (Show, Generic, Eq, Ord, Typeable)
-
-instance Display SimpleRepo where
-  display (SimpleRepo url commit typ) =
-    (case typ of
-       RepoGit -> "Git"
-       RepoHg -> "Mercurial") <>
-    " repo at " <>
-    display url <>
-    ", commit " <>
-    display commit
-
--- An unexported newtype wrapper to hang a 'FromJSON' instance off of. Contains
--- a GitHub user and repo name separated by a forward slash, e.g. "foo/bar".
-newtype GitHubRepo = GitHubRepo Text
-
-instance FromJSON GitHubRepo where
-  parseJSON = withText "GitHubRepo" $ \s -> do
-    case T.split (== '/') s of
-      [x, y] | not (T.null x || T.null y) -> pure (GitHubRepo s)
-      _ -> fail "expecting \"user/repo\""
-
--- | Configuration to securely download package metadata and contents. For most
--- purposes, you'll want to use the default Hackage settings via
--- @defaultPackageIndexConfig@.
---
--- /NOTE/ It's highly recommended to only use the official Hackage
--- server or a mirror. See
--- <https://github.com/commercialhaskell/stack/issues/4137>.
---
--- @since 0.6.0
-data PackageIndexConfig = PackageIndexConfig
-  { picDownloadPrefix :: !Text
-  , picHackageSecurityConfig :: !HackageSecurityConfig
-  }
-  deriving Show
-
--- | If the @hackage-security@ key is absent from the JSON object, assigns
--- default value 'defaultHackageSecurityConfig'.
---
--- @since 0.6.0
-instance FromJSON (WithJSONWarnings PackageIndexConfig) where
-  parseJSON = withObjectWarnings "PackageIndexConfig" $ \o -> do
-    picDownloadPrefix <- o ..: "download-prefix"
-    picHackageSecurityConfig <- jsonSubWarnings $
-      o ..:? "hackage-security" ..!= noJSONWarnings defaultHackageSecurityConfig
-    pure PackageIndexConfig {..}
-
--- | Default 'HackageSecurityConfig' value using the official Hackage server.
--- The value of the 'hscIgnoreExpiry' field is 'True'.
---
--- @since 0.7.0
-defaultHackageSecurityConfig :: HackageSecurityConfig
-defaultHackageSecurityConfig = HackageSecurityConfig
-  { hscKeyIds =
-      [ "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"
-      , "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"
-      , "2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3"
-      , "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
-      , "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"
-      ]
-  , hscKeyThreshold = 3
-  , hscIgnoreExpiry = True
-  }
-
--- | Configuration for Hackage Security to securely download package metadata
--- and contents. For most purposes, you'll want to use the default Hackage
--- settings via @defaultHackageSecurityConfig@.
---
--- /NOTE/ It's highly recommended to only use the official Hackage
--- server or a mirror. See
--- <https://github.com/commercialhaskell/stack/issues/4137>.
---
--- @since 0.6.0
-data HackageSecurityConfig = HackageSecurityConfig
-  { hscKeyIds :: ![Text]
-  , hscKeyThreshold :: !Int
-  , hscIgnoreExpiry :: !Bool
-  }
-  deriving Show
-
--- | If the @ignore-expiry@ key is absent from the JSON object, assigns default
--- value 'True'.
---
--- @since 0.1.1.0
-instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
-  parseJSON = withObjectWarnings "HackageSecurityConfig" $ \o -> do
-    hscKeyIds <- o ..: "keyids"
-    hscKeyThreshold <- o ..: "key-threshold"
-    hscIgnoreExpiry <- o ..:? "ignore-expiry" ..!= True
-    pure HackageSecurityConfig {..}
-
--- | An environment which contains a 'PantryConfig'.
---
--- @since 0.1.0.0
-class HasPantryConfig env where
-  -- | Lens to get or set the 'PantryConfig'
-  --
-  -- @since 0.1.0.0
-  pantryConfigL :: Lens' env PantryConfig
-
-
--- | File size in bytes
---
--- @since 0.1.0.0
-newtype FileSize = FileSize Word
-  deriving ( Show, Eq, Ord, Typeable, Generic, Display, Hashable, NFData
-           , PersistField, PersistFieldSql, ToJSON, FromJSON
-           )
-
--- | A key for looking up a blob, which combines the SHA256 hash of the contents
--- and the file size.
---
--- The file size may seem redundant with the hash. However, it is necessary for
--- safely downloading blobs from an untrusted source. See
--- <https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys>.
---
--- @since 0.1.0.0
-data BlobKey = BlobKey !SHA256 !FileSize
-  deriving (Eq, Ord, Typeable, Generic)
-
-instance NFData BlobKey
-
-instance Show BlobKey where
-  show = T.unpack . utf8BuilderToText . display
-
-instance Display BlobKey where
-  display (BlobKey sha size') = display sha <> "," <> display size'
-
-blobKeyPairs :: BlobKey -> [(AesonKey, Value)]
-blobKeyPairs (BlobKey sha size') =
-  [ "sha256" .= sha
-  , "size" .= size'
-  ]
-
-instance ToJSON BlobKey where
-  toJSON = object . blobKeyPairs
-
-instance FromJSON BlobKey where
-  parseJSON = withObject "BlobKey" $ \o -> BlobKey
-    <$> o .: "sha256"
-    <*> o .: "size"
-
-newtype PackageNameP = PackageNameP { unPackageNameP :: PackageName }
-  deriving (Eq, Ord, Show, Read, NFData)
-
-instance Display PackageNameP where
-  display = fromString . packageNameString . unPackageNameP
-
-instance PersistField PackageNameP where
-  toPersistValue (PackageNameP pn) = PersistText $ T.pack $ packageNameString pn
-  fromPersistValue v = do
-    str <- fromPersistValue v
-    case parsePackageName str of
-      Nothing -> Left $ "Invalid package name: " <> T.pack str
-      Just pn -> Right $ PackageNameP pn
-
-instance PersistFieldSql PackageNameP where
-  sqlType _ = SqlString
-
-instance ToJSON PackageNameP where
-  toJSON (PackageNameP pn) = String $ T.pack $ packageNameString pn
-
-instance FromJSON PackageNameP where
-  parseJSON =
-    withText "PackageNameP" $ pure . PackageNameP . mkPackageName . T.unpack
-
-instance ToJSONKey PackageNameP where
-  toJSONKey =
-    ToJSONKeyText
-      (fromString . packageNameString . unPackageNameP)
-      (unsafeToEncoding . getUtf8Builder . display)
-
-instance FromJSONKey PackageNameP where
-  fromJSONKey = FromJSONKeyText $ PackageNameP . mkPackageName . T.unpack
-
-newtype VersionP = VersionP { unVersionP :: Version }
-  deriving (Eq, Ord, Show, Read, NFData)
-
-instance PersistField VersionP where
-  toPersistValue (VersionP v) = PersistText $ T.pack $ versionString v
-  fromPersistValue v = do
-    str <- fromPersistValue v
-    case parseVersion str of
-      Nothing -> Left $ "Invalid version number: " <> T.pack str
-      Just ver -> Right $ VersionP ver
-
-instance PersistFieldSql VersionP where
-  sqlType _ = SqlString
-
-instance Display VersionP where
-  display (VersionP v) = fromString $ versionString v
-
-instance ToJSON VersionP where
-  toJSON (VersionP v) = String $ T.pack $ versionString v
-
-instance FromJSON VersionP where
-  parseJSON =
-    withText "VersionP" $
-    either (fail . displayException) (pure . VersionP) . parseVersionThrowing . T.unpack
-
-newtype ModuleNameP = ModuleNameP
-  { unModuleNameP :: ModuleName
-  }
-  deriving (Eq, Ord, Show, NFData)
-
-instance Display ModuleNameP where
-  display = fromString . moduleNameString . unModuleNameP
-
-instance PersistField ModuleNameP where
-  toPersistValue (ModuleNameP mn) = PersistText $ T.pack $ moduleNameString mn
-  fromPersistValue v = do
-    str <- fromPersistValue v
-    case parseModuleName str of
-      Nothing -> Left $ "Invalid module name: " <> T.pack str
-      Just pn -> Right $ ModuleNameP pn
-
-instance PersistFieldSql ModuleNameP where
-  sqlType _ = SqlString
-
--- | How to choose a cabal file for a package from Hackage. This is to work with
--- Hackage cabal file revisions, which makes @PackageIdentifier@ insufficient
--- for specifying a package from Hackage.
---
--- @since 0.1.0.0
-data CabalFileInfo
-  = CFILatest
-    -- ^ Take the latest revision of the cabal file available. This
-    -- isn't reproducible at all, but the running assumption (not
-    -- necessarily true) is that cabal file revisions do not change
-    -- semantics of the build.
-    --
-    -- @since 0.1.0.0
-  | CFIHash !SHA256 !(Maybe FileSize)
-    -- ^ Identify by contents of the cabal file itself. Only reason for
-    -- @Maybe@ on @FileSize@ is for compatibility with input that
-    -- doesn't include the file size.
-    --
-    -- @since 0.1.0.0
-  | CFIRevision !Revision
-    -- ^ Identify by revision number, with 0 being the original and
-    -- counting upward. This relies on Hackage providing consistent
-    -- versioning. @CFIHash@ should be preferred wherever possible for
-    -- reproducibility.
-    --
-    -- @since 0.1.0.0
-  deriving (Generic, Show, Eq, Ord, Typeable)
-
-instance NFData CabalFileInfo
-
-instance Hashable CabalFileInfo
-
-instance Display CabalFileInfo where
-  display CFILatest = mempty
-  display (CFIHash hash' msize) =
-    "@sha256:" <> display hash' <> maybe mempty (\i -> "," <> display i) msize
-  display (CFIRevision rev) = "@rev:" <> display rev
-
--- | A full specification for a package from Hackage, including the package
--- name, version, and how to load up the correct cabal file revision.
---
--- @since 0.1.0.0
-data PackageIdentifierRevision
-  = PackageIdentifierRevision !PackageName !Version !CabalFileInfo
-  deriving (Generic, Eq, Ord, Typeable)
-
-instance NFData PackageIdentifierRevision
-
-instance Show PackageIdentifierRevision where
-  show = T.unpack . utf8BuilderToText . display
-
-instance Display PackageIdentifierRevision where
-  display (PackageIdentifierRevision name version cfi) =
-       fromString (packageNameString name)
-    <> "-"
-    <> fromString (versionString version)
-    <> display cfi
-
-instance ToJSON PackageIdentifierRevision where
-  toJSON = toJSON . utf8BuilderToText . display
-
-instance FromJSON PackageIdentifierRevision where
-  parseJSON = withText "PackageIdentifierRevision" $ \t ->
-    case parsePackageIdentifierRevision t of
-      Left e -> fail $ show e
-      Right pir -> pure pir
-
--- | Parse a hackage text.
---
--- @since 0.1.0.0
-parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
-parseHackageText t =
-  either (\x -> error (show x) $ const $ Left $ PackageIdentifierRevisionParseFail t) Right $
-  explicitEitherParsec (hackageTextParsec <* Parse.eof) $
-  T.unpack t
-
-hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
-hackageTextParsec = do
-  ident <- packageIdentifierParsec
-  _ <- Parse.string "@sha256:"
-
-  shaT <- Parse.munch (/= ',')
-  sha <- either (const mzero) pure $ SHA256.fromHexText $ fromString shaT
-
-  _ <- Parse.char ','
-  size' <- Parse.integral -- FIXME probably need to handle overflow, since unfortunately Cabal doesn't
-  pure (ident, BlobKey sha (FileSize size'))
-
-splitColon :: Text -> Maybe (Text, Text)
-splitColon t' =
-  let (x, y) = T.break (== ':') t'
-  in  (x, ) <$> T.stripPrefix ":" y
-
--- | Parse a 'PackageIdentifierRevision'
---
--- @since 0.1.0.0
-parsePackageIdentifierRevision ::
-     Text
-  -> Either PantryException PackageIdentifierRevision
-parsePackageIdentifierRevision t =
-  maybe (Left $ PackageIdentifierRevisionParseFail t) Right $ do
-    let (identT, cfiT) = T.break (== '@') t
-    PackageIdentifier name version <- parsePackageIdentifier $ T.unpack identT
-    cfi <-
-      case splitColon cfiT of
-        Just ("@sha256", shaSizeT) -> do
-          let (shaT, sizeT) = T.break (== ',') shaSizeT
-          sha <- either (const Nothing) Just $ SHA256.fromHexText shaT
-          msize <-
-            case T.stripPrefix "," sizeT of
-              Nothing -> Just Nothing
-              Just sizeT' ->
-                case decimal sizeT' of
-                  Right (size', "") -> Just $ Just $ FileSize size'
-                  _ -> Nothing
-          pure $ CFIHash sha msize
-        Just ("@rev", revT) ->
-          case decimal revT of
-            Right (rev, "") -> pure $ CFIRevision $ Revision rev
-            _ -> Nothing
-        Nothing -> pure CFILatest
-        _ -> Nothing
-    pure $ PackageIdentifierRevision name version cfi
-
-data Mismatch a = Mismatch
-  { mismatchExpected :: !a
-  , mismatchActual :: !a
-  }
-
--- | Things that can go wrong in pantry. Note two things:
---
--- * Many other exception types may be thrown from underlying libraries. Pantry
---   does not attempt to wrap these underlying exceptions.
---
--- * We may add more constructors to this data type in minor version bumps of
---   pantry. This technically breaks the PVP. You should not be writing pattern
---   matches against this type that expect total matching.
---
--- @since 0.1.0.0
-data PantryException
-  = PackageIdentifierRevisionParseFail !Text
-  | InvalidCabalFile
-      !(Either RawPackageLocationImmutable (Path Abs File))
-      !(Maybe Version)
-      ![PError]
-      ![PWarning]
-  | TreeWithoutCabalFile !RawPackageLocationImmutable
-  | TreeWithMultipleCabalFiles !RawPackageLocationImmutable ![SafeFilePath]
-  | MismatchedCabalName !(Path Abs File) !PackageName
-  | NoLocalPackageDirFound !(Path Abs Dir)
-  | NoCabalFileFound !(Path Abs Dir)
-  | MultipleCabalFilesFound !(Path Abs Dir) ![Path Abs File]
-  | InvalidWantedCompiler !Text
-  | InvalidSnapshotLocation !(Path Abs Dir) !Text
-  | InvalidOverrideCompiler !WantedCompiler !WantedCompiler
-  | InvalidFilePathSnapshot !Text
-  | InvalidSnapshot !RawSnapshotLocation !SomeException
-  | MismatchedPackageMetadata
-      !RawPackageLocationImmutable
-      !RawPackageMetadata
-      !(Maybe TreeKey)
-      !PackageIdentifier
-  | Non200ResponseStatus !Status
-  | InvalidBlobKey !(Mismatch BlobKey)
-  | Couldn'tParseSnapshot !RawSnapshotLocation !String
-  | WrongCabalFileName !RawPackageLocationImmutable !SafeFilePath !PackageName
-  | DownloadInvalidSHA256 !Text !(Mismatch SHA256)
-  | DownloadInvalidSize !Text !(Mismatch FileSize)
-  | DownloadTooLarge !Text !(Mismatch FileSize)
-  -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is
-  -- a lower bound on the size from the server.
-  | LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
-  | LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
-  | UnknownArchiveType !ArchiveLocation
-  | InvalidTarFileType !ArchiveLocation !FilePath !Tar.FileType
-  | UnsupportedTarball !ArchiveLocation !Text
-  | NoHackageCryptographicHash !PackageIdentifier
-  | FailedToCloneRepo !SimpleRepo
-  | TreeReferencesMissingBlob !RawPackageLocationImmutable !SafeFilePath !BlobKey
-  | CompletePackageMetadataMismatch !RawPackageLocationImmutable !PackageMetadata
-  | CRC32Mismatch !ArchiveLocation !FilePath !(Mismatch Word32)
-  | UnknownHackagePackage !PackageIdentifierRevision !FuzzyResults
-  | CannotCompleteRepoNonSHA1 !Repo
-  | MutablePackageLocationFromUrl !Text
-  | MismatchedCabalFileForHackage !PackageIdentifierRevision !(Mismatch PackageIdentifier)
-  | PackageNameParseFail !Text
-  | PackageVersionParseFail !Text
-  | InvalidCabalFilePath !(Path Abs File)
-  | DuplicatePackageNames !Utf8Builder ![(PackageName, [RawPackageLocationImmutable])]
-  | MigrationFailure !Text !(Path Abs File) !SomeException
-  | NoCasaConfig
-  | InvalidTreeFromCasa !BlobKey !ByteString
-  | ParseSnapNameException !Text
-  | HpackLibraryException !(Path Abs File) !String
-  | HpackExeException !FilePath !(Path Abs Dir) !SomeException
-  deriving Typeable
-
-instance Exception PantryException where
-
-instance Show PantryException where
-  show = T.unpack . utf8BuilderToText . display
-
--- To support the Haskell Foundation's
--- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry
--- error messages generated by Pantry itself begin with an unique code in the
--- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.
--- The numbers are selected at random, not in sequence.
---
--- Prettier versions of these error messages are also provided. See the instance
--- of Pretty.
-instance Display PantryException where
-  display NoCasaConfig =
-    "Error: [S-889]\n"
-    <> "The Pantry configuration has no Casa configuration."
-  display (InvalidTreeFromCasa blobKey _bs) =
-    "Error: [S-258]\n"
-    <> "Invalid tree from casa: "
-    <> display blobKey
-  display (PackageIdentifierRevisionParseFail text) =
-    "Error: [S-360]\n"
-    <> "Invalid package identifier (with optional revision): "
-    <> display text
-  display (InvalidCabalFile loc mversion errs warnings) =
-    "Error: [S-242]\n"
-    <> "Unable to parse cabal file from package "
-    <> either display (fromString . toFilePath) loc
-    <> "\n\n"
-    <> foldMap
-         ( \(PError pos msg) ->
-                 "- "
-              <> fromString (showPos pos)
-              <> ": "
-              <> fromString msg
-              <> "\n"
-         )
-         errs
-    <> foldMap
-         ( \(PWarning _ pos msg) ->
-                 "- "
-              <> fromString (showPos pos)
-              <> ": "
-              <> fromString msg
-              <> "\n"
-         )
-         warnings
-    <> ( case mversion of
-           Just version
-             | version > cabalSpecLatestVersion ->
-                    "\n\nThe cabal file uses the cabal specification version "
-                 <> fromString (versionString version)
-                 <> ", but we only support up to version "
-                 <> fromString (versionString cabalSpecLatestVersion)
-                 <> ".\nRecommended action: upgrade your build tool (e.g., `stack upgrade`)."
-           _ -> mempty
-       )
-  display (TreeWithoutCabalFile pl) =
-    "Error: [S-654]\n"
-    <> "No cabal file found for "
-    <> display pl
-  display (TreeWithMultipleCabalFiles pl sfps) =
-    "Error: [S-500]\n"
-    <> "Multiple cabal files found for "
-    <> display pl
-    <> ": "
-    <> fold (intersperse ", " (map display sfps))
-  display (MismatchedCabalName fp name) =
-    "Error: [S-910]\n"
-    <> "The Cabal file:\n"
-    <> fromString (toFilePath fp)
-    <> "\nis not named after the package that it defines.\n"
-    <> "Please rename the file to: "
-    <> fromString (packageNameString name)
-    <> ".cabal\n"
-    <> "Hackage rejects packages where the first part of the Cabal file name "
-    <> "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"
-    <> "The current entry points to "
-    <> fromString (toFilePath dir)
-    <> ",\nbut no such directory could be found. If, alternatively, a package\n"
-    <> "in the package index was intended, its name and version must be\n"
-    <> "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"
-    <> "The current entry points to "
-    <> fromString (toFilePath dir)
-    <> ",\nbut no .cabal or package.yaml file could be found there."
-  display (MultipleCabalFilesFound dir files) =
-    "Error: [S-368]\n"
-    <> "Multiple .cabal files found in directory "
-    <> fromString (toFilePath dir)
-    <> ":\n"
-    <> fold
-         ( intersperse
-             "\n"
-             (map (\x -> "- " <> fromString (toFilePath (filename x))) files)
-         )
-  display (InvalidWantedCompiler t) =
-    "Error: [S-204]\n"
-    <> "Invalid wanted compiler: "
-    <> display t
-  display (InvalidSnapshotLocation dir t) =
-    "Error: [S-935]\n"
-    <> "Invalid snapshot location "
-    <> displayShow t
-    <> " relative to directory "
-    <> displayShow (toFilePath dir)
-  display (InvalidOverrideCompiler x y) =
-    "Error: [S-287]\n"
-    <> "Specified compiler for a resolver ("
-    <> display x
-    <> "), but also specified an override compiler ("
-    <> display y
-    <> ")"
-  display (InvalidFilePathSnapshot t) =
-    "Error: [S-617]\n"
-    <> "Specified snapshot as file path with "
-    <> displayShow t
-    <> ", but not reading from a local file"
-  display (InvalidSnapshot loc err) =
-    "Error: [S-775]\n"
-    <> "Exception while reading snapshot from "
-    <> display loc
-    <> ":\n"
-    <> displayShow err
-  display (MismatchedPackageMetadata loc pm mtreeKey foundIdent) =
-    "Error: [S-427]\n"
-    <> "Mismatched package metadata for "
-    <> display loc
-    <> "\nFound: "
-    <> fromString (packageIdentifierString foundIdent)
-    <> ( case mtreeKey of
-           Nothing -> mempty
-           Just treeKey -> " with tree " <> display treeKey
-       )
-    <> "\nExpected: "
-    <> display pm
-  display (Non200ResponseStatus status) =
-    "Error: [S-571]\n"
-    <> "Unexpected non-200 HTTP status code: "
-    <> displayShow (statusCode status)
-  display (InvalidBlobKey Mismatch{..}) =
-    "Error: [S-236]\n"
-    <> "Invalid blob key found, expected: "
-    <> display mismatchExpected
-    <> ", actual: "
-    <> display mismatchActual
-  display (Couldn'tParseSnapshot sl err) =
-    "Error: [S-645]\n"
-    <> "Couldn't parse snapshot from "
-    <> display sl
-    <> ": "
-    <> fromString err
-  display (WrongCabalFileName pl sfp name) =
-    "Error: [S-575]\n"
-    <> "Wrong cabal file name for package "
-    <> display pl
-    <> "\nThe cabal file is named "
-    <> display sfp
-    <> ", but package name is "
-    <> fromString (packageNameString name)
-    <> "\nFor more information, see:\n  - https://github.com/commercialhaskell/stack/issues/317\n  -https://github.com/commercialhaskell/stack/issues/895"
-  display (DownloadInvalidSHA256 url Mismatch {..}) =
-    "Error: [S-394]\n"
-    <> "Mismatched SHA256 hash from "
-    <> display url
-    <> "\nExpected: "
-    <> display mismatchExpected
-    <> "\nActual:   "
-    <> display mismatchActual
-  display (DownloadInvalidSize url Mismatch {..}) =
-    "Error: [S-401]\n"
-    <> "Mismatched download size from "
-    <> display url
-    <> "\nExpected: "
-    <> display mismatchExpected
-    <> "\nActual:   "
-    <> display mismatchActual
-  display (DownloadTooLarge url Mismatch {..}) =
-    "Error: [S-113]\n"
-    <> "Download from "
-    <> display url
-    <> " was too large.\n"
-    <> "Expected: "
-    <> display mismatchExpected
-    <> ", stopped after receiving: "
-    <> display mismatchActual
-  display (LocalInvalidSHA256 path Mismatch {..}) =
-    "Error: [S-834]\n"
-    <> "Mismatched SHA256 hash from "
-    <> fromString (toFilePath path)
-    <> "\nExpected: "
-    <> display mismatchExpected
-    <> "\nActual:   "
-    <> display mismatchActual
-  display (LocalInvalidSize path Mismatch {..}) =
-    "Error: [S-713]\n"
-    <> "Mismatched file size from "
-    <> fromString (toFilePath path)
-    <> "\nExpected: "
-    <> display mismatchExpected
-    <> "\nActual:   "
-    <> display mismatchActual
-  display (UnknownArchiveType loc) =
-    "Error: [S-372]\n"
-    <> "Unable to determine archive type of: "
-    <> display loc
-  display (InvalidTarFileType loc fp x) =
-    "Error: [S-950]\n"
-    <> "Unsupported tar file type in archive "
-    <> display loc
-    <> " at file "
-    <> fromString fp
-    <> ": "
-    <> displayShow x
-  display (UnsupportedTarball loc err) =
-    "Error: [S-760]\n"
-    <> "Unsupported tarball from "
-    <> display loc
-    <> ": "
-    <> display err
-  display (NoHackageCryptographicHash ident) =
-    "Error: [S-922]\n"
-    <> "No cryptographic hash found for Hackage package "
-    <> fromString (packageIdentifierString ident)
-  display (FailedToCloneRepo repo) =
-    "Error: [S-109]\n"
-    <> "Failed to clone repo "
-    <> display repo
-  display (TreeReferencesMissingBlob loc sfp key) =
-    "Error: [S-237]\n"
-    <> "The package "
-    <> display loc
-    <> " needs blob "
-    <> display key
-    <> " for file path "
-    <> display sfp
-    <> ", but the blob is not available"
-  display (CompletePackageMetadataMismatch loc pm) =
-    "Error: [S-984]\n"
-    <> "When completing package metadata for "
-    <> display loc
-    <> ", some values changed in the new package metadata: "
-    <> display pm
-  display (CRC32Mismatch loc fp Mismatch {..}) =
-    "Error: [S-607]\n"
-    <> "CRC32 mismatch in ZIP file from "
-    <> display loc
-    <> " on internal file "
-    <> fromString fp
-    <> "\nExpected: "
-    <> display mismatchExpected
-    <> "\nActual:   "
-    <> display mismatchActual
-  display (UnknownHackagePackage pir fuzzy) =
-    "Error: [S-476]\n"
-    <> "Could not find "
-    <> display pir
-    <> " on Hackage"
-    <> displayFuzzy fuzzy
-  display (CannotCompleteRepoNonSHA1 repo) =
-    "Error: [S-112]\n"
-    <> "Cannot complete repo information for a non SHA1 commit due to non-reproducibility: "
-    <> display repo
-  display (MutablePackageLocationFromUrl t) =
-    "Error: [S-321]\n"
-    <> "Cannot refer to a mutable package location from a URL: "
-    <> display t
-  display (MismatchedCabalFileForHackage pir Mismatch{..}) =
-    "Error: [S-377]\n"
-    <> "When processing cabal file for Hackage package "
-    <> display pir
-    <> ":\nMismatched package identifier."
-    <> "\nExpected: "
-    <> fromString (packageIdentifierString mismatchExpected)
-    <> "\nActual:   "
-    <> fromString (packageIdentifierString mismatchActual)
-  display (PackageNameParseFail t) =
-    "Error: [S-580]\n"
-    <> "Invalid package name: "
-    <> display t
-  display (PackageVersionParseFail t) =
-    "Error: [S-479]\n"
-    <> "Invalid version: "
-    <> display t
-  display (InvalidCabalFilePath fp) =
-    "Error: [S-824]\n"
-    <> "File path contains a name which is not a valid package name: "
-    <> fromString (toFilePath fp)
-  display (DuplicatePackageNames source pairs') =
-    "Error: [S-674]\n"
-    <> "Duplicate package names ("
-    <> source
-    <> "):\n"
-    <> foldMap
-         ( \(name, locs) ->
-                fromString (packageNameString name)
-             <> ":\n"
-             <> foldMap (\loc -> "- " <> display loc <> "\n") locs
-         )
-         pairs'
-  display (MigrationFailure desc fp err) =
-    "Error: [S-536]\n"
-    <> "Encountered error while migrating database "
-    <> display desc
-    <> "\nlocated at "
-    <> fromString (toFilePath fp)
-    <> ":"
-    <> "\n    "
-    <> displayShow err
-  display (ParseSnapNameException t) =
-    "Error: [S-994]\n"
-     <> "Invalid snapshot name: "
-     <> display t
-  display (HpackLibraryException file err) =
-    "Error: [S-305]\n"
-    <> "Failed to generate a Cabal file using the Hpack library on file:\n"
-    <> fromString (toFilePath file)
-    <> "\n\n"
-    <> "The error encountered was:\n\n"
-    <> fromString err
-  display (HpackExeException fp dir err) =
-    "Error: [S-720]\n"
-    <> "Failed to generate a Cabal file using the Hpack executable:\n"
-    <> fromString fp
-    <> "in directory: "
-    <> fromString (toFilePath dir)
-    <> "\n\n"
-    <> "The error encountered was:\n\n"
-    <> fromString (show err)
-
--- See also the instance of Display. Although prettier, these messages are
--- intended to be substantively the same as the corresponding 'black and white'
--- versions.
-instance Pretty PantryException where
-  pretty NoCasaConfig =
-    "[S-889]"
-    <> line
-    <> flow "The Pantry configuration has no Casa configuration."
-  pretty (InvalidTreeFromCasa blobKey _bs) =
-    "[S-258]"
-    <> line
-    <> fillSep
-         [ flow "Invalid tree from casa:"
-         , fromString . T.unpack $ textDisplay blobKey
-         ]
-  pretty (PackageIdentifierRevisionParseFail text) =
-    "[S-360]"
-    <> line
-    <> fillSep
-         [ flow "Invalid package identifier (with optional revision):"
-         , fromString $ T.unpack text
-         ]
-  pretty (InvalidCabalFile loc mversion errs warnings) =
-    "[S-242]"
-    <> line
-    <> fillSep
-         [ flow "Unable to parse Cabal file from package"
-         , either pretty pretty loc <> ":"
-         ]
-    <> line
-    <> bulletedList
-         ( map (\(PError pos msg) -> fillSep
-             [ fromString (showPos pos) <> ":"
-             , fromString msg
-             ])
-             errs
-         )
-    <> line
-    <> bulletedList
-         ( map (\(PWarning _ pos msg) -> fillSep
-             [ fromString (showPos pos) <> ":"
-             , fromString msg
-             ])
-             warnings
-         )
-    <> ( case mversion of
-           Just version | version > cabalSpecLatestVersion ->
-                line
-             <> fillSep
-                  [ flow "The Cabal file uses the Cabal specification version"
-                  , style Current (fromString $ versionString version) <> ","
-                  , flow "but we only support up to version"
-                  , fromString (versionString cabalSpecLatestVersion) <> "."
-                  , flow "Recommended action: upgrade your build tool"
-                  , parens (fillSep
-                      [ "e.g."
-                      , style Shell (flow "stack upgrade")
-                      ]) <> "."
-                  ]
-           _ -> mempty
-       )
-  pretty (TreeWithoutCabalFile loc) =
-    "[S-654]"
-    <> line
-    <> fillSep
-         [ flow "No Cabal file found for"
-         , pretty loc <> "."
-         ]
-  pretty (TreeWithMultipleCabalFiles loc sfps) =
-    "[S-500]"
-    <> line
-    <> fillSep
-         ( flow "Multiple Cabal files found for"
-         : (pretty loc <> ":")
-         : mkNarrativeList (Just File) False
-             (map (fromString . T.unpack . textDisplay) sfps :: [StyleDoc])
-         )
-  pretty (MismatchedCabalName fp name) =
-    "[S-910]"
-    <> line
-    <> fillSep
-         [ flow "The Cabal file"
-         , pretty fp
-         , flow "is not named after the package that it defines. Please rename"
-         , flow "the file to"
-         , style File (fromString $ packageNameString name <> ".cabal") <> "."
-         , flow "Hackage rejects packages where the first part of the Cabal"
-         , flow "file name is not the package name."
-         ]
-  pretty (NoLocalPackageDirFound dir) =
-    "[S-395]"
-    <> line
-    <> fillSep
-         [ flow "Stack looks for packages in the directories configured in the"
-         , style Shell "packages"
-         , "and"
-         , style Shell "extra-deps"
-         , flow "fields defined in your"
-         , style File "stack.yaml" <> "."
-         , flow "The current entry points to"
-         , pretty dir
-         , flow "but no such directory could be found. If, alternatively, a"
-         , flow "package in the package index was intended, its name and"
-         , flow "version must be specified as an extra-dep."
-         ]
-  pretty (NoCabalFileFound dir) =
-    "[S-636]"
-    <> line
-    <> fillSep
-         [ flow "Stack looks for packages in the directories configured in the"
-         , style Shell "packages"
-         , "and"
-         , style Shell "extra-deps"
-         , flow "fields defined in your"
-         , style File "stack.yaml" <> "."
-         , flow "The current entry points to"
-         , pretty dir
-         , flow "but no Cabal file or"
-         , style File "package.yaml"
-         , flow "could be found there."
-         ]
-  pretty (MultipleCabalFilesFound dir files) =
-    "[S-368]"
-    <> line
-    <> fillSep
-         ( flow "Multiple Cabal files found in directory"
-         : (pretty dir <> ":")
-         : mkNarrativeList (Just File) False
-             (map (pretty . filename) files)
-         )
-  pretty (InvalidWantedCompiler t) =
-    "[S-204]"
-    <> line
-    <> fillSep
-         [ flow "Invalid wanted compiler:"
-         , style Current (fromString $ T.unpack t) <> "."
-         ]
-  pretty (InvalidSnapshotLocation dir t) =
-    "[S-935]"
-    <> line
-    <> fillSep
-         [ flow "Invalid snapshot location"
-         , style Current (fromString $ T.unpack t)
-         , flow "relative to directory"
-         , pretty dir <> "."
-         ]
-  pretty (InvalidOverrideCompiler x y) =
-    "[S-287]"
-    <> line
-    <> fillSep
-         [ flow "Specified compiler for a resolver"
-         , parens (style Shell (fromString . T.unpack $ textDisplay x))
-         , flow "but also specified an override compiler"
-         , parens (style Shell (fromString . T.unpack $ textDisplay y)) <> "."
-         ]
-  pretty (InvalidFilePathSnapshot t) =
-    "[S-617]"
-    <> line
-    <> fillSep
-         [ flow "Specified snapshot as file path with"
-         , style File (fromString $ T.unpack t) <> ","
-         , flow "but not reading from a local file."
-         ]
-  pretty (InvalidSnapshot loc err) =
-    "[S-775]"
-    <> line
-    <> fillSep
-         [ flow "Exception while reading snapshot from"
-         , pretty loc <> ":"
-         ]
-    <> blankLine
-    <> string (displayException err)
-  pretty (MismatchedPackageMetadata loc pm mtreeKey foundIdent) =
-    "[S-427]"
-    <> line
-    <> fillSep
-         [ flow "Mismatched package metadata for"
-         , pretty loc <> "."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , let t = textDisplay pm
-           in  if T.null t
-                 then "nothing."
-                 else fromString $ T.unpack t <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Found:   "
-         , fromString $ packageIdentifierString foundIdent <> case mtreeKey of
-             Nothing -> "."
-             _ -> mempty
-         , case mtreeKey of
-             Nothing -> mempty
-             Just treeKey -> fillSep
-               [ "with tree"
-               , fromString . T.unpack $ textDisplay treeKey <> "."
-               ]
-         ])
-  pretty (Non200ResponseStatus status) =
-    "[S-571]"
-    <> line
-    <> fillSep
-         [ flow "Unexpected non-200 HTTP status code:"
-         , (fromString . show $ statusCode status) <> "."
-         ]
-  pretty (InvalidBlobKey Mismatch{..}) =
-    "[S-236]"
-    <> line
-    <> fillSep
-         [ flow "Invalid blob key found, expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> ","
-         , "actual:"
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ]
-  pretty (Couldn'tParseSnapshot sl err) =
-    "[S-645]"
-    <> line
-    <> fillSep
-         [ flow "Couldn't parse snapshot from"
-         , pretty sl <> ":"
-         ]
-    <> blankLine
-    <> string err
-  pretty (WrongCabalFileName loc sfp name) =
-    "[S-575]"
-    <> line
-    <> fillSep
-         [ flow "Wrong Cabal file name for package"
-         , pretty loc <> "."
-         , flow "The Cabal file is named"
-         , style File (fromString . T.unpack $ textDisplay sfp) <> ","
-         , flow "but package name is"
-         , fromString (packageNameString name) <> "."
-         , flow "For more information, see"
-         , style Url "https://github.com/commercialhaskell/stack/issues/317"
-         , "and"
-         , style Url "https://github.com/commercialhaskell/stack/issues/895" <> "."
-         ]
-  pretty (DownloadInvalidSHA256 url Mismatch {..}) =
-    "[S-394]"
-    <> line
-    <> fillSep
-         [ flow "Mismatched SHA256 hash from"
-         , style Url (fromString $ T.unpack url) <> "."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ])
-  pretty (DownloadInvalidSize url Mismatch {..}) =
-    "[S-401]"
-    <> line
-    <> fillSep
-         [ flow "Mismatched download size from"
-         , style Url (fromString $ T.unpack url) <> "."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ])
-  pretty (DownloadTooLarge url Mismatch {..}) =
-    "[S-113]"
-    <> line
-    <> fillSep
-         [ flow "Download from"
-         , style Url (fromString $ T.unpack url)
-         , flow "was too large. Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> ","
-         , flow "stopped after receiving:"
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ]
-  pretty (LocalInvalidSHA256 path Mismatch {..}) =
-    "[S-834]"
-    <> line
-    <> fillSep
-         [ flow "Mismatched SHA256 hash from"
-         , pretty path <> "."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ])
-  pretty (LocalInvalidSize path Mismatch {..}) =
-    "[S-713]"
-    <> line
-    <> fillSep
-         [ flow "Mismatched file size from"
-         , pretty path <> "."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ])
-  pretty (UnknownArchiveType loc) =
-    "[S-372]"
-    <> line
-    <> fillSep
-         [ flow "Unable to determine archive type of:"
-         , pretty loc <> "."
-         ]
-  pretty (InvalidTarFileType loc fp x) =
-    "[S-950]"
-    <> line
-    <> fillSep
-         [ flow "Unsupported tar file type in archive"
-         , pretty loc
-         , flow "at file"
-         , style File (fromString fp) <> ":"
-         , fromString $ show x <> "."
-         ]
-  pretty (UnsupportedTarball loc err) =
-    "[S-760]"
-    <> line
-    <> fillSep
-         [ flow "Unsupported tarball from"
-         , pretty loc <> ":"
-         ]
-    <> blankLine
-    <> string (T.unpack err)
-  pretty (NoHackageCryptographicHash ident) =
-    "[S-922]"
-    <> line
-    <> fillSep
-         [ flow "No cryptographic hash found for Hackage package"
-         , fromString (packageIdentifierString ident) <> "."
-         ]
-  pretty (FailedToCloneRepo repo) =
-    "[S-109]"
-    <> line
-    <> fillSep
-         [ flow "Failed to clone repository"
-         , fromString . T.unpack $ textDisplay repo
-         ]
-  pretty (TreeReferencesMissingBlob loc sfp key) =
-    "[S-237]"
-    <> line
-    <> fillSep
-         [ flow "The package"
-         , pretty loc
-         , flow "needs blob"
-         , fromString . T.unpack $ textDisplay key
-         , flow "for file path"
-         , style File (fromString . T.unpack $ textDisplay sfp) <> ","
-         , flow "but the blob is not available."
-         ]
-  pretty (CompletePackageMetadataMismatch loc pm) =
-    "[S-984]"
-    <> line
-    <> fillSep
-         [ flow "When completing package metadata for"
-         , pretty loc <> ","
-         , flow "some values changed in the new package metadata:"
-         , fromString . T.unpack $ textDisplay pm <> "."
-         ]
-  pretty (CRC32Mismatch loc fp Mismatch {..}) =
-    "[S-607]"
-    <> line
-    <> fillSep
-         [ flow "CRC32 mismatch in Zip file from"
-         , pretty loc
-         , flow "on internal file"
-         , style File (fromString fp)
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString . T.unpack $ textDisplay mismatchExpected <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString . T.unpack $ textDisplay mismatchActual <> "."
-         ])
-  pretty (UnknownHackagePackage pir fuzzy) =
-    "[S-476]"
-    <> line
-    <> fillSep
-         [ flow "Could not find"
-         , style Error (fromString . T.unpack $ textDisplay pir)
-         , flow "on Hackage."
-         ]
-    <> prettyFuzzy fuzzy
-  pretty (CannotCompleteRepoNonSHA1 repo) =
-    "[S-112]"
-    <> line
-    <> fillSep
-         [ flow "Cannot complete repo information for a non SHA1 commit due to"
-         , "non-reproducibility:"
-         , fromString . T.unpack $ textDisplay repo <> "."
-         ]
-  pretty (MutablePackageLocationFromUrl t) =
-    "[S-321]"
-    <> line
-    <> fillSep
-         [ flow "Cannot refer to a mutable package location from a URL:"
-         , style Url (fromString $ T.unpack t) <> "."
-         ]
-  pretty (MismatchedCabalFileForHackage pir Mismatch{..}) =
-    "[S-377]"
-    <> line
-    <> fillSep
-         [ flow "When processing Cabal file for Hackage package"
-         , fromString . T.unpack $ textDisplay pir <> ","
-         , flow "mismatched package identifier."
-         ]
-    <> blankLine
-    <> hang 10 (fillSep
-         [ "Expected:"
-         , fromString (packageIdentifierString mismatchExpected) <> "."
-         ])
-    <> line
-    <> hang 10 (fillSep
-         [ "Actual:  "
-         , fromString (packageIdentifierString mismatchActual) <> "."
-         ])
-  pretty (PackageNameParseFail t) =
-    "[S-580]"
-    <> line
-    <> fillSep
-         [ flow "Invalid package name:"
-         , fromString $ T.unpack t <> "."
-         ]
-  pretty (PackageVersionParseFail t) =
-    "[S-479]"
-    <> line
-    <> fillSep
-         [ flow "Invalid version:"
-         , fromString $ T.unpack t <> "."
-         ]
-  pretty (InvalidCabalFilePath fp) =
-    "[S-824]"
-    <> line
-    <> fillSep
-         [ flow "File path contains a name which is not a valid package name:"
-         , pretty fp <> "."
-         ]
-  pretty (DuplicatePackageNames source pairs') =
-    "[S-674]"
-    <> line
-    <> fillSep
-         [ flow "Duplicate package names"
-         , parens (fromString . T.unpack $ textDisplay source) <> ":"
-         ]
-    <> line
-    <> foldMap
-         ( \(name, locs) ->
-                fromString (packageNameString name) <> ":"
-             <> line
-             <> bulletedList (map pretty locs)
-             <> line
-         )
-         pairs'
-  pretty (MigrationFailure desc fp err) =
-    "[S-536]"
-    <> line
-    <> fillSep
-         [ flow "Encountered error while migrating database"
-         , fromString $ T.unpack desc
-         , flow "located at"
-         , pretty fp <> ":"
-         ]
-    <> blankLine
-    <> string (displayException err)
-  pretty (ParseSnapNameException t) =
-    "[S-994]"
-    <> line
-    <> fillSep
-         [ flow "Invalid snapshot name:"
-         , fromString $ T.unpack t <> "."
-         ]
-  pretty (HpackLibraryException file err) =
-    "[S-305]"
-    <> line
-    <> fillSep
-         [ flow "Failed to generate a Cabal file using the Hpack library on"
-         , "file:"
-         , pretty file <> "."
-         , flow "The error encountered was:"
-         ]
-    <> blankLine
-    <> string err
-  pretty (HpackExeException fp dir err) =
-    "[S-720]"
-    <> line
-    <> fillSep
-         [ flow "Failed to generate a Cabal file using the Hpack executable:"
-         , style File (fromString fp)
-         , flow "in directory:"
-         , pretty dir <> "."
-         , flow "The error encountered was:"
-         ]
-    <> blankLine
-    <> string (displayException err)
-
-blankLine :: StyleDoc
-blankLine = line <> line
-
-data FuzzyResults
-  = FRNameNotFound ![PackageName]
-  | FRVersionNotFound !(NonEmpty PackageIdentifierRevision)
-  | FRRevisionNotFound !(NonEmpty PackageIdentifierRevision)
-
-displayFuzzy :: FuzzyResults -> Utf8Builder
-displayFuzzy (FRNameNotFound names) =
-  case NE.nonEmpty names of
-    Nothing -> ""
-    Just names' ->
-      "\nPerhaps you meant " <>
-      orSeparated (NE.map (fromString . packageNameString) names') <>
-      "?"
-displayFuzzy (FRVersionNotFound pirs) =
-  "\nPossible candidates: " <>
-  commaSeparated (NE.map display pirs) <>
-  "."
-displayFuzzy (FRRevisionNotFound pirs) =
-  "\nThe specified revision was not found.\nPossible candidates: " <>
-  commaSeparated (NE.map display pirs) <>
-  "."
-
-prettyFuzzy :: FuzzyResults -> StyleDoc
-prettyFuzzy (FRNameNotFound names) =
-  case NE.nonEmpty names of
-    Nothing -> mempty
-    Just names' ->
-         line
-      <> fillSep
-           ( flow "Perhaps you meant one of"
-           : mkNarrativeList Nothing False
-               (NE.toList $ NE.map (fromString . packageNameString) names' :: [StyleDoc])
-           )
-prettyFuzzy (FRVersionNotFound pirs) =
-     line
-  <> fillSep
-       ( flow "Possible candidates:"
-       : mkNarrativeList Nothing False
-           (NE.toList $ NE.map (fromString . T.unpack . textDisplay) pirs :: [StyleDoc])
-       )
-prettyFuzzy (FRRevisionNotFound pirs) =
-     line
-  <> fillSep
-       ( flow "The specified revision was not found. Possible candidates:"
-       : mkNarrativeList Nothing False
-           (NE.toList $ NE.map (fromString . T.unpack . textDisplay) pirs :: [StyleDoc])
-       )
-
-orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
-orSeparated xs
-  | NE.length xs == 1 = NE.head xs
-  | NE.length xs == 2 = NE.head xs <> " or " <> NE.last xs
-  | otherwise = fold (intersperse ", " (NE.init xs)) <> ", or " <> NE.last xs
-
-commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
-commaSeparated = fold . NE.intersperse ", "
-
-cabalSpecLatestVersion :: Version
-cabalSpecLatestVersion = mkVersion $ cabalSpecToVersionDigits cabalSpecLatest
-
-#if !MIN_VERSION_Cabal(3,4,0)
-cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
-cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]
-cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]
-cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]
-cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]
-cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]
-cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]
-cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]
-cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]
-cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]
-cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]
-cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]
-cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]
-cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]
-cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]
-cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]
-#endif
-
-data BuildFile
-  = BFCabal !SafeFilePath !TreeEntry
-  | BFHpack !TreeEntry
-    -- We don't need SafeFilePath for Hpack since it has to be package.yaml file
-  deriving (Show, Eq)
-
-data FileType = FTNormal | FTExecutable
-  deriving (Show, Eq, Enum, Bounded, Ord)
-
-instance PersistField FileType where
-  toPersistValue FTNormal = PersistInt64 1
-  toPersistValue FTExecutable = PersistInt64 2
-
-  fromPersistValue v = do
-    i <- fromPersistValue v
-    case i :: Int64 of
-      1 -> Right FTNormal
-      2 -> Right FTExecutable
-      _ -> Left $ "Invalid FileType: " <> tshow i
-
-instance PersistFieldSql FileType where
-  sqlType _ = SqlInt32
-
-data TreeEntry = TreeEntry
-  { teBlob :: !BlobKey
-  , teType :: !FileType
-  }
-  deriving (Show, Eq, Ord)
-
-newtype SafeFilePath = SafeFilePath Text
-  deriving (Show, Eq, Ord, Display)
-
-instance PersistField SafeFilePath where
-  toPersistValue = toPersistValue . unSafeFilePath
-  fromPersistValue v = do
-    t <- fromPersistValue v
-    maybe (Left $ "Invalid SafeFilePath: " <> t) Right $ mkSafeFilePath t
-
-instance PersistFieldSql SafeFilePath where
-  sqlType _ = SqlString
-
-unSafeFilePath :: SafeFilePath -> Text
-unSafeFilePath (SafeFilePath t) = t
-
-safeFilePathToPath :: (MonadThrow m) => Path Abs Dir -> SafeFilePath -> m (Path Abs File)
-safeFilePathToPath dir (SafeFilePath path) = do
-  fpath <- parseRelFile (T.unpack path)
-  pure $ dir </> fpath
-
-mkSafeFilePath :: Text -> Maybe SafeFilePath
-mkSafeFilePath t = do
-  guard $ not $ "\\" `T.isInfixOf` t
-  guard $ not $ "//" `T.isInfixOf` t
-  guard $ not $ "\n" `T.isInfixOf` t
-  guard $ not $ "\0" `T.isInfixOf` t
-
-  (c, _) <- T.uncons t
-  guard $ c /= '/'
-
-  guard $ (not . any (T.all (== '.'))) $ T.split (== '/') t
-
-  Just $ SafeFilePath t
-
--- | SafeFilePath for `package.yaml` file.
-hpackSafeFilePath :: SafeFilePath
-hpackSafeFilePath =
-    let fpath = mkSafeFilePath (T.pack Hpack.packageConfig)
-    in case fpath of
-         Nothing -> error $
-           "hpackSafeFilePath: Not able to encode " <> Hpack.packageConfig
-         Just sfp -> sfp
-
--- | The hash of the binary representation of a 'Tree'.
---
--- @since 0.1.0.0
-newtype TreeKey = TreeKey BlobKey
-  deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON, NFData, Display)
-
--- | Represents the contents of a tree, which is a mapping from
--- relative file paths to 'TreeEntry's.
---
--- @since 0.1.0.0
-newtype Tree
-  = TreeMap (Map SafeFilePath TreeEntry)
-  -- In the future, consider allowing more lax parsing
-  -- See: https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys
-  -- TreeTarball !PackageTarball
-  deriving (Show, Eq, Ord)
-
-renderTree :: Tree -> ByteString
-renderTree = BL.toStrict . toLazyByteString . go
- where
-  go :: Tree -> Builder
-  go (TreeMap m) = "map:" <> Map.foldMapWithKey goEntry m
-
-  goEntry sfp (TreeEntry (BlobKey sha (FileSize size')) ft) =
-    netstring (unSafeFilePath sfp) <>
-    byteString (SHA256.toRaw sha) <>
-    netword size' <>
-    (case ft of
-      FTNormal -> "N"
-      FTExecutable -> "X")
-
-netstring :: Text -> Builder
-netstring t =
-  let bs = encodeUtf8 t
-  in  netword (fromIntegral (B.length bs)) <> byteString bs
-
-netword :: Word -> Builder
-netword w = wordDec w <> ":"
-
-parseTreeM :: MonadThrow m => (BlobKey, ByteString) -> m (TreeKey, Tree)
-parseTreeM (blobKey, blob) =
-  case parseTree blob of
-    Nothing -> throwM (InvalidTreeFromCasa blobKey blob)
-    Just tree -> pure (TreeKey blobKey, tree)
-
-parseTree :: ByteString -> Maybe Tree
-parseTree bs1 = do
-  tree <- parseTree' bs1
-  let bs2 = renderTree tree
-  guard $ bs1 == bs2
-  Just tree
-
-parseTree' :: ByteString -> Maybe Tree
-parseTree' bs0 = do
-  entriesBS <- B.stripPrefix "map:" bs0
-  TreeMap <$> loop Map.empty entriesBS
- where
-  loop !m bs1
-    | B.null bs1 = pure m
-    | otherwise = do
-        (sfpBS, bs2) <- takeNetstring bs1
-        sfp <-
-          case decodeUtf8' sfpBS of
-            Left _ -> Nothing
-            Right sfpT -> mkSafeFilePath sfpT
-        (sha, bs3) <- takeSha bs2
-        (size', bs4) <- takeNetword bs3
-        (typeW, bs5) <- B.uncons bs4
-        ft <-
-          case typeW of
-            78 -> Just FTNormal -- 'N'
-            88 -> Just FTExecutable -- 'X'
-            _ -> Nothing
-        let entry = TreeEntry (BlobKey sha (FileSize (fromIntegral size'))) ft
-        loop (Map.insert sfp entry m) bs5
-
-  takeNetstring bs1 = do
-    (size', bs2) <- takeNetword bs1
-    guard $ B.length bs2 >= size'
-    Just $ B.splitAt size' bs2
-
-  takeSha bs = do
-    let (x, y) = B.splitAt 32 bs
-    x' <- either (const Nothing) Just (SHA256.fromRaw x)
-    Just (x', y)
-
-  takeNetword =
-    go 0
-   where
-    go !accum bs = do
-      (next, rest) <- B.uncons bs
-      if
-        | next == 58 -> pure (accum, rest) -- ':'
-        | next >= 48 && next <= 57 ->
-            go
-              (accum * 10 + fromIntegral (next - 48))
-              rest
-        | otherwise -> Nothing
-
-    {-
-data PackageTarball = PackageTarball
-  { ptBlob :: !BlobKey
-  -- ^ Contains the tarball itself
-  , ptCabal :: !BlobKey
-  -- ^ Contains the cabal file contents
-  , ptSubdir :: !FilePath
-  -- ^ Subdir containing the files we want for this package.
-  --
-  -- There must be precisely one file with a @.cabal@ file extension
-  -- located there. Thanks to Hackage revisions, its contents will be
-  -- overwritten by the value of @ptCabal@.
-  }
-  deriving Show
-    -}
-
--- | This is almost a copy of Cabal's parser for package identifiers,
--- the main difference is in the fact that Stack requires version to be
--- present while Cabal uses "null version" as a default value
---
--- @since 0.1.0.0
-parsePackageIdentifier :: String -> Maybe PackageIdentifier
-parsePackageIdentifier = either (const Nothing) Just . explicitEitherParsec (packageIdentifierParsec <* Parse.eof)
-
-packageIdentifierParsec :: ParsecParser PackageIdentifier
-packageIdentifierParsec = do
-  ident@(PackageIdentifier _ v) <- parsec
-
-  -- version is a required component of a package identifier for Stack
-  guard (v /= nullVersion)
-
-  pure ident
-
--- | Parse a package name from a 'String'.
---
--- @since 0.1.0.0
-parsePackageName :: String -> Maybe PackageName
-parsePackageName = Distribution.Text.simpleParse
-
--- | Parse a package name from a 'String' throwing on failure
---
--- @since 0.1.0.0
-parsePackageNameThrowing :: MonadThrow m => String -> m PackageName
-parsePackageNameThrowing str =
-  case parsePackageName str of
-    Nothing -> throwM $ PackageNameParseFail $ T.pack str
-    Just pn -> pure pn
-
--- | Parse a version from a 'String'.
---
--- @since 0.1.0.0
-parseVersion :: String -> Maybe Version
-parseVersion = Distribution.Text.simpleParse
-
--- | Parse a package version from a 'String' throwing on failure
---
--- @since 0.1.0.0
-parseVersionThrowing :: MonadThrow m => String -> m Version
-parseVersionThrowing str =
-  case parseVersion str of
-    Nothing -> throwM $ PackageVersionParseFail $ T.pack str
-    Just v -> pure v
-
--- | Parse a version range from a 'String'.
---
--- @since 0.1.0.0
-parseVersionRange :: String -> Maybe VersionRange
-parseVersionRange = Distribution.Text.simpleParse
-
--- | Parse a module name from a 'String'.
---
--- @since 0.1.0.0
-parseModuleName :: String -> Maybe ModuleName
-parseModuleName = Distribution.Text.simpleParse
-
--- | Parse a flag name from a 'String'.
---
--- @since 0.1.0.0
-parseFlagName :: String -> Maybe FlagName
-parseFlagName = Distribution.Text.simpleParse
-
--- | Render a package name as a 'String'.
---
--- @since 0.1.0.0
-packageNameString :: PackageName -> String
-packageNameString = unPackageName
-
--- | Render a package identifier as a 'String'.
---
--- @since 0.1.0.0
-packageIdentifierString :: PackageIdentifier -> String
-packageIdentifierString = Distribution.Text.display
-
--- | Render a version as a 'String'.
---
--- @since 0.1.0.0
-versionString :: Version -> String
-versionString = Distribution.Text.display
-
--- | Render a flag name as a 'String'.
---
--- @since 0.1.0.0
-flagNameString :: FlagName -> String
-flagNameString = unFlagName
-
--- | Render a module name as a 'String'.
---
--- @since 0.1.0.0
-moduleNameString :: ModuleName -> String
-moduleNameString = Distribution.Text.display
-
-data OptionalSubdirs
-  = OSSubdirs !(NonEmpty Text)
-  | OSPackageMetadata !Text !RawPackageMetadata
-  -- ^ subdirectory and package metadata
-  deriving (Show, Eq, Generic)
-
-instance NFData OptionalSubdirs
-
--- | Metadata provided by a config file for archives and repos. This information
--- can be used for optimized lookups of information like package identifiers, or
--- for validating that the user configuration has the expected information.
---
--- @since 0.1.0.0
-data RawPackageMetadata = RawPackageMetadata
-  { rpmName :: !(Maybe PackageName)
-    -- ^ Package name in the cabal file
-    --
-    -- @since 0.1.0.0
-  , rpmVersion :: !(Maybe Version)
-    -- ^ Package version in the cabal file
-    --
-    -- @since 0.1.0.0
-  , rpmTreeKey :: !(Maybe TreeKey)
-    -- ^ Tree key of the loaded up package
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Show, Eq, Ord, Generic, Typeable)
-
-instance NFData RawPackageMetadata
-
-instance Display RawPackageMetadata where
-  display rpm = fold $ intersperse ", " $ catMaybes
-    [ (\name -> "name == " <> fromString (packageNameString name)) <$> rpmName rpm
-    , (\version -> "version == " <> fromString (versionString version)) <$> rpmVersion rpm
-    , (\tree -> "tree == " <> display tree) <$> rpmTreeKey rpm
-    ]
-
--- | Exact metadata specifying concrete package
---
--- @since 0.1.0.0
-data PackageMetadata = PackageMetadata
-  { pmIdent :: !PackageIdentifier
-    -- ^ Package identifier in the cabal file
-    --
-    -- @since 0.1.0.0
-  , pmTreeKey :: !TreeKey
-    -- ^ Tree key of the loaded up package
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Show, Eq, Ord, Generic, Typeable)
-
--- i PackageMetadata
-instance NFData PackageMetadata
-
-instance Display PackageMetadata where
-  display pm = fold $ intersperse ", "
-    [ "ident == " <> fromString (packageIdentifierString $ pmIdent pm)
-    , "tree == " <> display (pmTreeKey pm)
-    ]
-
-parsePackageMetadata :: Object -> WarningParser PackageMetadata
-parsePackageMetadata o = do
-  _oldCabalFile :: Maybe BlobKey <- o ..:? "cabal-file"
-  pantryTree :: BlobKey <- o ..: "pantry-tree"
-  CabalString pkgName <- o ..: "name"
-  CabalString pkgVersion <- o ..: "version"
-  let pmTreeKey = TreeKey pantryTree
-      pmIdent = PackageIdentifier {..}
-  pure PackageMetadata {..}
-
-
--- | Convert package metadata to its "raw" equivalent.
---
--- @since 0.1.0.0
-toRawPM :: PackageMetadata -> RawPackageMetadata
-toRawPM pm = RawPackageMetadata (Just name) (Just version) (Just $ pmTreeKey pm)
- where
-  PackageIdentifier name version = pmIdent pm
-
--- | File path relative to the configuration file it was parsed from
---
--- @since 0.1.0.0
-newtype RelFilePath = RelFilePath Text
-  deriving (Show, ToJSON, FromJSON, Eq, Ord, Generic, Typeable, NFData, Display)
-
--- | Location that an archive is stored at
---
--- @since 0.1.0.0
-data ArchiveLocation
-  = ALUrl !Text
-    -- ^ Archive stored at an HTTP(S) URL
-    --
-    -- @since 0.1.0.0
-  | ALFilePath !(ResolvedPath File)
-    -- ^ Archive stored at a local file path
-    --
-    -- @since 0.1.0.0
-  deriving (Show, Eq, Ord, Generic, Typeable)
-
-instance NFData ArchiveLocation
-
-instance Display ArchiveLocation where
-  display (ALUrl url) = display url
-  display (ALFilePath resolved) =
-    fromString $ toFilePath $ resolvedAbsolute resolved
-
-instance Pretty ArchiveLocation where
-  pretty (ALUrl url) = style Url (fromString $ T.unpack url)
-  pretty (ALFilePath resolved) = pretty $ resolvedAbsolute resolved
-
-parseArchiveLocationObject ::
-     Object
-  -> WarningParser (Unresolved ArchiveLocation)
-parseArchiveLocationObject o =
-      ((o ..: "url") >>= either (fail . T.unpack) pure . validateUrl)
-  <|> ((o ..: "filepath") >>= either (fail . T.unpack) pure . validateFilePath)
-  <|> ((o ..: "archive") >>= either (fail . T.unpack) pure . parseArchiveLocationText)
-  <|> ((o ..: "location") >>= either (fail . T.unpack) pure . parseArchiveLocationText)
-
-parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
-parseArchiveLocationText t =
-  case validateUrl t of
-    Left e1 ->
-      case validateFilePath t of
-        Left e2 -> Left $ T.unlines
-          [ "Invalid archive location, neither a URL nor a file path"
-          , "  URL error: " <> e1
-          , "  File path error: " <> e2
-          ]
-        Right x -> Right x
-    Right x -> Right x
-
-validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
-validateUrl t =
-  case parseRequest $ T.unpack t of
-    Left _ -> Left $ "Could not parse URL: " <> t
-    Right _ -> pure $ pure $ ALUrl t
-
-validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
-validateFilePath t =
-  if any (`T.isSuffixOf` t) (T.words ".zip .tar .tar.gz")
-    then pure $ Unresolved $ \case
-      Nothing -> throwIO $ InvalidFilePathSnapshot t
-      Just dir -> do
-        abs' <- resolveFile dir $ T.unpack t
-        pure $ ALFilePath $ ResolvedPath (RelFilePath t) abs'
-    else Left $ "Does not have an archive file extension: " <> t
-
-instance ToJSON RawPackageLocation where
-  toJSON (RPLImmutable rpli) = toJSON rpli
-  toJSON (RPLMutable resolved) = toJSON (resolvedRelative resolved)
-
-instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))) where
-  parseJSON v =
-    (fmap . fmap . fmap . fmap) RPLImmutable (parseJSON v) <|>
-    (noJSONWarnings . mkMutable <$> parseJSON v)
-   where
-    mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
-    mkMutable t = Unresolved $ \mdir -> do
-      case mdir of
-        Nothing -> throwIO $ MutablePackageLocationFromUrl t
-        Just dir -> do
-          abs' <- resolveDir dir $ T.unpack t
-          pure $ pure $ RPLMutable $ ResolvedPath (RelFilePath t) abs'
-
-instance ToJSON RawPackageLocationImmutable where
-  toJSON (RPLIHackage pir mtree) = object $
-    ("hackage" .= pir) : maybe [] (\tree -> ["pantry-tree" .= tree]) mtree
-  toJSON (RPLIArchive (RawArchive loc msha msize subdir) rpm) = object $ concat
-    [ case loc of
-        ALUrl url -> ["url" .= url]
-        ALFilePath resolved -> ["filepath" .= resolvedRelative resolved]
-    , maybe [] (\sha -> ["sha256" .= sha]) msha
-    , maybe [] (\size' -> ["size" .= size']) msize
-    , [ "subdir" .= subdir | not (T.null subdir) ]
-    , rpmToPairs rpm
-    ]
-  toJSON (RPLIRepo (Repo url commit typ subdir) rpm) = object $ concat
-    [ [ urlKey .= url
-      , "commit" .= commit
-      ]
-    , ["subdir" .= subdir | not (T.null subdir) ]
-    , rpmToPairs rpm
-    ]
-   where
-    urlKey =
-      case typ of
-        RepoGit -> "git"
-        RepoHg  -> "hg"
-
-rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
-rpmToPairs (RawPackageMetadata mname mversion mtree) = concat
-  [ maybe [] (\name -> ["name" .= CabalString name]) mname
-  , maybe [] (\version -> ["version" .= CabalString version]) mversion
-  , maybe [] (\tree -> ["pantry-tree" .= tree]) mtree
-  ]
-
-instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where
-  parseJSON v =
-        repoObject v
-    <|> archiveObject v
-    <|> hackageObject v
-    <|> github v
-    <|> fail ("Could not parse a UnresolvedPackageLocationImmutable from: " ++ show v)
-   where
-    repoObject ::
-         Value
-      -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-    repoObject =
-      withObjectWarnings "UnresolvedPackageLocationImmutable.PLIRepo" $ \o -> do
-        pm <- parsePackageMetadata o
-        repoSubdir <- o ..:? "subdir" ..!= ""
-        repoCommit <- o ..: "commit"
-        (repoType, repoUrl) <-
-            (o ..: "git" >>= \url -> pure (RepoGit, url)) <|>
-            (o ..: "hg" >>= \url -> pure (RepoHg, url))
-        pure $ pure $ PLIRepo Repo {..} pm
-
-    archiveObject =
-      withObjectWarnings "UnresolvedPackageLocationImmutable.PLIArchive" $ \o -> do
-        pm <- parsePackageMetadata o
-        Unresolved mkArchiveLocation <- parseArchiveLocationObject o
-        archiveHash <- o ..: "sha256"
-        archiveSize <- o ..: "size"
-        archiveSubdir <- o ..:? "subdir" ..!= ""
-        pure $ Unresolved $ \mdir -> do
-          archiveLocation <- mkArchiveLocation mdir
-          pure $ PLIArchive Archive {..} pm
-
-    hackageObject =
-      withObjectWarnings "UnresolvedPackagelocationimmutable.PLIHackage (Object)" $ \o -> do
-        treeKey <- o ..: "pantry-tree"
-        htxt <- o ..: "hackage"
-        case parseHackageText htxt of
-          Left e -> fail $ show e
-          Right (pkgIdentifier, blobKey) ->
-            pure $ pure $ PLIHackage pkgIdentifier blobKey (TreeKey treeKey)
-
-    github =
-      withObjectWarnings "UnresolvedPackagelocationimmutable.PLIArchive:github" (\o -> do
-        pm <- parsePackageMetadata o
-        GitHubRepo ghRepo <- o ..: "github"
-        commit <- o ..: "commit"
-        let archiveLocation = ALUrl $ T.concat
-              [ "https://github.com/"
-              , ghRepo
-              , "/archive/"
-              , commit
-              , ".tar.gz"
-              ]
-        archiveHash <- o ..: "sha256"
-        archiveSize <- o ..: "size"
-        archiveSubdir <- o ..:? "subdir" ..!= ""
-        pure $ pure $ PLIArchive Archive {..} pm)
-
-instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable))) where
-  parseJSON v =
-        http v
-    <|> hackageText v
-    <|> hackageObject v
-    <|> repo v
-    <|> archiveObject v
-    <|> github v
-    <|> fail ("Could not parse a UnresolvedRawPackageLocationImmutable from: " ++ show v)
-   where
-    http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
-    http = withText "UnresolvedPackageLocationImmutable.RPLIArchive (Text)" $ \t ->
-      case parseArchiveLocationText t of
-        Left _ -> fail $ "Invalid archive location: " ++ T.unpack t
-        Right (Unresolved mkArchiveLocation) ->
-          pure $ noJSONWarnings $ Unresolved $ \mdir -> do
-            raLocation <- mkArchiveLocation mdir
-            let raHash = Nothing
-                raSize = Nothing
-                raSubdir = T.empty
-            pure $ pure $ RPLIArchive RawArchive {..} rpmEmpty
-
-    hackageText = withText "UnresolvedPackageLocationImmutable.UPLIHackage (Text)" $ \t ->
-      case parsePackageIdentifierRevision t of
-        Left e -> fail $ show e
-        Right pir -> pure $ noJSONWarnings $ pure $ pure $ RPLIHackage pir Nothing
-
-    hackageObject = withObjectWarnings "UnresolvedPackageLocationImmutable.UPLIHackage" $ \o -> pure . pure <$> (RPLIHackage
-      <$> o ..: "hackage"
-      <*> o ..:? "pantry-tree")
-
-    optionalSubdirs :: Object -> WarningParser OptionalSubdirs
-    optionalSubdirs o =
-      -- if subdirs exists, it needs to be valid
-      case HM.lookup "subdirs" o of
-        Just v' -> do
-          tellJSONField "subdirs"
-          subdirs <- lift $ parseJSON v'
-          case NE.nonEmpty subdirs of
-            Nothing -> fail "Invalid empty subdirs"
-            Just x -> pure $ OSSubdirs x
-        Nothing -> OSPackageMetadata
-          <$> o ..:? "subdir" ..!= T.empty
-          <*> (   rawPackageMetadataHelper
-              <$> (fmap unCabalString <$> (o ..:? "name"))
-              <*> (fmap unCabalString <$> (o ..:? "version"))
-              <*> o ..:? "pantry-tree"
-              <*> o ..:? "cabal-file"
-              )
-
-    rawPackageMetadataHelper ::
-         Maybe PackageName
-      -> Maybe Version
-      -> Maybe TreeKey
-      -> Maybe BlobKey
-      -> RawPackageMetadata
-    rawPackageMetadataHelper name version pantryTree _ignoredCabalFile =
-      RawPackageMetadata name version pantryTree
-
-    repo = withObjectWarnings "UnresolvedPackageLocationImmutable.UPLIRepo" $ \o -> do
-      (repoType, repoUrl) <-
-        ((RepoGit, ) <$> o ..: "git") <|>
-        ((RepoHg, ) <$> o ..: "hg")
-      repoCommit <- o ..: "commit"
-      os <- optionalSubdirs o
-      pure $ pure $ NE.map (\(repoSubdir, pm) -> RPLIRepo Repo {..} pm) (osToRpms os)
-
-    archiveObject = withObjectWarnings "UnresolvedPackageLocationImmutable.RPLIArchive" $ \o -> do
-      Unresolved mkArchiveLocation <- parseArchiveLocationObject o
-      raHash <- o ..:? "sha256"
-      raSize <- o ..:? "size"
-      os <- optionalSubdirs o
-      pure $ Unresolved $ \mdir -> do
-        raLocation <- mkArchiveLocation mdir
-        pure $ NE.map (\(raSubdir, pm) -> RPLIArchive RawArchive {..} pm) (osToRpms os)
-
-    github = withObjectWarnings "PLArchive:github" $ \o -> do
-      GitHubRepo ghRepo <- o ..: "github"
-      commit <- o ..: "commit"
-      let raLocation = ALUrl $ T.concat
-            [ "https://github.com/"
-            , ghRepo
-            , "/archive/"
-            , commit
-            , ".tar.gz"
-            ]
-      raHash <- o ..:? "sha256"
-      raSize <- o ..:? "size"
-      os <- optionalSubdirs o
-      pure $ pure $
-        NE.map (\(raSubdir, pm) -> RPLIArchive RawArchive {..} pm) (osToRpms os)
-
--- | Returns pairs of subdirectory and 'PackageMetadata'.
-osToRpms :: OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
-osToRpms (OSSubdirs subdirs) = NE.map (, rpmEmpty) subdirs
-osToRpms (OSPackageMetadata subdir rpm) = pure (subdir, rpm)
-
-rpmEmpty :: RawPackageMetadata
-rpmEmpty = RawPackageMetadata Nothing Nothing Nothing
-
--- | Newtype wrapper for easier JSON integration with Cabal types.
---
--- @since 0.1.0.0
-newtype CabalString a = CabalString { unCabalString :: a }
-  deriving (Show, Eq, Ord, Typeable)
-
--- I'd like to use coerce here, but can't due to roles. unsafeCoerce
--- could work, but let's avoid unsafe code.
-
--- | Wrap the keys in a 'Map' with a 'CabalString' to get a 'ToJSON'
--- instance.
---
--- @since 0.1.0.0
-toCabalStringMap :: Map a v -> Map (CabalString a) v
-toCabalStringMap = Map.mapKeysMonotonic CabalString
-
--- | Unwrap the 'CabalString' from the keys in a 'Map' to use a
--- 'FromJSON' instance.
---
--- @since 0.1.0.0
-unCabalStringMap :: Map (CabalString a) v -> Map a v
-unCabalStringMap = Map.mapKeysMonotonic unCabalString
-
-instance Distribution.Pretty.Pretty a => ToJSON (CabalString a) where
-  toJSON = toJSON . Distribution.Text.display . unCabalString
-
-instance Distribution.Pretty.Pretty a => ToJSONKey (CabalString a) where
-  toJSONKey = toJSONKeyText $ T.pack . Distribution.Text.display . unCabalString
-
-instance forall a. IsCabalString a => FromJSON (CabalString a) where
-  parseJSON = withText name $ \t ->
-    case cabalStringParser $ T.unpack t of
-      Nothing -> fail $ "Invalid " ++ name ++ ": " ++ T.unpack t
-      Just x -> pure $ CabalString x
-   where
-    name = cabalStringName (Nothing :: Maybe a)
-
-instance forall a. IsCabalString a => FromJSONKey (CabalString a) where
-  fromJSONKey =
-    FromJSONKeyTextParser $ \t ->
-    case cabalStringParser $ T.unpack t of
-      Nothing -> fail $ "Invalid " ++ name ++ ": " ++ T.unpack t
-      Just x -> pure $ CabalString x
-   where
-    name = cabalStringName (Nothing :: Maybe a)
-
-class IsCabalString a where
-  cabalStringName :: proxy a -> String
-  cabalStringParser :: String -> Maybe a
-
-instance IsCabalString PackageName where
-  cabalStringName _ = "package name"
-  cabalStringParser = parsePackageName
-
-instance IsCabalString Version where
-  cabalStringName _ = "version"
-  cabalStringParser = parseVersion
-
-instance IsCabalString VersionRange where
-  cabalStringName _ = "version range"
-  cabalStringParser = parseVersionRange
-
-instance IsCabalString PackageIdentifier where
-  cabalStringName _ = "package identifier"
-  cabalStringParser = parsePackageIdentifier
-
-instance IsCabalString FlagName where
-  cabalStringName _ = "flag name"
-  cabalStringParser = parseFlagName
-
--- | What to use for running hpack
---
--- @since 0.1.0.0
-data HpackExecutable
-  = HpackBundled
-    -- ^ Compiled in library
-  | HpackCommand !FilePath
-    -- ^ Executable at the provided path
-  deriving (Show, Read, Eq, Ord)
-
-
--- | Which compiler a snapshot wants to use. The build tool may elect to do some
--- fuzzy matching of versions (e.g., allowing different patch versions).
---
--- @since 0.1.0.0
-data WantedCompiler
-  = WCGhc !Version
-  | WCGhcGit !Text !Text
-  | WCGhcjs
-      !Version
-      !Version
-    -- ^ GHCJS version followed by GHC version
-  deriving (Show, Eq, Ord, Generic)
-
-instance NFData WantedCompiler
-
-instance Display WantedCompiler where
-  display (WCGhc vghc) = "ghc-" <> fromString (versionString vghc)
-  display (WCGhcjs vghcjs vghc) =
-       "ghcjs-"
-    <> fromString (versionString vghcjs)
-    <> "_ghc-" <> fromString (versionString vghc)
-  display (WCGhcGit commit flavour) =
-    "ghc-git-" <> display commit <> "-" <> display flavour
-
-instance ToJSON WantedCompiler where
-  toJSON = toJSON . utf8BuilderToText . display
-
-instance FromJSON WantedCompiler where
-  parseJSON =
-    withText "WantedCompiler" $ either (fail . show) pure . parseWantedCompiler
-
-instance FromJSONKey WantedCompiler where
-  fromJSONKey =
-    FromJSONKeyTextParser $ \t ->
-    case parseWantedCompiler t of
-      Left e -> fail $ "Invalid WantedCompiler " ++ show t ++ ": " ++ show e
-      Right x -> pure x
-
--- | Parse a 'Text' into a 'WantedCompiler' value.
---
--- @since 0.1.0.0
-parseWantedCompiler :: Text -> Either PantryException WantedCompiler
-parseWantedCompiler t0 = maybe (Left $ InvalidWantedCompiler t0) Right $
-  case T.stripPrefix "ghcjs-" t0 of
-    Just t1 -> parseGhcjs t1
-    Nothing -> case T.stripPrefix "ghc-git-" t0 of
-       Just t1 -> parseGhcGit t1
-       Nothing -> T.stripPrefix "ghc-" t0 >>= parseGhc
- where
-  parseGhcjs t1 = do
-    let (ghcjsVT, t2) = T.break (== '_') t1
-    ghcjsV <- parseVersion $ T.unpack ghcjsVT
-    ghcVT <- T.stripPrefix "_ghc-" t2
-    ghcV <- parseVersion $ T.unpack ghcVT
-    pure $ WCGhcjs ghcjsV ghcV
-  parseGhcGit t1 = do
-    let (commit, flavour) = T.break (== '-') t1
-    pure $ WCGhcGit commit (T.drop 1 flavour)
-  parseGhc = fmap WCGhc . parseVersion . T.unpack
-
-instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLocation)) where
-  parseJSON v = text v <|> obj v
-   where
-    text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-    text =
-      withText "UnresolvedSnapshotLocation (Text)" $
-        pure . noJSONWarnings . parseRawSnapshotLocation
-
-    obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-    obj = withObjectWarnings "UnresolvedSnapshotLocation (Object)" $ \o ->
-      (pure . RSLCompiler <$> o ..: "compiler") <|>
-      ((\x y -> pure $ RSLUrl x y) <$> o ..: "url" <*> blobKey o) <|>
-      (parseRawSnapshotLocationPath <$> o ..: "filepath")
-
-    blobKey o = do
-      msha <- o ..:? "sha256"
-      msize <- o ..:? "size"
-      case (msha, msize) of
-        (Nothing, Nothing) -> pure Nothing
-        (Just sha, Just size') -> pure $ Just $ BlobKey sha size'
-        (Just _sha, Nothing) -> fail "You must also specify the file size"
-        (Nothing, Just _) -> fail "You must also specify the file's SHA256"
-
-instance Display SnapshotLocation where
-  display (SLCompiler compiler) = display compiler
-  display (SLUrl url blob) = display url <> " (" <> display blob <> ")"
-  display (SLFilePath resolved) = display (resolvedRelative resolved)
-
--- | Parse a 'Text' into an 'Unresolved' 'RawSnapshotLocation'.
---
--- @since 0.1.0.0
-parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
-parseRawSnapshotLocation t0 = fromMaybe (parseRawSnapshotLocationPath t0) $
-  either (const Nothing) (Just . pure . RSLCompiler) (parseWantedCompiler t0) <|>
-  (pure . RSLSynonym <$> parseSnapName t0) <|>
-  parseGitHub <|>
-  parseUrl
- where
-  parseGitHub = do
-    t1 <- T.stripPrefix "github:" t0
-    let (user, t2) = T.break (== '/') t1
-    t3 <- T.stripPrefix "/" t2
-    let (repo, t4) = T.break (== ':') t3
-    path <- T.stripPrefix ":" t4
-    Just $ pure $ githubSnapshotLocation user repo path
-
-  parseUrl = parseRequest (T.unpack t0) $> pure (RSLUrl t0 Nothing)
-
-parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
-parseRawSnapshotLocationPath t =
-  Unresolved $ \case
-    Nothing -> throwIO $ InvalidFilePathSnapshot t
-    Just dir -> do
-      abs' <- resolveFile dir (T.unpack t) `catchAny` \_ -> throwIO (InvalidSnapshotLocation dir t)
-      pure $ RSLFilePath $ ResolvedPath (RelFilePath t) abs'
-
-githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
-githubSnapshotLocation user repo path =
-  let url = T.concat
-        [ "https://raw.githubusercontent.com/"
-        , user
-        , "/"
-        , repo
-        , "/master/"
-        , path
-        ]
-  in  RSLUrl url Nothing
-
-defUser :: Text
-defUser = "commercialhaskell"
-
-defRepo :: Text
-defRepo = "stackage-snapshots"
-
--- | Default location of snapshot synonyms, i.e. commercialhaskell's GitHub
--- repository.
---
--- @since 0.5.0.0
-defaultSnapshotLocation ::
-     SnapName
-  -> RawSnapshotLocation
-defaultSnapshotLocation (LTS x y) =
-  githubSnapshotLocation defUser defRepo $
-  utf8BuilderToText $
-  "lts/" <> display x <> "/" <> display y <> ".yaml"
-defaultSnapshotLocation (Nightly date) =
-     githubSnapshotLocation defUser defRepo
-  $  utf8BuilderToText
-  $  "nightly/"
-  <> display year
-  <> "/"
-  <> display month
-  <> "/"
-  <> display day
-  <> ".yaml"
- where
-  (year, month, day) = toGregorian date
-
--- | A snapshot synonym. It is expanded according to the field
--- 'snapshotLocation' of a 'PantryConfig'.
---
--- @ since 0.5.0.0
-data SnapName
-    = LTS
-        !Int -- ^ Major version
-        !Int -- ^ Minor version
-      -- ^ LTS Haskell snapshot, displayed as @"lts-maj.min"@.
-      --
-      -- @since 0.5.0.0
-    | Nightly !Day
-      -- ^ Stackage Nightly snapshot, displayed as @"nighly-YYYY-MM-DD"@.
-      --
-      -- @since 0.5.0.0
-    deriving (Eq, Ord, Generic)
-
-instance NFData SnapName
-
-instance Display SnapName where
-  display (LTS x y) = "lts-" <> display x <> "." <> display y
-  display (Nightly date) = "nightly-" <> displayShow date
-
-instance Show SnapName where
-  show = T.unpack . utf8BuilderToText . display
-
-instance ToJSON SnapName where
-  toJSON syn = String $ utf8BuilderToText $ display syn
-
--- | Parse the short representation of a 'SnapName'.
---
--- @since 0.5.0.0
-parseSnapName :: MonadThrow m => Text -> m SnapName
-parseSnapName t0 =
-  case lts <|> nightly of
-    Nothing -> throwM $ ParseSnapNameException t0
-    Just sn -> pure sn
- where
-  lts = do
-    t1 <- T.stripPrefix "lts-" t0
-    Right (x, t2) <- Just $ decimal t1
-    t3 <- T.stripPrefix "." t2
-    Right (y, "") <- Just $ decimal t3
-    pure $ LTS x y
-  nightly = do
-    t1 <- T.stripPrefix "nightly-" t0
-    Nightly <$> readMaybe (T.unpack t1)
-
--- | Where to load a snapshot from in raw form (RSUrl could have a missing
--- BlobKey)
---
--- @since 0.1.0.0
-data RawSnapshotLocation
-  = RSLCompiler !WantedCompiler
-    -- ^ Don't use an actual snapshot, just a version of the compiler with its
-    -- shipped packages.
-    --
-    -- @since 0.1.0.0
-  | RSLUrl !Text !(Maybe BlobKey)
-    -- ^ Download the snapshot from the given URL. The optional 'BlobKey' is
-    -- used for reproducibility.
-    --
-    -- @since 0.1.0.0
-  | RSLFilePath !(ResolvedPath File)
-    -- ^ Snapshot at a local file path.
-    --
-    -- @since 0.1.0.0
-  | RSLSynonym !SnapName
-    -- ^ Snapshot synonym (LTS/Nightly).
-    --
-    -- @since 0.5.0.0
-  deriving (Show, Eq, Ord, Generic)
-
-instance NFData RawSnapshotLocation
-
-instance Display RawSnapshotLocation where
-  display (RSLCompiler compiler) = display compiler
-  display (RSLUrl url Nothing) = display url
-  display (RSLUrl url (Just blob)) = display url <> " (" <> display blob <> ")"
-  display (RSLFilePath resolved) = display (resolvedRelative resolved)
-  display (RSLSynonym syn) = display syn
-
-instance Pretty RawSnapshotLocation where
-  pretty (RSLCompiler compiler) = fromString . T.unpack $ textDisplay compiler
-  pretty (RSLUrl url Nothing) = style Url (fromString $ T.unpack url)
-  pretty (RSLUrl url (Just blob)) = fillSep
-    [ style Url (fromString $ T.unpack  url)
-    , parens (fromString . T.unpack $ textDisplay blob)
-    ]
-  pretty (RSLFilePath resolved) =
-    style File (fromString . T.unpack $ textDisplay (resolvedRelative resolved))
-  pretty (RSLSynonym syn) =
-    style Shell (fromString . T.unpack $ textDisplay syn)
-
-instance ToJSON RawSnapshotLocation where
-  toJSON (RSLCompiler compiler) = object ["compiler" .= compiler]
-  toJSON (RSLUrl url mblob) = object
-    $ "url" .= url
-    : maybe [] blobKeyPairs mblob
-  toJSON (RSLFilePath resolved) =
-    object ["filepath" .= resolvedRelative resolved]
-  toJSON (RSLSynonym syn) = toJSON syn
-
--- | Where to load a snapshot from.
---
--- @since 0.1.0.0
-data SnapshotLocation
-  = SLCompiler !WantedCompiler
-    -- ^ Don't use an actual snapshot, just a version of the compiler
-    -- with its shipped packages.
-    --
-    -- @since 0.1.0.0
-  | SLUrl !Text !BlobKey
-    -- ^ Download the snapshot from the given URL. The optional
-    -- 'BlobKey' is used for reproducibility.
-    --
-    -- @since 0.1.0.0
-  | SLFilePath !(ResolvedPath File)
-    -- ^ Snapshot at a local file path.
-    --
-    -- @since 0.1.0.0
-  deriving (Show, Eq, Ord, Generic)
-
-instance NFData SnapshotLocation
-
-instance ToJSON SnapshotLocation where
-  toJSON sl = toJSON (toRawSL sl)
-
-instance FromJSON (WithJSONWarnings (Unresolved SnapshotLocation)) where
-  parseJSON v = file v <|> url v <|> compiler v
-   where
-    file = withObjectWarnings "SLFilepath" $ \o -> do
-      ufp <- o ..: "filepath"
-      pure $ Unresolved $ \case
-        Nothing -> throwIO $ InvalidFilePathSnapshot ufp
-        Just dir -> do
-          absolute <- resolveFile dir (T.unpack ufp)
-          let fp = ResolvedPath (RelFilePath ufp) absolute
-          pure $ SLFilePath fp
-    url = withObjectWarnings "SLUrl" $ \o -> do
-      url' <- o ..: "url"
-      sha <- o ..: "sha256"
-      size <- o ..: "size"
-      pure $ Unresolved $ \_ -> pure $ SLUrl url' (BlobKey sha size)
-    compiler = withObjectWarnings "SLCompiler" $ \o -> do
-      c <- o ..: "compiler"
-      pure $ Unresolved $ \_ -> pure $ SLCompiler c
-
--- | Convert snapshot location to its "raw" equivalent.
---
--- @since 0.1.0.0
-toRawSL :: SnapshotLocation -> RawSnapshotLocation
-toRawSL (SLCompiler c) = RSLCompiler c
-toRawSL (SLUrl url blob) = RSLUrl url (Just blob)
-toRawSL (SLFilePath fp) = RSLFilePath fp
-
--- | A flattened representation of all the layers in a snapshot.
---
--- @since 0.1.0.0
-data RawSnapshot = RawSnapshot
-  { rsCompiler :: !WantedCompiler
-    -- ^ The compiler wanted for this snapshot.
-  , rsPackages :: !(Map PackageName RawSnapshotPackage)
-    -- ^ Packages available in this snapshot for installation. This will be
-    -- applied on top of any globally available packages.
-  , rsDrop :: !(Set PackageName)
-    -- ^ Global packages that should be dropped/ignored.
-  }
-
--- | A flattened representation of all the layers in a snapshot.
---
--- @since 0.1.0.0
-data Snapshot = Snapshot
-  { snapshotCompiler :: !WantedCompiler
-    -- ^ The compiler wanted for this snapshot.
-  , snapshotPackages :: !(Map PackageName SnapshotPackage)
-    -- ^ Packages available in this snapshot for installation. This will be
-    -- applied on top of any globally available packages.
-  , snapshotDrop :: !(Set PackageName)
-    -- ^ Global packages that should be dropped/ignored.
-  }
-
--- | Settings for a package found in a snapshot.
---
--- @since 0.1.0.0
-data RawSnapshotPackage = RawSnapshotPackage
-  { rspLocation :: !RawPackageLocationImmutable
-    -- ^ Where to get the package from
-  , rspFlags :: !(Map FlagName Bool)
-    -- ^ Same as 'slFlags'
-  , rspHidden :: !Bool
-    -- ^ Same as 'slHidden'
-  , rspGhcOptions :: ![Text]
-    -- ^ Same as 'slGhcOptions'
-  }
-
--- | Settings for a package found in a snapshot.
---
--- @since 0.1.0.0
-data SnapshotPackage = SnapshotPackage
-  { spLocation :: !PackageLocationImmutable
-    -- ^ Where to get the package from
-  , spFlags :: !(Map FlagName Bool)
-    -- ^ Same as 'slFlags'
-  , spHidden :: !Bool
-    -- ^ Same as 'slHidden'
-  , spGhcOptions :: ![Text]
-    -- ^ Same as 'slGhcOptions'
-  }
-  deriving Show
-
--- | A single layer of a snapshot, i.e. a specific YAML configuration file.
---
--- @since 0.1.0.0
-data RawSnapshotLayer = RawSnapshotLayer
-  { rslParent :: !RawSnapshotLocation
-    -- ^ The sl to extend from. This is either a specific compiler, or a
-    -- @SnapshotLocation@ which gives us more information (like packages).
-    -- Ultimately, we'll end up with a @CompilerVersion@.
-    --
-    -- @since 0.1.0.0
-  , rslCompiler :: !(Maybe WantedCompiler)
-    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if
-    -- using 'SLCompiler'.
-    --
-    -- @since 0.1.0.0
-  , rslLocations :: ![RawPackageLocationImmutable]
-    -- ^ Where to grab all of the packages from.
-    --
-    -- @since 0.1.0.0
-  , rslDropPackages :: !(Set PackageName)
-    -- ^ Packages present in the parent which should not be included here.
-    --
-    -- @since 0.1.0.0
-  , rslFlags :: !(Map PackageName (Map FlagName Bool))
-    -- ^ Flag values to override from the defaults
-    --
-    -- @since 0.1.0.0
-  , rslHidden :: !(Map PackageName Bool)
-    -- ^ Packages which should be hidden when registering. This will affect, for
-    -- example, the import parser in the script command. We use a 'Map' instead
-    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.
-    --
-    -- @since 0.1.0.0
-  , rslGhcOptions :: !(Map PackageName [Text])
-    -- ^ GHC options per package
-    --
-    -- @since 0.1.0.0
-  , rslPublishTime :: !(Maybe UTCTime)
-    -- ^ See 'slPublishTime'
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Show, Eq, Generic)
-
-instance NFData RawSnapshotLayer
-
-instance ToJSON RawSnapshotLayer where
-  toJSON rsnap = object $ concat
-    [ ["resolver" .= rslParent rsnap]
-    , maybe [] (\compiler -> ["compiler" .= compiler]) (rslCompiler rsnap)
-    , ["packages" .= rslLocations rsnap]
-    , [ "drop-packages" .= Set.map CabalString (rslDropPackages rsnap)
-      | not (Set.null (rslDropPackages rsnap))
-      ]
-    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap (rslFlags rsnap))
-      | not(Map.null (rslFlags rsnap))
-      ]
-    , [ "hidden" .= toCabalStringMap (rslHidden rsnap)
-      | not (Map.null (rslHidden rsnap))
-      ]
-    , [ "ghc-options" .= toCabalStringMap (rslGhcOptions rsnap)
-      | not (Map.null (rslGhcOptions rsnap))
-      ]
-    , maybe [] (\time -> ["publish-time" .= time]) (rslPublishTime rsnap)
-    ]
-
-instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
-  parseJSON = withObjectWarnings "Snapshot" $ \o -> do
-    _ :: Maybe Text <- o ..:? "name" -- avoid warnings for old snapshot format
-    mcompiler <- o ..:? "compiler"
-    mresolver <- jsonSubWarningsT $ o ...:? ["snapshot", "resolver"]
-    unresolvedSnapshotParent <-
-      case (mcompiler, mresolver) of
-        (Nothing, Nothing) -> fail "Snapshot must have either resolver or compiler"
-        (Just compiler, Nothing) -> pure $ pure (RSLCompiler compiler, Nothing)
-        (_, Just (Unresolved usl)) -> pure $ Unresolved $ \mdir -> do
-          sl <- usl mdir
-          case (sl, mcompiler) of
-            (RSLCompiler c1, Just c2) -> throwIO $ InvalidOverrideCompiler c1 c2
-            _ -> pure (sl, mcompiler)
-
-    unresolvedLocs <- jsonSubWarningsT (o ..:? "packages" ..!= [])
-    rslDropPackages <- Set.map unCabalString <$> (o ..:? "drop-packages" ..!= Set.empty)
-    rslFlags <- unCabalStringMap . fmap unCabalStringMap <$> (o ..:? "flags" ..!= Map.empty)
-    rslHidden <- unCabalStringMap <$> (o ..:? "hidden" ..!= Map.empty)
-    rslGhcOptions <- unCabalStringMap <$> (o ..:? "ghc-options" ..!= Map.empty)
-    rslPublishTime <- o ..:? "publish-time"
-    pure $ (\rslLocations (rslParent, rslCompiler) -> RawSnapshotLayer {..})
-      <$> (concatMap NE.toList <$> sequenceA unresolvedLocs)
-      <*> unresolvedSnapshotParent
-
--- | A single layer of a snapshot, i.e. a specific YAML configuration file.
---
--- @since 0.1.0.0
-data SnapshotLayer = SnapshotLayer
-  { slParent :: !SnapshotLocation
-    -- ^ The sl to extend from. This is either a specific compiler, or a
-    -- @SnapshotLocation@ which gives us more information (like packages).
-    -- Ultimately, we'll end up with a @CompilerVersion@.
-    --
-    -- @since 0.1.0.0
-  , slCompiler :: !(Maybe WantedCompiler)
-    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if
-    -- using 'SLCompiler'.
-    --
-    -- @since 0.1.0.0
-  , slLocations :: ![PackageLocationImmutable]
-    -- ^ Where to grab all of the packages from.
-    --
-    -- @since 0.1.0.0
-  , slDropPackages :: !(Set PackageName)
-    -- ^ Packages present in the parent which should not be included here.
-    --
-    -- @since 0.1.0.0
-  , slFlags :: !(Map PackageName (Map FlagName Bool))
-    -- ^ Flag values to override from the defaults
-    --
-    -- @since 0.1.0.0
-  , slHidden :: !(Map PackageName Bool)
-    -- ^ Packages which should be hidden when registering. This will affect, for
-    -- example, the import parser in the script command. We use a 'Map' instead
-    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.
-    --
-    -- @since 0.1.0.0
-  , slGhcOptions :: !(Map PackageName [Text])
-    -- ^ GHC options per package
-    --
-    -- @since 0.1.0.0
-  , slPublishTime :: !(Maybe UTCTime)
-    -- ^ Publication timestamp for this snapshot. This field is optional, and is
-    -- for informational purposes only.
-    --
-    -- @since 0.1.0.0
-  }
-  deriving (Show, Eq, Generic)
-
-instance ToJSON SnapshotLayer where
-  toJSON snap = object $ concat
-    [ ["resolver" .= slParent snap]
-    , maybe [] (\compiler -> ["compiler" .= compiler]) (slCompiler snap)
-    , ["packages" .= slLocations snap]
-    , [ "drop-packages" .= Set.map CabalString (slDropPackages snap)
-      | not (Set.null (slDropPackages snap))
-      ]
-    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap (slFlags snap))
-      | not (Map.null (slFlags snap))
-      ]
-    , [ "hidden" .= toCabalStringMap (slHidden snap)
-      | not (Map.null (slHidden snap))
-      ]
-    , [ "ghc-options" .= toCabalStringMap (slGhcOptions snap)
-      | not (Map.null (slGhcOptions snap))
-      ]
-    , maybe [] (\time -> ["publish-time" .= time]) (slPublishTime snap)
-    ]
-
--- | Convert snapshot layer into its "raw" equivalent.
---
--- @since 0.1.0.0
-toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
-toRawSnapshotLayer sl = RawSnapshotLayer
-  { rslParent = toRawSL (slParent sl)
-  , rslCompiler = slCompiler sl
-  , rslLocations = map toRawPLI (slLocations sl)
-  , rslDropPackages = slDropPackages sl
-  , rslFlags = slFlags sl
-  , rslHidden = slHidden sl
-  , rslGhcOptions = slGhcOptions sl
-  , rslPublishTime = slPublishTime sl
-  }
-
--- | An arbitrary hash for a snapshot, used for finding module names in a
--- snapshot. Mostly intended for Stack's usage.
---
--- @since 0.1.0.0
-newtype SnapshotCacheHash = SnapshotCacheHash { unSnapshotCacheHash :: SHA256}
-  deriving (Show)
-
--- | Get the path to the global hints cache file
-getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
-getGlobalHintsFile = do
-  root <- view $ pantryConfigL.to pcRootDir
-  globalHintsRelFile <- parseRelFile "global-hints-cache.yaml"
-  pure $ root </> globalHintsRelFile
-
--- | Creates BlobKey for an input ByteString
---
--- @since 0.1.0.0
-bsToBlobKey :: ByteString -> BlobKey
-bsToBlobKey bs =
-  BlobKey (SHA256.hashBytes bs) (FileSize (fromIntegral (B.length bs)))
-
--- | Warn if the package uses 'PCHpack'.
---
--- @since 0.4.0.0
-warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()
-warnMissingCabalFile loc =
-  logWarn $
-       "DEPRECATED: The package at "
-    <> display loc
-    <> " does not include a cabal file.\n"
-    <> "Instead, it includes an hpack package.yaml file for generating a cabal file.\n"
-    <> "This usage is deprecated; please see "
-    <> "https://github.com/commercialhaskell/stack/issues/5210.\n"
-    <> "Support for this workflow will be removed in the future.\n"