From 7e65c4f653e9066204d83d53acf6ffdb0ee5730a Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 14 Jul 2021 15:10:30 +0200 Subject: [PATCH] Support custom GHC installation hooks --- ChangeLog.md | 1 + doc/yaml_configuration.md | 59 +++++++++++++ src/Stack/Setup.hs | 84 ++++++++++++++++--- src/Stack/Types/Config.hs | 14 ++++ .../tests/ghc-install-hooks/Main.hs | 7 ++ .../tests/ghc-install-hooks/files/.gitignore | 1 + .../tests/ghc-install-hooks/files/foo.hs | 1 + .../tests/ghc-install-hooks/files/run.sh | 15 ++++ 8 files changed, 172 insertions(+), 10 deletions(-) create mode 100644 test/integration/tests/ghc-install-hooks/Main.hs create mode 100644 test/integration/tests/ghc-install-hooks/files/.gitignore create mode 100644 test/integration/tests/ghc-install-hooks/files/foo.hs create mode 100755 test/integration/tests/ghc-install-hooks/files/run.sh diff --git a/ChangeLog.md b/ChangeLog.md index be245da5aa..70d74c45c0 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -18,6 +18,7 @@ Other enhancements: * `stack upgrade` makes less assumptions about archive format. See [#5288](https://github.com/commercialhaskell/stack/issues/5288) * Add a `--no-run` flag to the `script` command when compiling. +* Add GHC installation hooks Bug fixes: diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md index 898f5c777d..850a9e075c 100644 --- a/doc/yaml_configuration.md +++ b/doc/yaml_configuration.md @@ -1200,3 +1200,62 @@ This field is convenient in setups that restrict access to GitHub, for instance Since 2.5.0 + +## Hooks + +### GHC installation hooks (experimental) + +Stack's installation procedure can be fully customized by placing a shell script at +`~/.stack/hooks/ghc-install.sh` and making it executable. + +The script **must** return an exit code of `0` and the standard output **must** be the +absolute path to the ghc binary that was installed. Otherwise stack will ignore +the hook and possibly fall back to its own installation procedure. + +Hooks are not run when `system-ghc: true`. This is compatible with `install-ghc: false`, +which allows you to ensure that only your hook will install a GHC version. + +An example hook is: + +```sh +#!/bin/sh + +set -eu + +case $HOOK_GHC_TYPE in + bindist) + # install GHC here, not printing to stdout, e.g.: + # command >/dev/null + ;; + git) + >&2 echo "Hook doesn't support installing from source" + exit 1 + ;; + *) + >&2 echo "Unsupported GHC installation type: $HOOK_GHC_TYPE" + exit 2 + ;; +esac + +echo "location/to/ghc/executable" +``` + +The following environment variables are always passed to the hook: + +* `HOOK_GHC_TYPE = "bindist" | "git" | "ghcjs"` + +For "bindist", additional variables are: + +* `HOOK_GHC_VERSION = ` + +For "git", additional variables are: + +* `HOOK_GHC_COMMIT = ` +* `HOOK_GHC_FLAVOR = ` + +For "ghcjs", additional variables are: + +* `HOOK_GHC_VERSION = ` +* `HOOK_GHCJS_VERSION = ` + +Since 2.8.X diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index c728879cb3..b8f1d90fde 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -46,7 +46,9 @@ import Data.List hiding (concat, elem, maximumBy, any) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Text.Encoding.Error as T import qualified Data.Yaml as Yaml import Distribution.System (OS, Arch (..), Platform (..)) @@ -89,7 +91,7 @@ import Stack.Types.Docker import Stack.Types.SourceMap import Stack.Types.Version import qualified System.Directory as D -import System.Environment (getExecutablePath, lookupEnv) +import System.Environment (getExecutablePath, lookupEnv, getEnvironment) import System.IO.Error (isPermissionError) import System.FilePath (searchPathSeparator) import qualified System.FilePath as FP @@ -596,13 +598,16 @@ installGhcBindist sopts getSetupInfo' installed = do -- | Ensure compiler is installed, without worrying about msys ensureCompiler - :: forall env. (HasBuildConfig env, HasGHCVariant env) + :: forall env. (HasConfig env, HasBuildConfig env, HasGHCVariant env) => SetupOpts -> Memoized SetupInfo -> RIO env (CompilerPaths, ExtraDirs) ensureCompiler sopts getSetupInfo' = do let wanted = soptsWantedCompiler sopts wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted + + hook <- ghcInstallHook + hookIsExecutable <- handleIO (\_ -> pure False) $ executable <$> getPermissions hook Platform expectedArch _ <- view platformL @@ -623,20 +628,79 @@ ensureCompiler sopts getSetupInfo' = do Right cp -> pure $ Just cp mcp <- - if soptsUseSystem sopts - then do - logDebug "Getting system compiler version" - runConduit $ - sourceSystemCompilers wanted .| - concatMapMC checkCompiler .| - await - else return Nothing + if | soptsUseSystem sopts -> do + logDebug "Getting system compiler version" + runConduit $ + sourceSystemCompilers wanted .| + concatMapMC checkCompiler .| + await + | hookIsExecutable -> do + -- if the hook fails, we fall through to stacks sandboxed installation + logDebug "Getting hook installed compiler version" + hookGHC <- runGHCInstallHook sopts hook + maybe (pure Nothing) checkCompiler hookGHC + | otherwise -> return Nothing case mcp of Nothing -> ensureSandboxedCompiler sopts getSetupInfo' Just cp -> do let paths = ExtraDirs { edBins = [parent $ cpCompiler cp], edInclude = [], edLib = [] } pure (cp, paths) + +-- | Runs @STACK_ROOT\/hooks\/ghc-install.sh@. +-- +-- Reads and possibly validates the output of the process as the GHC +-- binary and returns it. +runGHCInstallHook + :: HasBuildConfig env + => SetupOpts + -> Path Abs File + -> RIO env (Maybe (Path Abs File)) +runGHCInstallHook sopts hook = do + logDebug "Getting hook installed compiler version" + let wanted = soptsWantedCompiler sopts + curEnv <- Map.fromList . map (T.pack *** T.pack) <$> liftIO getEnvironment + let newEnv = Map.union (wantedCompilerToEnv wanted) curEnv + pCtx <- mkProcessContext newEnv + (exit, out) <- withProcessContext pCtx $ proc "sh" [toFilePath hook] readProcessStdout + case exit of + ExitSuccess -> do + let ghcPath = stripNewline . TL.unpack . TL.decodeUtf8With T.lenientDecode $ out + case parseAbsFile ghcPath of + Just compiler -> do + when (soptsSanityCheck sopts) $ sanityCheck compiler + logDebug ("Using GHC compiler at: " <> fromString (toFilePath compiler)) + pure (Just compiler) + Nothing -> do + logWarn ("Path to GHC binary is not a valid path: " <> fromString ghcPath) + pure Nothing + ExitFailure i -> do + logDebug ("GHC install hook exited with code: " <> fromString (show i)) + pure Nothing + where + wantedCompilerToEnv :: WantedCompiler -> EnvVars + wantedCompilerToEnv (WCGhc ver) = + Map.fromList [("HOOK_GHC_TYPE", "bindist") + ,("HOOK_GHC_VERSION", T.pack (versionString ver)) + ] + wantedCompilerToEnv (WCGhcGit commit flavor) = + Map.fromList [("HOOK_GHC_TYPE", "git") + ,("HOOK_GHC_COMMIT", commit) + ,("HOOK_GHC_FLAVOR", flavor) + ,("HOOK_GHC_FLAVOUR", flavor) + ] + wantedCompilerToEnv (WCGhcjs ghcjs_ver ghc_ver) = + Map.fromList [("HOOK_GHC_TYPE", "ghcjs") + ,("HOOK_GHC_VERSION", T.pack (versionString ghc_ver)) + ,("HOOK_GHCJS_VERSION", T.pack (versionString ghcjs_ver)) + ] + newlines :: [Char] + newlines = ['\n', '\r'] + + stripNewline :: String -> String + stripNewline str = filter (flip notElem newlines) str + + ensureSandboxedCompiler :: HasBuildConfig env => SetupOpts diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index bd5a2828ae..44a392944f 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -10,6 +10,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -127,6 +128,7 @@ module Stack.Types.Config ,shaPath ,shaPathForBytes ,workDirL + ,ghcInstallHook -- * Command-specific types -- ** Eval ,EvalOpts(..) @@ -1302,6 +1304,18 @@ askLatestSnapshotUrl = view $ configL.to configLatestSnapshot workDirL :: HasConfig env => Lens' env (Path Rel Dir) workDirL = configL.lens configWorkDir (\x y -> x { configWorkDir = y }) +-- | @STACK_ROOT\/hooks\/@ +hooksDir :: HasConfig env => RIO env (Path Abs Dir) +hooksDir = do + sr <- view $ configL.to configStackRoot + pure (sr [reldir|hooks|]) + +-- | @STACK_ROOT\/hooks\/ghc-install.sh@ +ghcInstallHook :: HasConfig env => RIO env (Path Abs File) +ghcInstallHook = do + hd <- hooksDir + pure (hd [relfile|ghc-install.sh|]) + -- | Per-project work dir getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir) getProjectWorkDir = do diff --git a/test/integration/tests/ghc-install-hooks/Main.hs b/test/integration/tests/ghc-install-hooks/Main.hs new file mode 100644 index 0000000000..271c259449 --- /dev/null +++ b/test/integration/tests/ghc-install-hooks/Main.hs @@ -0,0 +1,7 @@ +import System.Process (rawSystem) +import Control.Exception (throwIO) +import StackTest +import Control.Monad (unless) + +main :: IO () +main = unless isWindows $ rawSystem "bash" ["run.sh"] >>= throwIO diff --git a/test/integration/tests/ghc-install-hooks/files/.gitignore b/test/integration/tests/ghc-install-hooks/files/.gitignore new file mode 100644 index 0000000000..17906d378e --- /dev/null +++ b/test/integration/tests/ghc-install-hooks/files/.gitignore @@ -0,0 +1 @@ +/fake-root/ diff --git a/test/integration/tests/ghc-install-hooks/files/foo.hs b/test/integration/tests/ghc-install-hooks/files/foo.hs new file mode 100644 index 0000000000..623c600c18 --- /dev/null +++ b/test/integration/tests/ghc-install-hooks/files/foo.hs @@ -0,0 +1 @@ +main = putStrLn "Looks like everything is working!" diff --git a/test/integration/tests/ghc-install-hooks/files/run.sh b/test/integration/tests/ghc-install-hooks/files/run.sh new file mode 100755 index 0000000000..a27bee9420 --- /dev/null +++ b/test/integration/tests/ghc-install-hooks/files/run.sh @@ -0,0 +1,15 @@ +#!/usr/bin/env bash + +set -exuo pipefail + +stack_bin=$("$STACK_EXE" path --resolver ghc-8.6.5 --compiler-bin) + +export STACK_ROOT=$(pwd)/fake-root + +mkdir -p "${STACK_ROOT}"/hooks + +echo "echo ${stack_bin}/ghc" > "${STACK_ROOT}"/hooks/ghc-install.sh +chmod +x "${STACK_ROOT}"/hooks/ghc-install.sh + +"$STACK_EXE" --no-install-ghc --resolver ghc-8.6.5 ghc -- --info +"$STACK_EXE" --no-install-ghc --resolver ghc-8.6.5 runghc foo.hs