{-# 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//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") (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