cabal-install-3.2.0.0: Distribution/Client/PackageHash.hs
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-- | Functions to calculate nix-style hashes for package ids.
--
-- The basic idea is simple, hash the combination of:
--
-- * the package tarball
-- * the ids of all the direct dependencies
-- * other local configuration (flags, profiling, etc)
--
module Distribution.Client.PackageHash (
-- * Calculating package hashes
PackageHashInputs(..),
PackageHashConfigInputs(..),
PackageSourceHash,
hashedInstalledPackageId,
hashPackageHashInputs,
renderPackageHashInputs,
-- ** Platform-specific variations
hashedInstalledPackageIdLong,
hashedInstalledPackageIdShort,
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Package
( PackageId, PackageIdentifier(..), mkComponentId
, PkgconfigName )
import Distribution.System
( Platform, OS(Windows, OSX), buildOS )
import Distribution.PackageDescription
( FlagAssignment, unFlagAssignment, showFlagValue )
import Distribution.Simple.Compiler
( CompilerId, OptimisationLevel(..), DebugInfoLevel(..)
, ProfDetailLevel(..), showProfDetailLevel )
import Distribution.Simple.InstallDirs
( PathTemplate, fromPathTemplate )
import Distribution.Pretty (prettyShow)
import Distribution.Deprecated.Text
( display )
import Distribution.Types.PkgconfigVersion (PkgconfigVersion)
import Distribution.Client.HashValue
import Distribution.Client.Types
( InstalledPackageId )
import qualified Distribution.Solver.Types.ComponentDeps as CD
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Function (on)
-------------------------------
-- Calculating package hashes
--
-- | Calculate a 'InstalledPackageId' for a package using our nix-style
-- inputs hashing method.
--
-- Note that due to path length limitations on Windows, this function uses
-- a different method on Windows that produces shorted package ids.
-- See 'hashedInstalledPackageIdLong' vs 'hashedInstalledPackageIdShort'.
--
hashedInstalledPackageId :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
| buildOS == Windows = hashedInstalledPackageIdShort
| buildOS == OSX = hashedInstalledPackageIdVeryShort
| otherwise = hashedInstalledPackageIdLong
-- | Calculate a 'InstalledPackageId' for a package using our nix-style
-- inputs hashing method.
--
-- This produces large ids with big hashes. It is only suitable for systems
-- without significant path length limitations (ie not Windows).
--
hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
display pkgHashPkgId -- to be a bit user friendly
++ "-"
++ showHashValue (hashPackageHashInputs pkghashinputs)
-- | On Windows we have serious problems with path lengths. Windows imposes a
-- maximum path length of 260 chars, and even if we can use the windows long
-- path APIs ourselves, we cannot guarantee that ghc, gcc, ld, ar, etc etc all
-- do so too.
--
-- So our only choice is to limit the lengths of the paths, and the only real
-- way to do that is to limit the size of the 'InstalledPackageId's that we
-- generate. We do this by truncating the package names and versions and also
-- by truncating the hash sizes.
--
-- Truncating the package names and versions is technically ok because they are
-- just included for human convenience, the full source package id is included
-- in the hash.
--
-- Truncating the hash size is disappointing but also technically ok. We
-- rely on the hash primarily for collision avoidance not for any security
-- properties (at least for now).
--
hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
intercalate "-"
-- max length now 64
[ truncateStr 14 (display name)
, truncateStr 8 (display version)
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
]
where
PackageIdentifier name version = pkgHashPkgId
-- Truncate a string, with a visual indication that it is truncated.
truncateStr n s | length s <= n = s
| otherwise = take (n-1) s ++ "_"
-- | On macOS we shorten the name very aggressively. The mach-o linker on
-- macOS has a limited load command size, to which the name of the library
-- as well as its relative path (\@rpath) entry count. To circumvent this,
-- on macOS the libraries are not stored as
-- @store/<libraryname>/libHS<libraryname>.dylib@
-- where libraryname contains the libraries name, version and abi hash, but in
-- @store/lib/libHS<very short libraryname>.dylib@
-- where the very short library name drops all vowels from the package name,
-- and truncates the hash to 4 bytes.
--
-- We therefore we only need one \@rpath entry to @store/lib@ instead of one
-- \@rpath entry for each library. And the reduced library name saves some
-- additional space.
--
-- This however has two major drawbacks:
-- 1) Packages can collide more easily due to the shortened hash.
-- 2) The libraries are *not* prefix relocatable anymore as they all end up
-- in the same @store/lib@ folder.
--
-- The ultimate solution would have to include generating proxy dynamic
-- libraries on macOS, such that the proxy libraries and the linked libraries
-- stay under the load command limit, and the recursive linker is still able
-- to link all of them.
hashedInstalledPackageIdVeryShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
intercalate "-"
[ filter (not . flip elem "aeiou") (display name)
, display version
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
where
PackageIdentifier name version = pkgHashPkgId
-- | All the information that contribues to a package's hash, and thus its
-- 'InstalledPackageId'.
--
data PackageHashInputs = PackageHashInputs {
pkgHashPkgId :: PackageId,
pkgHashComponent :: Maybe CD.Component,
pkgHashSourceHash :: PackageSourceHash,
pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion),
pkgHashDirectDeps :: Set InstalledPackageId,
pkgHashOtherConfig :: PackageHashConfigInputs
}
type PackageSourceHash = HashValue
-- | Those parts of the package configuration that contribute to the
-- package hash.
--
data PackageHashConfigInputs = PackageHashConfigInputs {
pkgHashCompilerId :: CompilerId,
pkgHashPlatform :: Platform,
pkgHashFlagAssignment :: FlagAssignment, -- complete not partial
pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure
pkgHashVanillaLib :: Bool,
pkgHashSharedLib :: Bool,
pkgHashDynExe :: Bool,
pkgHashFullyStaticExe :: Bool,
pkgHashGHCiLib :: Bool,
pkgHashProfLib :: Bool,
pkgHashProfExe :: Bool,
pkgHashProfLibDetail :: ProfDetailLevel,
pkgHashProfExeDetail :: ProfDetailLevel,
pkgHashCoverage :: Bool,
pkgHashOptimization :: OptimisationLevel,
pkgHashSplitObjs :: Bool,
pkgHashSplitSections :: Bool,
pkgHashStripLibs :: Bool,
pkgHashStripExes :: Bool,
pkgHashDebugInfo :: DebugInfoLevel,
pkgHashProgramArgs :: Map String [String],
pkgHashExtraLibDirs :: [FilePath],
pkgHashExtraFrameworkDirs :: [FilePath],
pkgHashExtraIncludeDirs :: [FilePath],
pkgHashProgPrefix :: Maybe PathTemplate,
pkgHashProgSuffix :: Maybe PathTemplate,
-- Haddock options
pkgHashDocumentation :: Bool,
pkgHashHaddockHoogle :: Bool,
pkgHashHaddockHtml :: Bool,
pkgHashHaddockHtmlLocation :: Maybe String,
pkgHashHaddockForeignLibs :: Bool,
pkgHashHaddockExecutables :: Bool,
pkgHashHaddockTestSuites :: Bool,
pkgHashHaddockBenchmarks :: Bool,
pkgHashHaddockInternal :: Bool,
pkgHashHaddockCss :: Maybe FilePath,
pkgHashHaddockLinkedSource :: Bool,
pkgHashHaddockQuickJump :: Bool,
pkgHashHaddockContents :: Maybe PathTemplate
-- TODO: [required eventually] pkgHashToolsVersions ?
-- TODO: [required eventually] pkgHashToolsExtraOptions ?
}
deriving Show
-- | Calculate the overall hash to be used for an 'InstalledPackageId'.
--
hashPackageHashInputs :: PackageHashInputs -> HashValue
hashPackageHashInputs = hashValue . renderPackageHashInputs
-- | Render a textual representation of the 'PackageHashInputs'.
--
-- The 'hashValue' of this text is the overall package hash.
--
renderPackageHashInputs :: PackageHashInputs -> LBS.ByteString
renderPackageHashInputs PackageHashInputs{
pkgHashPkgId,
pkgHashComponent,
pkgHashSourceHash,
pkgHashDirectDeps,
pkgHashPkgConfigDeps,
pkgHashOtherConfig =
PackageHashConfigInputs{..}
} =
-- The purpose of this somewhat laboured rendering (e.g. why not just
-- use show?) is so that existing package hashes do not change
-- unnecessarily when new configuration inputs are added into the hash.
-- In particular, the assumption is that when a new configuration input
-- is included into the hash, that existing packages will typically get
-- the default value for that feature. So if we avoid adding entries with
-- the default value then most of the time adding new features will not
-- change the hashes of existing packages and so fewer packages will need
-- to be rebuilt.
--TODO: [nice to have] ultimately we probably want to put this config info
-- into the ghc-pkg db. At that point this should probably be changed to
-- use the config file infrastructure so it can be read back in again.
LBS.pack $ unlines $ catMaybes $
[ entry "pkgid" display pkgHashPkgId
, mentry "component" show pkgHashComponent
, entry "src" showHashValue pkgHashSourceHash
, entry "pkg-config-deps"
(intercalate ", " . map (\(pn, mb_v) -> display pn ++
case mb_v of
Nothing -> ""
Just v -> " " ++ prettyShow v)
. Set.toList) pkgHashPkgConfigDeps
, entry "deps" (intercalate ", " . map display
. Set.toList) pkgHashDirectDeps
-- and then all the config
, entry "compilerid" display pkgHashCompilerId
, entry "platform" display pkgHashPlatform
, opt "flags" mempty showFlagAssignment pkgHashFlagAssignment
, opt "configure-script" [] unwords pkgHashConfigureScriptArgs
, opt "vanilla-lib" True display pkgHashVanillaLib
, opt "shared-lib" False display pkgHashSharedLib
, opt "dynamic-exe" False display pkgHashDynExe
, opt "fully-static-exe" False display pkgHashFullyStaticExe
, opt "ghci-lib" False display pkgHashGHCiLib
, opt "prof-lib" False display pkgHashProfLib
, opt "prof-exe" False display pkgHashProfExe
, opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail
, opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail
, opt "hpc" False display pkgHashCoverage
, opt "optimisation" NormalOptimisation (show . fromEnum) pkgHashOptimization
, opt "split-objs" False display pkgHashSplitObjs
, opt "split-sections" False display pkgHashSplitSections
, opt "stripped-lib" False display pkgHashStripLibs
, opt "stripped-exe" True display pkgHashStripExes
, opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo
, opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs
, opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs
, opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs
, opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix
, opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix
, opt "documentation" False display pkgHashDocumentation
, opt "haddock-hoogle" False display pkgHashHaddockHoogle
, opt "haddock-html" False display pkgHashHaddockHtml
, opt "haddock-html-location" Nothing (fromMaybe "") pkgHashHaddockHtmlLocation
, opt "haddock-foreign-libraries" False display pkgHashHaddockForeignLibs
, opt "haddock-executables" False display pkgHashHaddockExecutables
, opt "haddock-tests" False display pkgHashHaddockTestSuites
, opt "haddock-benchmarks" False display pkgHashHaddockBenchmarks
, opt "haddock-internal" False display pkgHashHaddockInternal
, opt "haddock-css" Nothing (fromMaybe "") pkgHashHaddockCss
, opt "haddock-hyperlink-source" False display pkgHashHaddockLinkedSource
, opt "haddock-quickjump" False display pkgHashHaddockQuickJump
, opt "haddock-contents-location" Nothing (maybe "" fromPathTemplate) pkgHashHaddockContents
] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs
where
entry key format value = Just (key ++ ": " ++ format value)
mentry key format value = fmap (\v -> key ++ ": " ++ format v) value
opt key def format value
| value == def = Nothing
| otherwise = entry key format value
showFlagAssignment = unwords . map showFlagValue . sortBy (compare `on` fst) . unFlagAssignment