pantry 0.9.1 → 0.9.2
raw patch · 5 files changed
+67/−46 lines, 5 filesdep +cryptondep +crypton-conduitdep −cryptonitedep −cryptonite-conduitdep ~casa-clientdep ~hpackdep ~http-client-tlsPVP ok
version bump matches the API change (PVP)
Dependencies added: crypton, crypton-conduit
Dependencies removed: cryptonite, cryptonite-conduit
Dependency ranges changed: casa-client, hpack, http-client-tls, http-download, tar-conduit
API changes (from Hackage documentation)
Files
- ChangeLog.md +8/−0
- int/Pantry/Types.hs +1/−1
- pantry.cabal +29/−29
- src/Pantry.hs +2/−2
- src/Pantry/Archive.hs +27/−14
ChangeLog.md view
@@ -1,5 +1,13 @@ # Changelog for pantry +## v0.9.2 + +* `defaultCasaRepoPrefix` references https://casa.stackage.org, instead of + https://casa.fpcomplete.com. +* Depend on `crypton` instead of `cryptonite`. +* Depend on `tar-conduit-0.4.0`, which will tolerate long filenames and + directory names in archives created by `git archive`. + ## v0.9.1 * Expose module `Pantry.SQLite`.
int/Pantry/Types.hs view
@@ -311,7 +311,7 @@ , pcConnectionCount :: !Int -- ^ concurrently open downloads , pcCasaConfig :: !(Maybe (CasaRepoPrefix, Int)) - -- ^ Optionally, the Casa pull URL e.g. @https://casa.fpcomplete.com@ and + -- ^ Optionally, the Casa pull URL e.g. @https://casa.stackage.org@ and -- the maximum number of Casa keys to pull per request. , pcSnapshotLocation :: SnapName -> RawSnapshotLocation -- ^ The location of snapshot synonyms
pantry.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: pantry -version: 0.9.1 +version: 0.9.2 synopsis: Content addressable Haskell package management description: Please see the README on GitHub at <https://github.com/commercialhaskell/pantry#readme> category: Development @@ -59,23 +59,23 @@ , ansi-terminal , base >=4.10 && <5 , bytestring - , casa-client + , casa-client >=0.0.2 , casa-types , companion , conduit , conduit-extra , containers - , cryptonite - , cryptonite-conduit + , crypton + , crypton-conduit , digest , filelock , generic-deriving , hackage-security - , hpack >=0.35.1 + , hpack >=0.35.3 , http-client - , http-client-tls + , http-client-tls >=0.3.6.2 , http-conduit - , http-download + , http-download >=0.2.1.0 , http-types , internal , memory @@ -92,7 +92,7 @@ , rio-orphans , rio-prettyprint , static-bytes - , tar-conduit + , tar-conduit >=0.4.0 , text , text-metrics , time @@ -138,23 +138,23 @@ , ansi-terminal , base >=4.10 && <5 , bytestring - , casa-client + , casa-client >=0.0.2 , casa-types , companion , conduit , conduit-extra , containers - , cryptonite - , cryptonite-conduit + , crypton + , crypton-conduit , digest , filelock , generic-deriving , hackage-security - , hpack >=0.35.1 + , hpack >=0.35.3 , http-client - , http-client-tls + , http-client-tls >=0.3.6.2 , http-conduit - , http-download + , http-download >=0.2.1.0 , http-types , memory , mtl @@ -170,7 +170,7 @@ , rio-orphans , rio-prettyprint , static-bytes - , tar-conduit + , tar-conduit >=0.4.0 , text , text-metrics , time @@ -202,23 +202,23 @@ , ansi-terminal , base >=4.10 && <5 , bytestring - , casa-client + , casa-client >=0.0.2 , casa-types , companion , conduit , conduit-extra , containers - , cryptonite - , cryptonite-conduit + , crypton + , crypton-conduit , digest , filelock , generic-deriving , hackage-security - , hpack >=0.35.1 + , hpack >=0.35.3 , http-client - , http-client-tls + , http-client-tls >=0.3.6.2 , http-conduit - , http-download + , http-download >=0.2.1.0 , http-types , memory , mtl @@ -236,7 +236,7 @@ , rio-orphans , rio-prettyprint , static-bytes - , tar-conduit + , tar-conduit >=0.4.0 , text , text-metrics , time @@ -299,26 +299,26 @@ , ansi-terminal , base >=4.10 && <5 , bytestring - , casa-client + , casa-client >=0.0.2 , casa-types , companion , conduit , conduit-extra , containers - , cryptonite - , cryptonite-conduit + , crypton + , crypton-conduit , digest , exceptions , filelock , generic-deriving , hackage-security , hedgehog - , hpack >=0.35.1 + , hpack >=0.35.3 , hspec , http-client - , http-client-tls + , http-client-tls >=0.3.6.2 , http-conduit - , http-download + , http-download >=0.2.1.0 , http-types , internal , memory @@ -337,7 +337,7 @@ , rio-orphans , rio-prettyprint , static-bytes - , tar-conduit + , tar-conduit >=0.4.0 , text , text-metrics , time
src/Pantry.hs view
@@ -282,7 +282,7 @@ -> Int -- ^ Maximum connection count -> CasaRepoPrefix - -- ^ The casa pull URL e.g. https://casa.fpcomplete.com/v1/pull. + -- ^ The casa pull URL e.g. https://casa.stackage.org/v1/pull. -> Int -- ^ Max casa keys to pull per request. -> (SnapName -> RawSnapshotLocation) @@ -344,7 +344,7 @@ -- -- @since 0.1.1.1 defaultCasaRepoPrefix :: CasaRepoPrefix -defaultCasaRepoPrefix = $(thParserCasaRepo "https://casa.fpcomplete.com") +defaultCasaRepoPrefix = $(thParserCasaRepo "https://casa.stackage.org") -- | Default max keys to pull per request. --
src/Pantry/Archive.hs view
@@ -288,7 +288,8 @@ withSourceFile fp $ \src -> runConduit $ src .| foldTar loc accum f foldArchive loc fp ATZip accum0 f = withBinaryFile fp ReadMode $ \h -> do let go accum entry = do - let me = MetaEntry (Zip.eRelativePath entry) met + let normalizedRelPath = removeInitialDotSlash $ Zip.eRelativePath entry + me = MetaEntry normalizedRelPath met met = fromMaybe METNormal $ do let modes = shiftR (Zip.eExternalFileAttributes entry) 16 guard $ Zip.eVersionMadeBy entry .&. 0xFF00 == 0x0300 @@ -345,7 +346,7 @@ _ -> throwIO exc pure $ (\met -> MetaEntry - { mePath = Tar.getFileInfoPath fi + { mePath = removeInitialDotSlash . Tar.getFileInfoPath $ fi , meType = met }) <$> mmet @@ -356,6 +357,10 @@ } deriving Show +removeInitialDotSlash :: FilePath -> FilePath +removeInitialDotSlash filename = + fromMaybe filename $ List.stripPrefix "./" filename + -- | Attempt to parse the contents of the given archive in the given subdir into -- a 'Tree'. This will not consult any caches. It will ensure that: -- @@ -365,22 +370,28 @@ -- -- * The name inside the cabal file matches the name of the cabal file itself parseArchive :: - (HasPantryConfig env, HasLogFunc env, HasProcessContext env) + forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => RawPackageLocationImmutable -> RawArchive -> FilePath -- ^ file holding the archive -> RIO env (Package, CachedTree) parseArchive rpli archive fp = do let loc = raLocation archive + archiveTypes :: [ArchiveType] + archiveTypes = [minBound .. maxBound] + getFiles :: [ArchiveType] -> RIO env (ArchiveType, Map FilePath MetaEntry) getFiles [] = throwIO $ UnknownArchiveType loc getFiles (at:ats) = do - eres <- tryAny $ foldArchive loc fp at id $ \m me -> pure $ m . (me:) + eres <- tryAny $ + -- foldArchive normalises filepaths in archives that begin with ./ + foldArchive loc fp at id $ \m me -> pure $ m . (me:) case eres of Left e -> do logDebug $ "parseArchive of " <> display at <> ": " <> displayShow e getFiles ats - Right files -> pure (at, Map.fromList $ map (mePath &&& id) $ files []) - (at :: ArchiveType, files :: Map FilePath MetaEntry) <- getFiles [minBound..maxBound] + Right files -> + pure (at, Map.fromList $ map (mePath &&& id) $ files []) + (at, files) <- getFiles archiveTypes let toSimple :: FilePath -> MetaEntry -> Either String (Map FilePath SimpleEntry) toSimple key me = case meType me of @@ -439,7 +450,8 @@ ++ "See https://github.com/commercialhaskell/stack/issues/4579 \ \for further information." pairs -> - fmap fold $ for pairs $ \(suffix, me') -> toSimple (key ++ '/' : suffix) me' + fmap fold $ for pairs $ \(suffix, me') -> + toSimple (key ++ '/' : suffix) me' Just me' -> case meType me' of METNormal -> @@ -466,7 +478,7 @@ Left e -> throwIO $ UnsupportedTarball loc $ T.pack e Right safeFiles -> do let toSave = Set.fromList $ map (seSource . snd) safeFiles - (blobs :: Map FilePath (BlobKey, BlobId)) <- + (blobs :: Map FilePath (BlobKey, BlobId)) <- foldArchive loc fp at mempty $ \m me -> if mePath me `Set.member` toSave then do @@ -474,12 +486,13 @@ (blobId, blobKey) <- lift $ withStorage $ storeBlob bs pure $ Map.insert (mePath me) (blobKey, blobId) m else pure m - tree :: CachedTree <- fmap (CachedTreeMap . Map.fromList) $ for safeFiles $ \(sfp, se) -> - case Map.lookup (seSource se) blobs of - Nothing -> - error $ "Impossible: blob not found for: " ++ seSource se - Just (blobKey, blobId) -> - pure (sfp, (TreeEntry blobKey (seType se), blobId)) + tree :: CachedTree <- + fmap (CachedTreeMap . Map.fromList) $ for safeFiles $ \(sfp, se) -> + case Map.lookup (removeInitialDotSlash . seSource $ se) blobs of + Nothing -> + error $ "Impossible: blob not found for: " ++ seSource se + Just (blobKey, blobId) -> + pure (sfp, (TreeEntry blobKey (seType se), blobId)) -- parse the cabal file and ensure it has the right name buildFile <- findCabalOrHpackFile rpli $ unCachedTree tree (buildFilePath, buildFileBlobKey, buildFileEntry) <- case buildFile of