Merge pull request #217242 from maralorn/broken-reasons

maintainers/scripts/haskell/hydra-report: Add comments with error causes to broken list
This commit is contained in:
maralorn 2023-03-01 00:17:20 +01:00 committed by GitHub
commit 994e845bd0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -26,6 +26,7 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DataKinds #-}
import Control.Monad (forM_, (<=<))
import Control.Monad.Trans (MonadIO (liftIO))
@ -54,17 +55,22 @@ import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
import Data.Time.Clock (UTCTime)
import GHC.Generics (Generic)
import Network.HTTP.Req (
GET (GET),
NoReqBody (NoReqBody),
defaultHttpConfig,
header,
https,
jsonResponse,
req,
responseBody,
responseTimeout,
runReq,
(/:),
GET (GET),
HttpResponse (HttpResponseBody),
NoReqBody (NoReqBody),
Option,
Req,
Scheme (Https),
bsResponse,
defaultHttpConfig,
header,
https,
jsonResponse,
req,
responseBody,
responseTimeout,
runReq,
(/:),
)
import System.Directory (XdgDirectory (XdgCache), getXdgDirectory)
import System.Environment (getArgs)
@ -76,6 +82,10 @@ import Control.Exception (evaluate)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import Data.Bifunctor (second)
import Data.Data (Proxy)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as ByteString
import Distribution.Simple.Utils (safeLast, fromUTF8BS)
newtype JobsetEvals = JobsetEvals
{ evals :: Seq Eval
@ -123,17 +133,31 @@ showT = Text.pack . show
getBuildReports :: IO ()
getBuildReports = runReq defaultHttpConfig do
evalMay <- Seq.lookup 0 . evals <$> myReq (https "hydra.nixos.org" /: "jobset" /: "nixpkgs" /: "haskell-updates" /: "evals") mempty
evalMay <- Seq.lookup 0 . evals <$> hydraJSONQuery mempty ["jobset", "nixpkgs", "haskell-updates", "evals"]
eval@Eval{id} <- maybe (liftIO $ fail "No Evalution found") pure evalMay
liftIO . putStrLn $ "Fetching evaluation " <> show id <> " from Hydra. This might take a few minutes..."
buildReports :: Seq Build <- myReq (https "hydra.nixos.org" /: "eval" /: showT id /: "builds") (responseTimeout 600000000)
buildReports :: Seq Build <- hydraJSONQuery (responseTimeout 600000000) ["eval", showT id, "builds"]
liftIO do
fileName <- reportFileName
putStrLn $ "Finished fetching all builds from Hydra, saving report as " <> fileName
now <- getCurrentTime
encodeFile fileName (eval, now, buildReports)
where
myReq query option = responseBody <$> req GET query NoReqBody jsonResponse (header "User-Agent" "hydra-report.hs/v1 (nixpkgs;maintainers/scripts/haskell)" <> option)
hydraQuery :: HttpResponse a => Proxy a -> Option 'Https -> [Text] -> Req (HttpResponseBody a)
hydraQuery responseType option query =
responseBody
<$> req
GET
(foldl' (/:) (https "hydra.nixos.org") query)
NoReqBody
responseType
(header "User-Agent" "hydra-report.hs/v1 (nixpkgs;maintainers/scripts/haskell)" <> option)
hydraJSONQuery :: FromJSON a => Option 'Https -> [Text] -> Req a
hydraJSONQuery = hydraQuery jsonResponse
hydraPlainQuery :: [Text] -> Req ByteString
hydraPlainQuery = hydraQuery bsResponse mempty
hydraEvalCommand :: FilePath
hydraEvalCommand = "hydra-eval-jobs"
@ -326,23 +350,24 @@ instance Functor (Table row col) where
instance Foldable (Table row col) where
foldMap f (Table a) = foldMap f a
getBuildState :: Build -> BuildState
getBuildState Build{finished, buildstatus} = case (finished, buildstatus) of
(0, _) -> Unfinished
(_, Just 0) -> Success
(_, Just 1) -> Failed
(_, Just 2) -> DependencyFailed
(_, Just 3) -> HydraFailure
(_, Just 4) -> Canceled
(_, Just 7) -> TimedOut
(_, Just 11) -> OutputLimitExceeded
(_, i) -> Unknown i
buildSummary :: MaintainerMap -> ReverseDependencyMap -> Seq Build -> StatusSummary
buildSummary maintainerMap reverseDependencyMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
where
unionSummary (SummaryEntry (Table lb) lm lr lu) (SummaryEntry (Table rb) rm rr ru) = SummaryEntry (Table $ Map.union lb rb) (lm <> rm) (max lr rr) (max lu ru)
toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (SummaryEntry (Table (Map.singleton (set, Platform system) (BuildResult state id))) maintainers reverseDeps unbrokenReverseDeps)
toSummary build@Build{job, id, system} = Map.singleton name (SummaryEntry (Table (Map.singleton (set, Platform system) (BuildResult (getBuildState build) id))) maintainers reverseDeps unbrokenReverseDeps)
where
state :: BuildState
state = case (finished, buildstatus) of
(0, _) -> Unfinished
(_, Just 0) -> Success
(_, Just 1) -> Failed
(_, Just 2) -> DependencyFailed
(_, Just 3) -> HydraFailure
(_, Just 4) -> Canceled
(_, Just 7) -> TimedOut
(_, Just 11) -> OutputLimitExceeded
(_, i) -> Unknown i
packageName = fromMaybe job (Text.stripSuffix ("." <> system) job)
splitted = nonEmpty $ Text.splitOn "." packageName
name = maybe packageName NonEmpty.last splitted
@ -486,8 +511,23 @@ printMaintainerPing = do
printMarkBrokenList :: IO ()
printMarkBrokenList = do
(_, _, buildReport) <- readBuildReports
forM_ buildReport \Build{buildstatus, job} ->
case (buildstatus, Text.splitOn "." job) of
(Just 1, ["haskellPackages", name, "x86_64-linux"]) -> putStrLn $ " - " <> Text.unpack name
(_, fetchTime, buildReport) <- readBuildReports
runReq defaultHttpConfig $ forM_ buildReport \build@Build{job, id} ->
case (getBuildState build, Text.splitOn "." job) of
(Failed, ["haskellPackages", name, "x86_64-linux"]) -> do
-- Fetch build log from hydra to figure out the cause of the error.
build_log <- ByteString.lines <$> hydraPlainQuery ["build", showT id, "nixlog", "1", "raw"]
-- We use the last probable error cause found in the build log file.
let error_message = fromMaybe " failure " $ safeLast $ mapMaybe probableErrorCause build_log
liftIO $ putStrLn $ " - " <> Text.unpack name <> " # " <> error_message <> " in job https://hydra.nixos.org/build/" <> show id <> " at " <> formatTime defaultTimeLocale "%Y-%m-%d" fetchTime
_ -> pure ()
{- | This function receives a line from a Nix Haskell builder build log and returns a possible error cause.
| We might need to add other causes in the future if errors happen in unusual parts of the builder.
-}
probableErrorCause :: ByteString -> Maybe String
probableErrorCause "Setup: Encountered missing or private dependencies:" = Just "dependency missing"
probableErrorCause "running tests" = Just "test failure"
probableErrorCause build_line | ByteString.isPrefixOf "Building" build_line = Just ("failure building " <> fromUTF8BS (fst $ ByteString.breakSubstring " for" $ ByteString.drop 9 build_line))
probableErrorCause build_line | ByteString.isSuffixOf "Phase" build_line = Just ("failure in " <> fromUTF8BS build_line)
probableErrorCause _ = Nothing