{-# 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.Types.Flag ( FlagAssignment, showFlagAssignment ) import Distribution.Simple.Compiler ( CompilerId, OptimisationLevel(..), DebugInfoLevel(..) , ProfDetailLevel(..), showProfDetailLevel ) import Distribution.Simple.InstallDirs ( PathTemplate, fromPathTemplate ) 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 ------------------------------- -- 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,pkgHashComponent} = mkComponentId $ prettyShow pkgHashPkgId -- to be a bit user friendly ++ maybe "" displayComponent pkgHashComponent ++ "-" ++ showHashValue (hashPackageHashInputs pkghashinputs) where displayComponent :: CD.Component -> String displayComponent CD.ComponentLib = "" displayComponent (CD.ComponentSubLib s) = "-l-" ++ prettyShow s displayComponent (CD.ComponentFLib s) = "-f-" ++ prettyShow s displayComponent (CD.ComponentExe s) = "-e-" ++ prettyShow s displayComponent (CD.ComponentTest s) = "-t-" ++ prettyShow s displayComponent (CD.ComponentBench s) = "-b-" ++ prettyShow s displayComponent CD.ComponentSetup = "-setup" -- | 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 (prettyShow name) , truncateStr 8 (prettyShow 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//libHS.dylib@ -- where libraryname contains the libraries name, version and abi hash, but in -- @store/lib/libHS.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") (prettyShow name) , prettyShow 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" prettyShow pkgHashPkgId , mentry "component" show pkgHashComponent , entry "src" showHashValue pkgHashSourceHash , entry "pkg-config-deps" (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ case mb_v of Nothing -> "" Just v -> " " ++ prettyShow v) . Set.toList) pkgHashPkgConfigDeps , entry "deps" (intercalate ", " . map prettyShow . Set.toList) pkgHashDirectDeps -- and then all the config , entry "compilerid" prettyShow pkgHashCompilerId , entry "platform" prettyShow pkgHashPlatform , opt "flags" mempty showFlagAssignment pkgHashFlagAssignment , opt "configure-script" [] unwords pkgHashConfigureScriptArgs , opt "vanilla-lib" True prettyShow pkgHashVanillaLib , opt "shared-lib" False prettyShow pkgHashSharedLib , opt "dynamic-exe" False prettyShow pkgHashDynExe , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe , opt "ghci-lib" False prettyShow pkgHashGHCiLib , opt "prof-lib" False prettyShow pkgHashProfLib , opt "prof-exe" False prettyShow pkgHashProfExe , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail , opt "hpc" False prettyShow pkgHashCoverage , opt "optimisation" NormalOptimisation (show . fromEnum) pkgHashOptimization , opt "split-objs" False prettyShow pkgHashSplitObjs , opt "split-sections" False prettyShow pkgHashSplitSections , opt "stripped-lib" False prettyShow pkgHashStripLibs , opt "stripped-exe" True prettyShow 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 prettyShow pkgHashDocumentation , opt "haddock-hoogle" False prettyShow pkgHashHaddockHoogle , opt "haddock-html" False prettyShow pkgHashHaddockHtml , opt "haddock-html-location" Nothing (fromMaybe "") pkgHashHaddockHtmlLocation , opt "haddock-foreign-libraries" False prettyShow pkgHashHaddockForeignLibs , opt "haddock-executables" False prettyShow pkgHashHaddockExecutables , opt "haddock-tests" False prettyShow pkgHashHaddockTestSuites , opt "haddock-benchmarks" False prettyShow pkgHashHaddockBenchmarks , opt "haddock-internal" False prettyShow pkgHashHaddockInternal , opt "haddock-css" Nothing (fromMaybe "") pkgHashHaddockCss , opt "haddock-hyperlink-source" False prettyShow pkgHashHaddockLinkedSource , opt "haddock-quickjump" False prettyShow 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