From b94131cf61deb23ab761c4f1835418e66a0c1354 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 10 Jul 2026 20:09:54 +0100 Subject: [PATCH 1/2] hackageIndexLayout: speed up computation of PackageIdentifier `hackageIndexLayout` runs `fromPath` in a hot loop, for every file in the Hackage 01-index.tar. However, `fromPath` is rather wasteful when parsing `PackageIdentifier`: it concatenates together package name and version and asks `Cabal-syntax` to parse. This is very backwards, because `PackageIdentifier` is exactly a record with two fields: package name and its version. We already have the name at hand, there is no need to parse it again, and the version can be parsed more efficiently without resorting to `parsec`. This performance optimization was earlier attested in the `hackage-revdeps` package. --- .../src/Hackage/Security/TUF/Layout/Index.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs b/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs index be04b738..5508e0fe 100644 --- a/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs +++ b/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs @@ -10,9 +10,11 @@ module Hackage.Security.TUF.Layout.Index ( ) where import Prelude +import Data.Char (ord) import Data.Kind (Type) import Distribution.Package import Distribution.Text +import Distribution.Types.Version (mkVersion) import Hackage.Security.TUF.Paths import Hackage.Security.TUF.Signed @@ -94,7 +96,9 @@ hackageIndexLayout = IndexLayout { fromPath :: IndexPath -> Maybe (Some IndexFile) fromPath fp = case splitFragments (unrootPath fp) of [pkg, version, _file] -> do - pkgId <- simpleParse (pkg ++ "-" ++ version) + let pkgName = mkPackageName pkg + pkgVersion = mkVersion $ readVersion version + pkgId = PackageIdentifier { pkgName, pkgVersion } case takeExtension fp of ".cabal" -> return $ Some $ IndexPkgCabal pkgId ".json" -> return $ Some $ IndexPkgMetadata pkgId @@ -103,6 +107,17 @@ hackageIndexLayout = IndexLayout { Some . IndexPkgPrefs <$> simpleParse pkg _otherwise -> Nothing +-- Convert "3.12.1.0" to [3,12,1,0]. +-- Copied from hackage-revdeps package. +readVersion :: String -> [Int] +readVersion = (\(acc, _mult, rest) -> acc : rest) . foldr go (0, 1, []) + where + go c (acc, mult, rest) + | fromIntegral d < (10 :: Word) = (acc + d * mult, mult * 10, rest) + | otherwise = (0, 1, acc : rest) + where + d = ord c - ord '0' + {------------------------------------------------------------------------------- Utility -------------------------------------------------------------------------------} From 2570117b9127e03c45590633bf5cd76c48285e19 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 10 Jul 2026 20:16:15 +0100 Subject: [PATCH 2/2] hackageIndexLayout: speed up splitting path into components `hackageIndexLayout` runs `fromPath` in a hot loop, for every file in the Hackage 01-index.tar. However, `fromPath` is rather wasteful: it uses `splitFragments` (and underlying `System.FilePath.splitDirectories`) to explode `base/4.22.0.0/base.cabal` into `["base", "4.22.0.0", "base.cabal"]`. One could have expected that `splitDirectories` simply splits filepath by '/', but this is not the case. It's a general function, which does a lot of transformations such as checking for absolute paths, splitting drive letter, first retaining '/', then stripping them, etc. The patch replaces `splitDirectories` with a rather specialized operations, aiming to avoid traversing the same characters twice. It was previously attested in the `hackage-revdeps` package that this microptimization brings measurable performance benefits. --- .../src/Hackage/Security/TUF/Layout/Index.hs | 33 ++++++++++++------- 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs b/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs index 5508e0fe..6b3a5a4e 100644 --- a/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs +++ b/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs @@ -15,6 +15,7 @@ import Data.Kind (Type) import Distribution.Package import Distribution.Text import Distribution.Types.Version (mkVersion) +import System.FilePath.Posix (isPathSeparator) import Hackage.Security.TUF.Paths import Hackage.Security.TUF.Signed @@ -93,19 +94,27 @@ hackageIndexLayout = IndexLayout { fromFragments :: [String] -> IndexPath fromFragments = rootPath . joinFragments + -- This function is called in a hot loop, take care when modifying it. + -- Especially avoid 'splitFragments' / 'splitDirectories' and other high-level helpers, + -- they are very slow. fromPath :: IndexPath -> Maybe (Some IndexFile) - fromPath fp = case splitFragments (unrootPath fp) of - [pkg, version, _file] -> do - let pkgName = mkPackageName pkg - pkgVersion = mkVersion $ readVersion version - pkgId = PackageIdentifier { pkgName, pkgVersion } - case takeExtension fp of - ".cabal" -> return $ Some $ IndexPkgCabal pkgId - ".json" -> return $ Some $ IndexPkgMetadata pkgId - _otherwise -> Nothing - [pkg, "preferred-versions"] -> - Some . IndexPkgPrefs <$> simpleParse pkg - _otherwise -> Nothing + fromPath fp = case break isPathSeparator (toUnrootedFilePath (unrootPath fp)) of + (pkg, "/preferred-versions") -> + return $ Some $ IndexPkgPrefs $ mkPackageName pkg + (pkg, rest) -> case break isPathSeparator (drop 1 rest) of + (_, []) -> Nothing + (version, basename) -> do + let pkgName = mkPackageName pkg + pkgVersion = mkVersion $ readVersion version + pkgId = PackageIdentifier { pkgName, pkgVersion } + case reverse basename of + -- ".cabal" reversed + 'l' : 'a' : 'b' : 'a' : 'c' : '.' : _ -> + return $ Some $ IndexPkgCabal pkgId + -- ".json" reversed + 'n' : 'o' : 's' : 'j' : '.' : _ -> + return $ Some $ IndexPkgMetadata pkgId + _ -> Nothing -- Convert "3.12.1.0" to [3,12,1,0]. -- Copied from hackage-revdeps package.