Split out pantry

snapshot-lts-12.yaml

@@ -18,6 +18,7 @@ packages:
 - rio-prettyprint-0.1.0.0
 - hi-file-parser-0.1.0.0
 - http-download-0.1.0.0
+- pantry-0.1.1.0
 - git: https://github.com/snoyberg/filelock.git
   commit: 97e83ecc133cd60a99df8e1fa5a3c2739ad007dc
 

snapshot-nightly.yaml

@@ -12,6 +12,7 @@ packages:
 - rio-prettyprint-0.1.0.0
 - hi-file-parser-0.1.0.0
 - http-download-0.1.0.0
+- pantry-0.1.1.0
 - git: https://github.com/snoyberg/filelock.git
   commit: 97e83ecc133cd60a99df8e1fa5a3c2739ad007dc
 

snapshot.yaml

@@ -26,6 +26,7 @@ packages:
 - rio-prettyprint-0.1.0.0
 - hi-file-parser-0.1.0.0
 - http-download-0.1.0.0
+- pantry-0.1.1.0
 - git: https://github.com/snoyberg/filelock.git
   commit: 97e83ecc133cd60a99df8e1fa5a3c2739ad007dc
 

stack-lts-12.yaml

 resolver: snapshot-lts-12.yaml
 
-packages:
-- .
-- subs/pantry
-
 docker:
   enable: false
   repo: fpco/stack-build-small:lts-12.26

stack-nightly.yaml

 resolver: snapshot-nightly.yaml
 
-packages:
-- .
-- subs/pantry
-
 docker:
   enable: false
   repo: fpco/stack-build-small:lts-13.26

stack.yaml

 resolver: snapshot.yaml
 
-packages:
-- .
-- subs/pantry
-
 docker:
   enable: false
   repo: fpco/stack-build:lts-11.22

subs/pantry/.hindent.yaml

-indent-size: 2

subs/pantry/ChangeLog.md

