bake dependency references into executable

instead of relying on, for example, hub being on the PATH, use a specific version from the build environment. closes #217
2024-08-17 18:10:38 +03:00 · 2020-07-20 21:09:21 -07:00 · 2020-07-20 21:09:21 -07:00 · b52b9a0f3c
commit b52b9a0f3c
parent c731768f9d
8 changed files with 114 additions and 78 deletions
--- a/flake.nix
+++ b/flake.nix
@ -29,18 +29,15 @@
          root = self;
          overrides = self: super: { };
          source-overrides = { };
-        }).overrideAttrs (attrs: {
-          propagatedBuildInputs = with pkgs; [
-            nix
-            git
-            getent
-            gitAndTools.hub
-            jq
-            tree
-            gist
-            (import nixpkgs-review { inherit pkgs; })
-            cabal-install # just for develpoment
-          ];
+        }).overrideAttrs (attrs: with pkgs; {
+          # TODO: lock down coreutils paths too
+          NIX = nix;
+          GIT = git;
+          HUB = gitAndTools.hub;
+          JQ = jq;
+          TREE = tree;
+          GIST = gist;
+          NIXPKGSREVIEW = (import nixpkgs-review { inherit pkgs; });
        });
    in
    {
--- a/nixpkgs-update.cabal
+++ b/nixpkgs-update.cabal
@ -4,7 +4,7 @@ cabal-version: 2.2
 --
 -- see: https://github.com/sol/hpack
 --
-- hash: 423912d97dc4b89c2c6324797efb0befbf8ddf7701f87d49c4da3e9ee426419f
+-- hash: 2434848b7fd81488fc4e9c5c41882ad1c0b11f6922f982686b155bb6713dd2fc

 name:           nixpkgs-update
 version:        0.2.0
@ -87,6 +87,7 @@ library
    , template-haskell
    , temporary
    , text
+    , th-env
    , time
    , transformers
    , typed-process
@ -139,6 +140,7 @@ executable nixpkgs-update
    , template-haskell
    , temporary
    , text
+    , th-env
    , time
    , transformers
    , typed-process
@ -199,6 +201,7 @@ test-suite spec
    , template-haskell
    , temporary
    , text
+    , th-env
    , time
    , transformers
    , typed-process
--- a/package.yaml
+++ b/package.yaml
@ -63,6 +63,7 @@ dependencies:
  - template-haskell
  - temporary
  - text
+  - th-env
  - time
  - transformers
  - typed-process
--- a/src/Check.hs
+++ b/src/Check.hs
@ -1,6 +1,7 @@
 {-# LANGUAGE ExtendedDefaultRules #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}

 module Check
@ -10,23 +11,36 @@ where

 import Control.Applicative (many)
 import Data.Char (isSpace)
+import Data.Maybe (fromJust)
 import qualified Data.Text as T
+import Language.Haskell.TH.Env (envQ)
 import OurPrelude
 import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
 import System.Exit
 import System.IO.Temp (withSystemTempDirectory)
+import Text.Regex.Applicative.Text (RE', (=~))
 import qualified Text.Regex.Applicative.Text as RE
-import Text.Regex.Applicative.Text ((=~), RE')
 import Utils (UpdateEnv (..), Version, nixBuildOptions)

 default (T.Text)

-data BinaryCheck
-  = BinaryCheck
-      { filePath :: FilePath,
-        zeroExitCode :: Bool,
-        versionPresent :: Bool
-      }
+treeBin :: String
+treeBin = fromJust ($$(envQ "TREE") :: Maybe String) <> "/bin/tree"
+
+procTree :: [String] -> ProcessConfig () () ()
+procTree = proc treeBin
+
+gistBin :: String
+gistBin = fromJust ($$(envQ "GIST") :: Maybe String) <> "/bin/gist"
+
+procGist :: [String] -> ProcessConfig () () ()
+procGist = proc gistBin
+
+data BinaryCheck = BinaryCheck
+  { filePath :: FilePath,
+    zeroExitCode :: Bool,
+    versionPresent :: Bool
+  }

 -- | Construct regex: [^\.]*${version}\.*\s*
 versionRegex :: Text -> RE' ()
@ -168,9 +182,9 @@ treeGist resultPath =
  hush
    <$> runExceptT
      ( do
-          contents <- proc "tree" [resultPath] & ourReadProcessInterleavedBS_
+          contents <- procTree [resultPath] & ourReadProcessInterleavedBS_
          g <-
-            shell "gist" & setStdin (byteStringInput contents)
+            shell gistBin & setStdin (byteStringInput contents)
              & ourReadProcessInterleaved_
          return $ "- directory tree listing: " <> g <> "\n"
      )
@ -182,7 +196,7 @@ duGist resultPath =
      ( do
          contents <- proc "du" [resultPath] & ourReadProcessInterleavedBS_
          g <-
-            shell "gist" & setStdin (byteStringInput contents)
+            shell gistBin & setStdin (byteStringInput contents)
              & ourReadProcessInterleaved_
          return $ "- du listing: " <> g <> "\n"
      )
--- a/src/Git.hs
+++ b/src/Git.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}

 module Git
  ( checkAutoUpdateBranchDoesntExist,
@ -20,11 +21,13 @@ import Control.Concurrent
 import Control.Exception
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
+import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
 import Data.Time.Clock (addUTCTime, getCurrentTime)
 import qualified Data.Vector as V
+import Language.Haskell.TH.Env (envQ)
 import OurPrelude hiding (throw)
 import System.Directory (doesDirectoryExist, getModificationTime, setCurrentDirectory)
 import System.Environment (getEnv)
@ -35,31 +38,43 @@ import System.Posix.Env (setEnv)
 import qualified System.Process.Typed
 import Utils (Options (..), UpdateEnv (..), branchName, branchPrefix)

+bin :: String
+bin = fromJust ($$(envQ "GIT") :: Maybe String) <> "/bin/git"
+
+procGit :: [String] -> ProcessConfig () () ()
+procGit = proc bin
+
+hubBin :: String
+hubBin = fromJust ($$(envQ "HUB") :: Maybe String) <> "/bin/hub"
+
+procHub :: [String] -> ProcessConfig () () ()
+procHub = proc hubBin
+
 clean :: ProcessConfig () () ()
-clean = silently "git clean -fdx"
+clean = silently $ procGit ["clean", "-fdx"]

 checkout :: Text -> Text -> ProcessConfig () () ()
 checkout branch target =
-  silently $ proc "git" ["checkout", "-B", T.unpack branch, T.unpack target]
+  silently $ procGit ["checkout", "-B", T.unpack branch, T.unpack target]

 reset :: Text -> ProcessConfig () () ()
-reset target = silently $ proc "git" ["reset", "--hard", T.unpack target]
+reset target = silently $ procGit ["reset", "--hard", T.unpack target]

 delete1 :: Text -> ProcessConfig () () ()
 delete1 branch = delete [branch]

 delete :: [Text] -> ProcessConfig () () ()
-delete branches = silently $ proc "git" (["branch", "-D"] ++ fmap T.unpack branches)
+delete branches = silently $ procGit (["branch", "-D"] ++ fmap T.unpack branches)

 deleteOrigin :: [Text] -> ProcessConfig () () ()
 deleteOrigin branches =
-  silently $ proc "git" (["push", "origin", "--delete"] ++ fmap T.unpack branches)
+  silently $ procGit (["push", "origin", "--delete"] ++ fmap T.unpack branches)

 cleanAndResetTo :: MonadIO m => Text -> ExceptT Text m ()
 cleanAndResetTo branch =
  let target = "upstream/" <> branch
   in do
-        runProcessNoIndexIssue_ $ silently "git reset --hard"
+        runProcessNoIndexIssue_ $ silently $ procGit ["reset", "--hard"]
        runProcessNoIndexIssue_ clean
        runProcessNoIndexIssue_ $ checkout branch target
        runProcessNoIndexIssue_ $ reset target
@ -73,7 +88,7 @@ cleanup bName = do
    <|> liftIO (T.putStrLn ("Couldn't delete " <> bName))

 diff :: MonadIO m => ExceptT Text m Text
-diff = readProcessInterleavedNoIndexIssue_ $ proc "git" ["diff"]
+diff = readProcessInterleavedNoIndexIssue_ $ procGit ["diff"]

 staleFetchHead :: MonadIO m => m Bool
 staleFetchHead =
@ -95,13 +110,12 @@ fetchIfStale = whenM staleFetchHead fetch
 fetch :: MonadIO m => ExceptT Text m ()
 fetch =
  runProcessNoIndexIssue_ $
-    silently "git fetch -q --prune --multiple upstream origin"
+    silently $ procGit ["fetch", "-q", "--prune", "--multiple", "upstream", "origin"]

 push :: MonadIO m => UpdateEnv -> ExceptT Text m ()
 push updateEnv =
  runProcessNoIndexIssue_
-    ( proc
-        "git"
+    ( procGit
        ( [ "push",
            "--force",
            "--set-upstream",
@ -121,14 +135,14 @@ setupNixpkgs githubt = do
  exists <- doesDirectoryExist fp
  unless exists $ do
    path <- getEnv "PATH"
-    proc "hub" ["clone", "nixpkgs", fp]
+    procHub ["clone", "nixpkgs", fp]
      & System.Process.Typed.setEnv -- requires that user has forked nixpkgs
        [ ("PATH" :: String, path),
          ("GITHUB_TOKEN" :: String, githubt & T.unpack)
        ]
      & runProcess_
    setCurrentDirectory fp
-    shell "git remote add upstream https://github.com/NixOS/nixpkgs"
+    shell (bin <> "remote add upstream https://github.com/NixOS/nixpkgs")
      & runProcess_
  setCurrentDirectory fp
  _ <- runExceptT fetchIfStale
@ -139,14 +153,14 @@ checkoutAtMergeBase :: MonadIO m => Text -> ExceptT Text m ()
 checkoutAtMergeBase bName = do
  base <-
    readProcessInterleavedNoIndexIssue_
-      "git merge-base upstream/master upstream/staging"
+      (procGit ["merge-base", "upstream/master", "upstream/staging"])
      & fmapRT T.strip
  runProcessNoIndexIssue_ (checkout bName base)

 checkAutoUpdateBranchDoesntExist :: MonadIO m => Text -> ExceptT Text m ()
 checkAutoUpdateBranchDoesntExist pName = do
  remoteBranches <-
-    readProcessInterleavedNoIndexIssue_ "git branch --remote"
+    readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote"])
      & fmapRT (T.lines >>> fmap T.strip)
  when
    (("origin/" <> branchPrefix <> pName) `elem` remoteBranches)
@ -154,10 +168,10 @@ checkAutoUpdateBranchDoesntExist pName = do

 commit :: MonadIO m => Text -> ExceptT Text m ()
 commit ref =
-  runProcessNoIndexIssue_ (proc "git" ["commit", "-am", T.unpack ref])
+  runProcessNoIndexIssue_ (procGit ["commit", "-am", T.unpack ref])

 headHash :: MonadIO m => ExceptT Text m Text
-headHash = T.strip <$> readProcessInterleavedNoIndexIssue_ "git rev-parse HEAD"
+headHash = T.strip <$> readProcessInterleavedNoIndexIssue_ (procGit ["rev-parse", "HEAD"])

 deleteBranchesEverywhere :: Vector Text -> IO ()
 deleteBranchesEverywhere branches = do
--- a/src/Nix.hs
+++ b/src/Nix.hs
@ -1,12 +1,11 @@
-{-# LANGUAGE ExtendedDefaultRules #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}

 module Nix
  ( assertNewerVersion,
    assertOldVersionOn,
+    binPath,
    build,
    cachix,
    getAttr,
@ -38,21 +37,26 @@ module Nix
  )
 where

+import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TL
 import qualified Data.Vector as V
+import Language.Haskell.TH.Env (envQ)
 import OurPrelude
 import qualified Polysemy.Error as Error
-import qualified Process as P
 import qualified Process
+import qualified Process as P
 import System.Exit
 import Text.Parsec (parse)
 import Text.Parser.Combinators
 import Text.Parser.Token
-import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, overwriteErrorT, srcOrMain)
+import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, srcOrMain)
 import Prelude hiding (log)

+binPath :: String
+binPath = fromJust ($$(envQ "NIX") :: Maybe String) <> "/bin"
+
 data Env = Env [(String, String)]

 data Raw
@ -73,14 +77,13 @@ nixEvalSem ::
 nixEvalSem (EvalOptions raw (Env env)) expr =
  T.strip
    <$> ourReadProcessInterleaved_Sem
-      (setEnv env (proc "nix" (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))
+      (setEnv env (proc (binPath <> "/nix") (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))

 nixEvalET :: MonadIO m => EvalOptions -> Text -> ExceptT Text m Text
 nixEvalET (EvalOptions raw (Env env)) expr =
  ourReadProcessInterleaved_
-    (setEnv env (proc "nix" (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))
+    (setEnv env (proc (binPath <> "/nix") (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))
    & fmapRT T.strip
-    & overwriteErrorT ("nix eval failed for \"" <> expr <> "\"")

 -- Error if the "new version" is actually newer according to nix
 assertNewerVersion :: MonadIO m => UpdateEnv -> ExceptT Text m ()
@ -110,7 +113,7 @@ assertNewerVersion updateEnv = do
 lookupAttrPath :: MonadIO m => UpdateEnv -> ExceptT Text m Text
 lookupAttrPath updateEnv =
  proc
-    "nix-env"
+    (binPath <> "/nix-env")
    ( [ "-qa",
        (packageName updateEnv <> "-" <> oldVersion updateEnv) & T.unpack,
        "-f",
@ -124,10 +127,9 @@ lookupAttrPath updateEnv =

 getDerivationFile :: MonadIO m => Text -> ExceptT Text m FilePath
 getDerivationFile attrPath =
-  proc "env" ["EDITOR=echo", "nix", "edit", attrPath & T.unpack, "-f", "."]
+  proc "env" ["EDITOR=echo", (binPath <> "/nix"), "edit", attrPath & T.unpack, "-f", "."]
    & ourReadProcessInterleaved_
    & fmapRT (T.strip >>> T.unpack)
-    & overwriteErrorT "Couldn't find derivation file. "

 getDrvAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
 getDrvAttr drvAttr =
@ -149,11 +151,6 @@ getHash =
 getOldHash :: MonadIO m => Text -> ExceptT Text m Text
 getOldHash attrPath =
  getHash attrPath
-    & overwriteErrorT
-      ( "Could not find old output hash at "
-          <> attrPath
-          <> ".src.drvAttrs.outputHash or .drvAttrs.outputHash."
-      )

 getMaintainers :: MonadIO m => Text -> ExceptT Text m Text
 getMaintainers attrPath =
@ -163,7 +160,6 @@ getMaintainers attrPath =
        <> attrPath
        <> ".meta.maintainers or []))))"
    )
-    & overwriteErrorT ("Could not fetch maintainers for" <> attrPath)

 parseStringList :: MonadIO m => Text -> ExceptT Text m (Vector Text)
 parseStringList list =
@ -196,7 +192,6 @@ getIsBroken attrPath =
        <> ".meta.broken or false)"
    )
    & readNixBool
-    & overwriteErrorT ("Could not get meta.broken for attrpath " <> attrPath)

 getChangelog :: MonadIO m => Text -> ExceptT Text m Text
 getChangelog attrPath =
@ -206,7 +201,6 @@ getChangelog attrPath =
        <> attrPath
        <> ".meta.changelog or \"\")"
    )
-    & overwriteErrorT ("Could not get meta.changelog for attrpath " <> attrPath)

 getDescription :: MonadIO m => Text -> ExceptT Text m Text
 getDescription attrPath =
@ -216,7 +210,6 @@ getDescription attrPath =
        <> attrPath
        <> ".meta.description or \"\")"
    )
-    & overwriteErrorT ("Could not get meta.description for attrpath " <> attrPath)

 getHomepage ::
  Members '[P.Process, Error Text] r =>
@ -261,10 +254,10 @@ getSrcUrls = getSrcAttr "urls"

 buildCmd :: Text -> ProcessConfig () () ()
 buildCmd attrPath =
-  silently $ proc "nix-build" (nixBuildOptions ++ ["-A", attrPath & T.unpack])
+  silently $ proc (binPath <> "/nix-build") (nixBuildOptions ++ ["-A", attrPath & T.unpack])

 log :: Text -> ProcessConfig () () ()
-log attrPath = proc "nix" ["log", "-f", ".", attrPath & T.unpack]
+log attrPath = proc (binPath <> "/nix") ["log", "-f", ".", attrPath & T.unpack]

 build :: MonadIO m => Text -> ExceptT Text m ()
 build attrPath =
@ -348,7 +341,7 @@ getHashFromBuild =
    )

 version :: MonadIO m => ExceptT Text m Text
-version = ourReadProcessInterleaved_ "nix --version"
+version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"])

 getPatches :: MonadIO m => Text -> ExceptT Text m Text
 getPatches attrPath =
--- a/src/NixpkgsReview.hs
+++ b/src/NixpkgsReview.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}

 module NixpkgsReview
  ( cacheDir,
@ -6,13 +7,18 @@ module NixpkgsReview
  )
 where

+import Data.Maybe (fromJust)
 import Data.Text as T
 import qualified File as F
+import Language.Haskell.TH.Env (envQ)
 import OurPrelude
 import qualified Process as P
 import System.Environment.XDG.BaseDir (getUserCacheDir)
 import Prelude hiding (log)

+binPath :: String
+binPath = fromJust ($$(envQ "NIXPKGSREVIEW") :: Maybe String) <> "/bin"
+
 cacheDir :: IO FilePath
 cacheDir = getUserCacheDir "nixpkgs-review"

@ -27,10 +33,12 @@ run ::
 run cache commit = do
  -- TODO: probably just skip running nixpkgs-review if the directory
  -- already exists
-  void $ ourReadProcessInterleavedSem $
-    proc "rm" ["-rf", revDir cache commit]
-  void $ ourReadProcessInterleavedSem $
-    proc "nixpkgs-review" ["rev", T.unpack commit, "--no-shell"]
+  void $
+    ourReadProcessInterleavedSem $
+      proc "rm" ["-rf", revDir cache commit]
+  void $
+    ourReadProcessInterleavedSem $
+      proc (binPath <> "/nixpkgs-review") ["rev", T.unpack commit, "--no-shell"]
  F.read $ (revDir cache commit) <> "/report.md"

 -- Assumes we are already in nixpkgs dir
--- a/src/Update.hs
+++ b/src/Update.hs
@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}

 module Update
@ -30,6 +31,7 @@ import Data.Time.Calendar (showGregorian)
 import Data.Time.Clock (UTCTime, getCurrentTime, utctDay)
 import qualified GH
 import qualified Git
+import Language.Haskell.TH.Env (envQ)
 import NVD (getCVEs, withVulnDB)
 import qualified Nix
 import qualified NixpkgsReview
@ -52,11 +54,10 @@ import Prelude hiding (log)

 default (T.Text)

-data MergeBaseOutpathsInfo
-  = MergeBaseOutpathsInfo
-      { lastUpdated :: UTCTime,
-        mergeBaseOutpaths :: Set ResultLine
-      }
+data MergeBaseOutpathsInfo = MergeBaseOutpathsInfo
+  { lastUpdated :: UTCTime,
+    mergeBaseOutpaths :: Set ResultLine
+  }

 log' :: MonadIO m => FilePath -> Text -> m ()
 log' logFile msg = do
@ -90,7 +91,8 @@ notifyOptions log o = do
  let outpaths = repr calculateOutpaths
  let cve = repr makeCVEReport
  let review = repr runNixpkgsReview
-  log $ [interpolate|
+  log $
+    [interpolate|
    Configured Nixpkgs-Update Options:
    ----------------------------------
    GitHub User:                   $ghUser
@ -139,9 +141,9 @@ sourceGithubAll o updates = do
          v <- GH.latestVersion updateEnv srcUrl
          if v /= newV
            then
-              liftIO
-                $ T.putStrLn
-                $ p <> ": " <> oldV <> " -> " <> newV <> " -> " <> v
+              liftIO $
+                T.putStrLn $
+                  p <> ": " <> oldV <> " -> " <> newV <> " -> " <> v
            else return ()
    )
    u'
@ -288,8 +290,8 @@ publishPackage ::
 publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff rewriteMsgs = do
  let prBase =
        if (isNothing opDiff || numPackageRebuilds (fromJust opDiff) < 100)
-        then "master"
-        else "staging"
+          then "master"
+          else "staging"
  cachixTestInstructions <- doCachix log updateEnv result
  resultCheckReport <-
    case Blacklist.checkResult (packageName updateEnv) of
@ -405,7 +407,8 @@ prMessage updateEnv isBroken metaDescription metaHomepage metaChangelog rewriteM
      nixpkgsReviewSection =
        if nixpkgsReviewMsg == T.empty
          then "NixPkgs review skipped"
-          else [interpolate|
+          else
+            [interpolate|
            We have automatically built all packages that will get rebuilt due to
            this change.

@ -497,12 +500,15 @@ prMessage updateEnv isBroken metaDescription metaHomepage metaChangelog rewriteM
       $maintainersCc
    |]

+jqBin :: String
+jqBin = fromJust ($$(envQ "JQ") :: Maybe String) <> "/bin/jq"
+
 untilOfBorgFree :: MonadIO m => m ()
 untilOfBorgFree = do
  stats <-
    shell "curl -s https://events.nix.ci/stats.php" & readProcessInterleaved_
  waiting <-
-    shell "jq .evaluator.messages.waiting" & setStdin (byteStringInput stats)
+    shell (jqBin <> " .evaluator.messages.waiting") & setStdin (byteStringInput stats)
      & readProcessInterleaved_
      & fmap (BSL.readInt >>> fmap fst >>> fromMaybe 0)
  when (waiting > 2) $ do