diff options
author | sternenseemann <sternenseemann@systemli.org> | 2023-09-03 21:54:03 +0200 |
---|---|---|
committer | sternenseemann <sternenseemann@systemli.org> | 2023-09-03 21:54:03 +0200 |
commit | 76dc15354424f88c38124d5467b18dd5476ecc40 (patch) | |
tree | f2688f19f8afb4c89f9fdd6c8ae163a4220607b5 /maintainers/scripts/haskell | |
parent | 00b0824635f1ab030234124d79af4fbea1d0053c (diff) |
maintainers/haskell/hydra-report.hs: work around bulk status timeout
This change adds a flag --slow to hydra-report.sh get-report which causes it to fetch the cheap evaluation overview endpoint (which only contains build ids and meta data). The gathered information is then used to request each build's status individually instead of in bulk which is very slow, but useful as a last resort if the bulk endpoint times out.
Diffstat (limited to 'maintainers/scripts/haskell')
-rwxr-xr-x | maintainers/scripts/haskell/hydra-report.hs | 26 |
1 files changed, 19 insertions, 7 deletions
diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 3dbd66f2e4c27..68ba75452d438 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -30,7 +30,7 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE DataKinds #-} -import Control.Monad (forM_, (<=<)) +import Control.Monad (forM_, forM, (<=<)) import Control.Monad.Trans (MonadIO (liftIO)) import Data.Aeson ( FromJSON, @@ -108,6 +108,7 @@ newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs} data Eval = Eval { id :: Int , jobsetevalinputs :: JobsetEvalInputs + , builds :: Seq Int } deriving (Generic, ToJSON, FromJSON, Show) @@ -151,18 +152,20 @@ data Build = Build } deriving (Generic, ToJSON, FromJSON, Show) +data HydraSlownessWorkaroundFlag = HydraSlownessWorkaround | NoHydraSlownessWorkaround data RequestLogsFlag = RequestLogs | NoRequestLogs main :: IO () main = do args <- getArgs case args of - ["get-report"] -> getBuildReports + ["get-report", "--slow"] -> getBuildReports HydraSlownessWorkaround + ["get-report"] -> getBuildReports NoHydraSlownessWorkaround ["ping-maintainers"] -> printMaintainerPing ["mark-broken-list", "--no-request-logs"] -> printMarkBrokenList NoRequestLogs ["mark-broken-list"] -> printMarkBrokenList RequestLogs ["eval-info"] -> printEvalInfo - _ -> putStrLn "Usage: get-report | ping-maintainers | mark-broken-list [--no-request-logs] | eval-info" + _ -> putStrLn "Usage: get-report [--slow] | ping-maintainers | mark-broken-list [--no-request-logs] | eval-info" reportFileName :: IO FilePath reportFileName = getXdgDirectory XdgCache "haskell-updates-build-report.json" @@ -170,18 +173,27 @@ reportFileName = getXdgDirectory XdgCache "haskell-updates-build-report.json" showT :: Show a => a -> Text showT = Text.pack . show -getBuildReports :: IO () -getBuildReports = runReq defaultHttpConfig do +getBuildReports :: HydraSlownessWorkaroundFlag -> IO () +getBuildReports opt = runReq defaultHttpConfig do 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 <- hydraJSONQuery (responseTimeout 600000000) ["eval", showT id, "builds"] + buildReports <- getEvalBuilds opt id liftIO do fileName <- reportFileName putStrLn $ "Finished fetching all builds from Hydra, saving report as " <> fileName now <- getCurrentTime encodeFile fileName (eval, now, buildReports) +getEvalBuilds :: HydraSlownessWorkaroundFlag -> Int -> Req (Seq Build) +getEvalBuilds NoHydraSlownessWorkaround id = + hydraJSONQuery (responseTimeout 600000000) ["eval", showT id, "builds"] +getEvalBuilds HydraSlownessWorkaround id = do + Eval{builds} <- hydraJSONQuery mempty [ "eval", showT id ] + forM builds $ \buildId -> do + liftIO $ putStrLn $ "Querying build " <> show buildId + hydraJSONQuery mempty [ "build", showT buildId ] + hydraQuery :: HttpResponse a => Proxy a -> Option 'Https -> [Text] -> Req (HttpResponseBody a) hydraQuery responseType option query = responseBody @@ -190,7 +202,7 @@ hydraQuery responseType option query = (foldl' (/:) (https "hydra.nixos.org") query) NoReqBody responseType - (header "User-Agent" "hydra-report.hs/v1 (nixpkgs;maintainers/scripts/haskell)" <> option) + (header "User-Agent" "hydra-report.hs/v1 (nixpkgs;maintainers/scripts/haskell) pls fix https://github.com/NixOS/nixos-org-configurations/issues/270" <> option) hydraJSONQuery :: FromJSON a => Option 'Https -> [Text] -> Req a hydraJSONQuery = hydraQuery jsonResponse |