-# Changelog for pantry
-
-
-## Unreleased changes
-
-**Changes since v0.1.1.0**
-
-Release notes:
-
-Major changes:
-
-Behavior changes:
-
-Other enhancements:
-
-Bug fixes:
-
-
-## v0.1.1.0
-
-**Changes since 0.1.0.0**
-
-Bug fixes:
-
-* Fix to allow dependencies on specific versions of local git repositories. See
-  [#4862](https://github.com/commercialhaskell/stack/pull/4862)
-
-Behavior changes:
-
-* By default, do not perform expiry checks in Hackage Security. See
-
-  [#4928](https://github.com/commercialhaskell/stack/issues/4928).
-
-Other changes:
-
-* Rename `pantry-tmp` package back to `pantry`, now that we have gained
-  maintainership (which had been used by someone else for a candidate-only test
-  that made it look like the name was free but prevented uploading a real
-  package).
-
-
-## 0.1.0.0
-
-* Initial release

subs/pantry/LICENSE

-Copyright (c) 2015-2019, Stack contributors
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-    * Redistributions in binary form must reproduce the above copyright
-      notice, this list of conditions and the following disclaimer in the
-      documentation and/or other materials provided with the distribution.
-    * Neither the name of Stack nor the
-      names of its contributors may be used to endorse or promote products
-      derived from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL STACK CONTRIBUTORS BE LIABLE FOR ANY
-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

subs/pantry/README.md

-# pantry
-
-TODO: Add Travis and AppVeyor badges
-
-Content addressable Haskell package management, providing for secure,
-reproducible acquisition of Haskell package contents and metadata.
-
-## What is Pantry
-
-* A Haskell library, command line executable, storage specification, and
-  network protocol
-* Intended for content-addressable storage of Haskell packages
-* Allows non-centralized package storage
-* Primarily for use by Stackage and Stack, hopefully other tools as well
-
-## Goals
-
-* Efficient, distributed package storage for Haskell
-* Superset of existing storage mechanisms
-* Security via content addressable storage
-* Allow more Stackage-style snapshots to exist
-* Allow authors to bypass Hackage for uploads
-* Allow Stackage to create forks of packages on Hackage
-
-__TODO__
-
-Content below needs to be updated.
-
-* Support for hpack in PackageLocationImmutable?
-
-## Package definition
-
-Pantry defines the following concepts:
-
-* __Blob__: a raw byte sequence, identified by its key (SHA256 of the
-  contents)
-* __Tree entry__: contents of a single file (identified by blob key)
-  and whether or not it is executable.
-    * NOTE: existing package formats like tarballs support more
-      sophisticated options. We explicitly do not support those. If
-      such functionality is needed, fallback to those mechanism is
-      required.
-* __Tree__: mapping from relative path to a tree entry. Some basic
-  sanity rules apply to the paths: no `.` or `..` directory
-  components, no newlines in filepaths, does not begin with `/`, no
-  `\\` (we normalize to POSIX-style paths). A tree is identified by a
-  tree key (SHA256 of the tree's serialized format).
-* __Package__: a tree key for the package contents, package name,
-  version number, and cabal file blob key. Requirements: there must be
-  a single file with a `.cabal` file extension at the root of the
-  tree, and it must match the cabal file blob key. The cabal file must
-  be located at `pkgname.cabal`. Each tree can be in at most one
-  package, and therefore tree keys work as package keys too.
-
-Note that with the above, a tree key is all the information necessary
-to uniquely identify a package. However, including additional
-information (package name, version, cabal key) in config files may be
-useful for optimizations or user friendliness. If such extra
-information is ever included, it must be validated to concur with the
-package contents itself.
-
-### Package location
-
-Packages will optionally be sourced from some location:
-
-* __Hackage__ requires the package name, version number, and revision
-  number. Each revision of a package will end up with a different tree
-  key.
-* __Archive__ takes a URL pointing to a tarball (gzipped or not) or a
-  ZIP file. An implicit assumption is that archives remain immutable
-  over time. Use tree keys to verify this assumption. (Same applies to
-  Hackage for that matter.)
-* __Repository__ takes a repo type (Git or Mercurial), URL, and
-  commit. Assuming the veracity of the cryptographic hashes on the
-  repos, this should guarantee a unique set of files.
-
-In order to deal with _megarepos_ (repos and archives containing more
-than one package), there is also a subdirectory for the archive and
-repository cases. An empty subdir `""` would be the case for a
-standard repo/archive.
-
-In order to meet the rules of a package listed above, the following
-logic is applied to all three types above:
-
-* Find all of the files in the raw location, and represent as `Map
-  FilePath TreeEntry` (or equivalent).
-* Remove a wrapper directory. If _all_ filepaths in that `Map` are
-  contained within the same directory, strip it from all of the
-  paths. For example, if the paths are `foo/bar` and `foo/baz`, the
-  paths will be reduced to `bar` and `baz`.
-* After this wrapper is removed, then subdirectory logic is applied,
-  essentially applying `stripPrefix` to the filepaths. If the subdir
-  is `yesod-bin` and files exist called `yesod-core/yesod-core.cabal`
-  and `yesod-bin/yesod-bin.cabal`, the only file remaining after
-  subdir stripping would be `yesod-bin.cabal`. Note that trailing
-  slashes must be handled appropriately, and that an empty subdir
-  string results in this step being a noop.
-
-The result of all of this is that, given one of the three package
-locations above, we can receive a tree key which will provide an
-installable package. That tree key will remain immutable.
-
-### How tooling refers to packages
-
-We'll get to the caching mechanism for Pantry below. However, the
-recommended approach for tooling is to support some kind of composite
-of the Pantry keys, parsed info, and raw package location. This allows
-for more efficient lookups when available, with a fallback when
-mirrors don't have the needed information.
-
-An example:
-
-```yaml
-extra-deps:
-- name: foobar
-  version: 1.2.3.4
-  pantry: deadbeef # tree key
-  cabal-file: 12345678 # blob key
-  archive: https://example.com/foobar-1.2.3.4.tar.gz
-```
-
-It is also recommended that tooling provide an easy way to generate
-such complete information from, e.g., just the URL of the tarball, and
-that upon reading information, hashes, package names, and version
-numbers are all checked for correctness.
-
-## Pantry caching
-
-One simplistic option for Pantry would be that, every time a piece of
-data is needed, Pantry downloads the necessary tarball/Git
-repo/etc. However, this would in practice be highly wasteful, since
-downloading Git repos and archives just to get a single cabal file
-(for plan construction purposes) is overkill. Instead, here's the
-basic idea for how caching works:
-
-* All data for Pantry can be stored in a SQL database. Local tools
-  like Stack will use an SQLite database. Servers will use PostgreSQL.
-* We'll define a network protocol (initially just HTTP, maybe
-  extending to something more efficient if desired) for querying blobs
-  and trees.
-* When a blob or tree is needed, it is first checked for in the local
-  SQLite cache. If it's not available there, a request to the Pantry
-  mirrors (configurable) will be made for the data. Since everything
-  is content addressable, it is safe to use untrusted mirrors.
-* If the data is not available in a mirror, and a location is
-  provided, the location will be downloaded and cached locally.
-
-We may also allow these Pantry mirrors to provide some kind of query
-interface to find out, e.g., the latest version of a package on
-Hackage. That's still TBD.
-
-## Example: resolving a package location
-
-To work through a full example, the following three stanzas are intended to
-have equivalent behavior:
-
-```yaml
-- archive: https://example.com/foobar-1.2.3.4.tar.gz
-
-- name: foobar
-  version: 1.2.3.4
-  pantry: deadbeef # tree key
-  cabal-file: 12345678 # blob key
-  archive: https://example.com/foobar-1.2.3.4.tar.gz
-
-- pantry: deadbeef
-
-```
-
-The question is: how does the first one (presumably what a user would want to
-enter) be resolved into the second and third? Pantry would follow this set of
-steps:
-
-* Download the tarball from the given URL
-* Place each file in the tarball into its store as a blob, getting a blob key
-  for each. The tarball is now represented as `Map FilePath BlobKey`
-* Perform the root directory stripping step, removing a shared path
-* Since there's no subdirectory: no subdirectory stripping would be performed
-* Serialize the `Map FilePath BlobKey` to a binary format and take its hash to
-  get a tree key
-* Store the tree in the store referenced by its tree key. In our example: the
-  tree key is `deadbeef`.
-* Ensure that the tree is a valid package by checking for a single cabal file
-  at the root. In our example, that's found in `foobar.cabal` with blob key
-  `12345678`.
-* Parse the cabal file and ensure that it is a valid cabal file, and that its
-  package name is `foobar`. Grab the version number (1.2.3.4).
-* We now know that tree key `deadbeef` is a valid package, and can refer to it
-  by tree key exclusively. However, including the other information allows us
-  to verify our assumptions, provide user-friendly readable data, and provide a
-  fallback if the package isn't in the Pantry cache.
-
-## More advanced content discovery
-
-There are three more advanced cases to consider:
-
-* Providing fall-back locations for content, such as out of concern for a
-  single URL being removed in the future
-* Closed corporate setups, where access to the general internet may either be
-  impossible or undesirable
-* Automatic discovery of missing content by hash
-
-The following extensions are possible to address these cases:
-
-* Instead of a single package location, provide a list of package locations
-  with fallback semantics.
-* Corporate environments will be encouraged to run a local Pantry mirror, and
-  configure clients like Stack to speak to these mirrors instead of the default
-  ones (or in addition to).
-* Provide some kind of federation protocol for Pantry where servers can
-  registry with each other and requests for content can be pinged to each
-  other.
-
-Providing override at the client level for Pantry mirror locations is a
-__MUST__. Making it easy to run in a corporate environment is a __SHOULD__.
-Providing the fallback package locations seems easy enough that we should
-include it initially, but falls under a __SHOULD__. The federated protocol
-should be added on-demand.

subs/pantry/package.yaml

-name:        pantry
-version:     0.1.1.0
-synopsis:    Content addressable Haskell package management
-description: Please see the README on Github at <https://github.com/commercialhaskell/stack/blob/master/subs/pantry/README.md>
-category:    Development
-author:      Michael Snoyman
-maintainer:  michael@snoyman.com
-copyright:   2018-2019 FP Complete
-license:     BSD3
-github:      commercialhaskell/stack # TODO move to commercialhaskell/pantry!
-
-default-extensions:
-- MonadFailDesugaring
-
-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
-
-dependencies:
-- base >=4.10 && < 5
-- ansi-terminal
-- digest
-- rio
-- aeson
-- text
-- unordered-containers
-- containers
-- path
-- transformers
-- generic-deriving
-- unliftio
-- http-conduit
-- http-client-tls
-- http-download
-- http-types
-- http-client
-- conduit
-- bytestring
-- network-uri
-- hackage-security
-- primitive
-- vector
-- memory
-- cryptonite
-- cryptonite-conduit
-- persistent
-- persistent-sqlite
-- persistent-template
-- Cabal
-- path-io
-- rio-orphans
-- conduit-extra
-- tar-conduit
-- time
-- unix-compat
-- hpack
-- yaml
-- zip-archive
-- text-metrics
-- resourcet
-- rio-prettyprint
-- mtl
-- filelock
-
-# FIXME remove when we drop store
-- integer-gmp
-- ghc-prim
-- template-haskell
-- network
-- th-utilities
-- th-reify-many
-- th-lift
-- th-lift-instances
-- mono-traversable
-- safe
-- contravariant
-- syb
-- deepseq
-- array
-- hashable
-- base-orphans
-- th-orphans
-- cryptonite
-- base64-bytestring
-- directory
-- filepath
-
-ghc-options:
-  - -Wall
-
-library:
-  source-dirs: src/
-  when:
-  - condition: 'os(windows)'
-    then:
-      source-dirs: src/windows/
-    else:
-      source-dirs: src/unix/
-
-  exposed-modules:
-  - Pantry
-  - Pantry.SHA256
-
-  # For testing
-  - Pantry.Internal
-  - Pantry.Internal.StaticBytes
-
-  # For stackage-server
-  - Pantry.Internal.Stackage
-
-  # For stack
-  - 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.Tree
-  - Pantry.Types
-
-tests:
-  spec:
-    source-dirs: test
-    main: Spec.hs
-    dependencies:
-    - pantry
-    - hspec
-    - exceptions
-    - hedgehog
-    - QuickCheck
-    - raw-strings-qq

subs/pantry/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs

--- Explicitly disabling due to external code {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings   #-}
--- Taken from
--- https://github.com/well-typed/hackage-security/tree/master/hackage-security-http-client
--- to avoid extra dependencies
-module Hackage.Security.Client.Repository.HttpLib.HttpClient (
-    httpLib
-  ) where
-
-import Control.Exception
-import Control.Monad (void)
-import Data.ByteString (ByteString)
-import Network.URI
-import qualified Data.ByteString              as BS
-import qualified Data.ByteString.Char8        as BS.C8
-import qualified Pantry.HTTP as HTTP
-
-import Hackage.Security.Client hiding (Header)
-import Hackage.Security.Client.Repository.HttpLib
-import Hackage.Security.Util.Checked
-import qualified Hackage.Security.Util.Lens as Lens
-
-{-------------------------------------------------------------------------------
-  Top-level API
--------------------------------------------------------------------------------}
-
--- | An 'HttpLib' value using the default global manager
-httpLib :: HttpLib
-httpLib = HttpLib
-    { httpGet      = get
-    , httpGetRange = getRange
-    }
-
-{-------------------------------------------------------------------------------
-  Individual methods
--------------------------------------------------------------------------------}
-
-get :: Throws SomeRemoteError
-    => [HttpRequestHeader] -> URI
-    -> ([HttpResponseHeader] -> BodyReader -> IO a)
-    -> IO a
-get reqHeaders uri callback = wrapCustomEx $ do
-    -- TODO: setUri fails under certain circumstances; in particular, when
-    -- the URI contains URL auth. Not sure if this is a concern.
-    request' <- HTTP.setUri HTTP.defaultRequest uri
-    let request = setRequestHeaders reqHeaders request'
-    checkHttpException $ HTTP.withResponse request $ \response -> do
-      let br = wrapCustomEx $ HTTP.getResponseBody response
-      callback (getResponseHeaders response) br
-
-getRange :: Throws SomeRemoteError
-         => [HttpRequestHeader] -> URI -> (Int, Int)
-         -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
-         -> IO a
-getRange reqHeaders uri (from, to) callback = wrapCustomEx $ do
-    request' <- HTTP.setUri HTTP.defaultRequest uri
-    let request = setRange from to
-                $ setRequestHeaders reqHeaders request'
-    checkHttpException $ HTTP.withResponse request $ \response -> do
-      let br = wrapCustomEx $ HTTP.getResponseBody response
-      case () of
-         () | HTTP.getResponseStatus response == HTTP.partialContent206 ->
-           callback HttpStatus206PartialContent (getResponseHeaders response) br
-         () | HTTP.getResponseStatus response == HTTP.ok200 ->
-           callback HttpStatus200OK (getResponseHeaders response) br
-         _otherwise ->
-           throwChecked $ HTTP.HttpExceptionRequest request
-                        $ HTTP.StatusCodeException (void response) ""
-
--- | Wrap custom exceptions
---
--- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@
--- but it is currently disabled <https://github.com/snoyberg/http-client/issues/116>
-wrapCustomEx :: (Throws HTTP.HttpException => IO a)
-             -> (Throws SomeRemoteError => IO a)
-wrapCustomEx act = handleChecked (\(ex :: HTTP.HttpException) -> go ex) act
-  where
-    go ex = throwChecked (SomeRemoteError ex)
-
-checkHttpException :: Throws HTTP.HttpException => IO a -> IO a
-checkHttpException = handle $ \(ex :: HTTP.HttpException) ->
-                       throwChecked ex
-
-{-------------------------------------------------------------------------------
-  http-client auxiliary
--------------------------------------------------------------------------------}
-
-hAcceptRanges :: HTTP.HeaderName
-hAcceptRanges = "Accept-Ranges"
-
-hAcceptEncoding :: HTTP.HeaderName
-hAcceptEncoding = "Accept-Encoding"
-
-setRange :: Int -> Int
-         -> HTTP.Request -> HTTP.Request
-setRange from to =
-    HTTP.addRequestHeader HTTP.hRange rangeHeader
-  where
-    -- Content-Range header uses inclusive rather than exclusive bounds
-    -- See <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html>
-    rangeHeader = BS.C8.pack $ "bytes=" ++ show from ++ "-" ++ show (to - 1)
-
--- | Set request headers
-setRequestHeaders :: [HttpRequestHeader]
-                  -> HTTP.Request -> HTTP.Request
-setRequestHeaders opts =
-    HTTP.setRequestHeaders (trOpt disallowCompressionByDefault opts)
-  where
-    trOpt :: [(HTTP.HeaderName, [ByteString])]
-          -> [HttpRequestHeader]
-          -> [HTTP.Header]
-    trOpt acc [] =
-      concatMap finalizeHeader acc
-    trOpt acc (HttpRequestMaxAge0:os) =
-      trOpt (insert HTTP.hCacheControl ["max-age=0"] acc) os
-    trOpt acc (HttpRequestNoTransform:os) =
-      trOpt (insert HTTP.hCacheControl ["no-transform"] acc) os
-
-    -- disable content compression (potential security issue)
-    disallowCompressionByDefault :: [(HTTP.HeaderName, [ByteString])]
-    disallowCompressionByDefault = [(hAcceptEncoding, [])]
-
-    -- Some headers are comma-separated, others need multiple headers for
-    -- multiple options.
-    --
-    -- TODO: Right we we just comma-separate all of them.
-    finalizeHeader :: (HTTP.HeaderName, [ByteString])
-                   -> [HTTP.Header]
-    finalizeHeader (name, strs) = [(name, BS.intercalate ", " (reverse strs))]
-
-    insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
-    insert x y = Lens.modify (Lens.lookupM x) (++ y)
-
--- | Extract the response headers
-getResponseHeaders :: HTTP.Response a -> [HttpResponseHeader]
-getResponseHeaders response = concat [
-      [ HttpResponseAcceptRangesBytes
-      | (hAcceptRanges, "bytes") `elem` headers
-      ]
-    ]
-  where
-    headers = HTTP.getResponseHeaders response

subs/pantry/src/Pantry/HPack.hs

-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}
-
-module Pantry.HPack
-    (
-     hpack
-    , hpackVersion
-    ) where
-
-import RIO
-import RIO.Process
-import Pantry.Types
-import qualified Data.ByteString.Lazy.Char8 as BL
-import qualified Hpack
-import qualified Hpack.Config as Hpack
-import Data.Char (isSpace, isDigit)
-import Path (Path, Abs, toFilePath, Dir, (</>), filename, parseRelFile)
-import Path.IO (doesFileExist)
-
-
-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,\n" <>
-                        "please upgrade and try again."
-                    Hpack.ExistingCabalFileWasModifiedManually -> logWarn $
-                        cabalFile <>
-                        " was modified manually. Ignoring " <>
-                        fromString (toFilePath hpackFile) <>
-                        " in favor of the cabal file.\nIf 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_

subs/pantry/src/Pantry/HTTP.hs

-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Pantry.HTTP
-  ( module Export
-  , withResponse
-  , httpSink
-  , httpSinkChecked
-  ) where
-
-import           Conduit
-import           Network.HTTP.Client          as Export (parseRequest)
-import           Network.HTTP.Client          as Export (parseUrlThrow)
-import           Network.HTTP.Client          as Export (BodyReader, HttpExceptionContent (StatusCodeException))
-import qualified Network.HTTP.Client          as HTTP (withResponse)
-import           Network.HTTP.Client.Internal as Export (setUri)
-import           Network.HTTP.Client.TLS      (getGlobalManager)
-import           Network.HTTP.Simple          as Export (HttpException (..),
-                                                         Request, Response,
-                                                         addRequestHeader,
-                                                         defaultRequest,
-                                                         getResponseBody,
-                                                         getResponseHeaders,
-                                                         getResponseStatus,
-                                                         setRequestHeader,
-                                                         setRequestHeaders)
-import qualified Network.HTTP.Simple          as HTTP hiding (withResponse)
-import           Network.HTTP.Types           as Export (Header, HeaderName,
-                                                         Status, hCacheControl,
-                                                         hRange, ok200,
-                                                         partialContent206,
-                                                         statusCode)
-import qualified Pantry.SHA256                as SHA256
-import           Pantry.Types
-import           RIO
-import qualified RIO.ByteString               as B
-import qualified RIO.Text                     as T
-
-setUserAgent :: Request -> Request
-setUserAgent = setRequestHeader "User-Agent" ["Haskell pantry package"]
-
-withResponse
-  :: MonadUnliftIO m
-  => HTTP.Request
-  -> (Response BodyReader -> m a)
-  -> m a
-withResponse req inner = withRunInIO $ \run -> do
-  manager <- getGlobalManager
-  HTTP.withResponse (setUserAgent req) manager (run . inner)
-
-httpSink
-  :: MonadUnliftIO m
-  => Request
-  -> (Response () -> ConduitT ByteString Void m a)
-  -> m a
-httpSink req inner = HTTP.httpSink (setUserAgent req) inner
-
-httpSinkChecked
-  :: MonadUnliftIO m
-  => Text
-  -> Maybe SHA256
-  -> Maybe FileSize
-  -> ConduitT ByteString Void m a
-  -> m (SHA256, FileSize, a)
-httpSinkChecked url msha msize sink = do
-    req <- liftIO $ parseUrlThrow $ T.unpack url
-    httpSink req $ const $ getZipSink $ (,,)
-      <$> ZipSink (checkSha msha)
-      <*> ZipSink (checkSize msize)
-      <*> ZipSink sink
-  where
-    checkSha mexpected = do
-      actual <- SHA256.sinkHash
-      for_ mexpected $ \expected -> unless (actual == expected) $
-        throwIO $ DownloadInvalidSHA256 url Mismatch
-          { mismatchExpected = expected
-          , mismatchActual = actual
-          }
-      pure actual
-    checkSize mexpected =
-      loop 0
-      where
-        loop accum = do
-          mbs <- await
-          case mbs of
-            Nothing ->
-              case mexpected of
-                Just (FileSize expected) | expected /= accum ->
-                  throwIO $ DownloadInvalidSize url Mismatch
-                    { mismatchExpected = FileSize expected
-                    , mismatchActual = FileSize accum
-                    }
-                _ -> pure (FileSize accum)
-            Just bs -> do
-              let accum' = accum + fromIntegral (B.length bs)
-              case mexpected of
-                Just (FileSize expected)
-                  | accum' > expected ->
-                    throwIO $ DownloadTooLarge url Mismatch
-                      { mismatchExpected = FileSize expected
-                      , mismatchActual = FileSize accum'
-                      }
-                _ -> loop accum'