From 39b98f330ae46b4b147807c1d84e7655f96f78b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?F=C3=A9lix=20Baylac-Jacqu=C3=A9?= Date: Mon, 25 May 2020 13:19:21 +0200 Subject: [PATCH] Add Haskell script trying to reproduce the build We add a Haskell script in charge of reproducing the build. --- ReproTest.hs | 112 +++++++++++++++++++++++++++++++++++++++++++ default.nix | 11 +---- examples/ghc-src.nix | 7 +++ repro.nix | 14 ++++++ 4 files changed, 135 insertions(+), 9 deletions(-) create mode 100755 ReproTest.hs create mode 100644 examples/ghc-src.nix create mode 100644 repro.nix diff --git a/ReproTest.hs b/ReproTest.hs new file mode 100755 index 0000000..26c4b90 --- /dev/null +++ b/ReproTest.hs @@ -0,0 +1,112 @@ +#!/usr/bin/env nix-shell +#!nix-shell -i runhaskell -p "haskellPackages.ghcWithPackages(p: with p; [ relude optparse-applicative process ])" -p nix -p diffoscope +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +import Relude + +import Data.Maybe +import GHC.IO.Handle +import Control.Monad.Except +import Control.DeepSeq +import Options.Applicative +import Data.Text hiding (foldl') +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified System.Exit as E +import System.Process + + +data Config = Config + { pkgName :: Text, + ghcPath :: Text, + diffOutDir :: Text, + nbRepro :: Int + } +data ReproStatus = ReproStatus IsReproducible ReproPaths + +type IsReproducible = Bool +type ReproPaths = [Text] +type StorePath = Text +type NixError = Text + +main :: IO () +main = do + c <- execParser opts + rs <- runExceptT $ repro c + case rs of + Left err -> T.putStrLn err >> exitFailure + Right (ReproStatus True xs) -> T.putStrLn "The build seems to be reproducible" >> exitSuccess + Right (ReproStatus False xs) -> do + runDiffoscope c xs + T.putStrLn $ "Cannot Reproduce build.\n" <> unwords xs + T.putStrLn $ "See diffoscope report for more details: " <> diffOutDir c + where + opts = info (configParser <**> helper) + ( fullDesc + <> header "ReproTest.hs - Test the GHC binary reproducibility for a hackage package" + ) + +configParser :: Parser Config +configParser = Config + <$> strOption (long "package-name" <> short 'p' <> help "Hackage package to test.") + <*> strOption (long "ghc-nixexpr-path" <> short 'e' <> help "Path to the nix derivation retrieving the custom GHC checkpout you want to use.") + <*> strOption (long "report-dir" <> short 'o' <> help "Directory in which you want to store the diff output in case of a failing test." <> showDefault <> value "./diff-out") + <*> option auto (long "nb-repro" <> short 'n' <> help "How much reproduction iterations we want to perform." <> showDefault <> value 3) + +repro :: (MonadIO m) => Config -> ExceptT NixError m ReproStatus +repro c = do + -- 1. Nix instantiate derivation + (eci, drvPath) <- streamRunCmd "nix-instantiate" + [ + "--arg", "hs-pkg-name", "\"" <> pkgName c <> "\"", + "--arg", "ghcSrcDrv", ghcPath c, + "./repro.nix" + ] True + -- 2. nix-store --realize /nix/store/xxx.drv + (_, p1) <- streamRunCmd "nix-store" + ["--realise", "--quiet", drvPath] True + -- 3. nix-store --realize --check /nix/store/xxx.drv + (ecr2, p2) <- repeatRepro c drvPath + -- 4. If exit code > 1 => Just two repro paths + pure $ ReproStatus (ecr2 == E.ExitSuccess) [p1, p2] + +repeatRepro :: (MonadIO m) => Config -> Text -> ExceptT NixError m (E.ExitCode, StorePath) +repeatRepro c drv = go $ nbRepro c + where + go (!i) = do + (ecr2, p2) <- streamRunCmd "nix-store" + ["--realise", "--quiet", "-K", "--check", drv] False + if ecr2 /= E.ExitSuccess || i < 1 + then pure (ecr2, p2) + else go $ i - 1 + +runDiffoscope :: Config -> ReproPaths -> IO () +runDiffoscope c rp = callProcess "diffoscope" + $ unpack <$> [ "--html-dir", diffOutDir c ] <> rp + +-- Partially vendored from Shask +-- TODO: +-- - Handle custom Exp stacks in Shask. +-- - Determine whether the out parsing should be part of the Shask API or not. +-- - Release Shask. +streamRunCmd :: (MonadIO m) => Text -> [Text] -> Bool -> ExceptT NixError m (E.ExitCode, StorePath) +streamRunCmd cmd args fail = do + liftIO . T.putStr $ "[+] " <> cmd <> " " <> unwords args <> "\n\n" + (ec, out) <- liftIO $ withCreateProcess p progressFn + when (ec /= E.ExitSuccess && fail) . throwError $ "Failed to run " <> cmd <> " " <> unwords args + liftIO $ T.putStr $ " " <> "DONE\n\n" + return (force ec, force . T.filter (/= '\n') $ out) + where + p = (proc (unpack cmd) (unpack <$> args)) { std_out = CreatePipe, std_err = CreatePipe } + progressFn _ (Just hout) (Just herr) ph = go + where + go = do + eof <- hIsEOF herr + unless eof $ T.hGetLine herr >>= T.putStrLn + mec <- getProcessExitCode ph + case mec of + (Just ec) -> T.hGetContents hout >>= \out -> pure (ec, out) + Nothing -> go + progressFn _ _ _ ph = error "Cannot open subprocess IO handles" diff --git a/default.nix b/default.nix index 7928b94..9c45e67 100644 --- a/default.nix +++ b/default.nix @@ -2,12 +2,5 @@ hs-pkg-name ? "wcwidth", ghcSrc ? /home/ninjatrappeur/Code/perso/haskell/ghc }: -let - ghcOverlay = - import ./overlays/ghc.nix { - inherit ghcSrc pkgs; - }; - nixpkgsConfig = { overlays = [ ghcOverlay ]; }; - nixpkgsSrc = (import ./nix/sources.nix).nixpkgs; - pkgs = import nixpkgsSrc nixpkgsConfig; -in pkgs.customGhcHEAD."${hs-pkg-name}" + +import ./repro.nix { inherit hs-pkg-name ghcSrc; } diff --git a/examples/ghc-src.nix b/examples/ghc-src.nix new file mode 100644 index 0000000..c1ab8f8 --- /dev/null +++ b/examples/ghc-src.nix @@ -0,0 +1,7 @@ +let + pkgs = import (import ../nix/sources.nix).nixpkgs {}; +in pkgs.fetchgit { + url = "https://gitlab.haskell.org/ghc/ghc.git/"; + rev = "40c71c2cf38b4e134d81b7184a4d5e02949ae70c"; + sha256 = "04h9rcyzm9w3an1z00hjs062dp7dl19b8pkyxjsypr7a2i9dmvkb"; +} diff --git a/repro.nix b/repro.nix new file mode 100644 index 0000000..70218ac --- /dev/null +++ b/repro.nix @@ -0,0 +1,14 @@ +{ + hs-pkg-name ? "wcwidth", + ghcSrcDrv ? ./examples/ghc.nix +}: +let + ghcSrc = import ghcSrcDrv; + ghcOverlay = + import ./overlays/ghc.nix { + inherit ghcSrc pkgs; + }; + nixpkgsConfig = { overlays = [ ghcOverlay ]; }; + nixpkgsSrc = (import ./nix/sources.nix).nixpkgs; + pkgs = import nixpkgsSrc nixpkgsConfig; +in pkgs.haskellPackages."${hs-pkg-name}"