diff --git a/flake.nix b/flake.nix index 41db58e..9e806a4 100644 --- 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 { diff --git a/nixpkgs-update.cabal b/nixpkgs-update.cabal index 1ec2f66..8881ea2 100644 --- 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 diff --git a/package.yaml b/package.yaml index 2c75e0c..4c7ed04 100644 --- a/package.yaml +++ b/package.yaml @@ -63,6 +63,7 @@ dependencies: - template-haskell - temporary - text + - th-env - time - transformers - typed-process diff --git a/src/Check.hs b/src/Check.hs index 31f295c..d361d5b 100644 --- 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" ) diff --git a/src/Git.hs b/src/Git.hs index b7a5de5..fda7d5e 100644 --- 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 diff --git a/src/Nix.hs b/src/Nix.hs index 1a7275d..9464f79 100644 --- 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 = diff --git a/src/NixpkgsReview.hs b/src/NixpkgsReview.hs index 751664e..4e30367 100644 --- 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 diff --git a/src/Update.hs b/src/Update.hs index dd75163..3cd683f 100644 --- 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