maintainers/scripts/haskell/hydra-report.hs: Use only 2 queries to get report

This commit is contained in:
(cdep)illabout 2021-05-08 14:15:20 +09:00 committed by Malte Brandy
parent 912c7bd20d
commit 277bb664de
No known key found for this signature in database
GPG key ID: 226A2D41EF5378C9

View file

@ -11,7 +11,7 @@ The purpose of this script is
2) print a summary of the state suitable for pasting into a github comment (with ping-maintainers) 2) print a summary of the state suitable for pasting into a github comment (with ping-maintainers)
3) print a list of broken packages suitable for pasting into configuration-hackage2nix.yaml 3) print a list of broken packages suitable for pasting into configuration-hackage2nix.yaml
Because step 1) is very expensive and takes roughly ~30 minutes the result is cached in a json file in XDG_CACHE. Because step 1) is quite expensive and takes roughly ~5 minutes the result is cached in a json file in XDG_CACHE.
-} -}
{-# LANGUAGE BlockArguments #-} {-# LANGUAGE BlockArguments #-}
@ -25,7 +25,7 @@ Because step 1) is very expensive and takes roughly ~30 minutes the result is ca
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
import Control.Monad (forM, forM_, (<=<)) import Control.Monad (forM, forM_, when, (<=<))
import Control.Monad.Trans (MonadIO (liftIO)) import Control.Monad.Trans (MonadIO (liftIO))
import Data.Aeson ( import Data.Aeson (
FromJSON, FromJSON,
@ -60,10 +60,12 @@ import Network.HTTP.Req (
GET (GET), GET (GET),
NoReqBody (NoReqBody), NoReqBody (NoReqBody),
defaultHttpConfig, defaultHttpConfig,
header,
https, https,
jsonResponse, jsonResponse,
req, req,
responseBody, responseBody,
responseTimeout,
runReq, runReq,
(/:), (/:),
) )
@ -83,8 +85,7 @@ newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs}
deriving (Generic, ToJSON, FromJSON, Show) deriving (Generic, ToJSON, FromJSON, Show)
data Eval = Eval data Eval = Eval
{ builds :: Seq Int { id :: Int
, id :: Int
, jobsetevalinputs :: JobsetEvalInputs , jobsetevalinputs :: JobsetEvalInputs
} }
deriving (Generic, ToJSON, FromJSON, Show) deriving (Generic, ToJSON, FromJSON, Show)
@ -116,16 +117,18 @@ showT :: Show a => a -> Text
showT = Text.pack . show showT = Text.pack . show
getBuildReports :: IO () getBuildReports :: IO ()
getBuildReports = runReq defaultHttpConfig $ do getBuildReports = runReq defaultHttpConfig do
-- GET request http response evalMay <- Seq.lookup 0 . evals <$> myReq (https "hydra.nixos.org" /: "jobset" /: "nixpkgs" /: "haskell-updates" /: "evals") mempty
now <- liftIO getCurrentTime eval@Eval{id} <- maybe (liftIO $ fail "No Evalution found") pure evalMay
r <- req GET (https "hydra.nixos.org" /: "jobset" /: "nixpkgs" /: "haskell-updates" /: "evals") NoReqBody jsonResponse mempty liftIO . putStrLn $ "Fetching evaluation " <> show id <> " from Hydra. This might take a few minutes..."
let eval = Seq.lookup 0 . evals $ (responseBody r :: JobsetEvals) buildReports :: Seq Build <- myReq (https "hydra.nixos.org" /: "eval" /: showT id /: "builds") (responseTimeout 600000000)
eval & maybe (liftIO $ putStrLn "No Evalution found") \eval -> do liftIO do
(buildReports :: Seq Build) <- forM (builds eval) \buildId -> fileName <- reportFileName
responseBody <$> req GET (https "hydra.nixos.org" /: "build" /: showT buildId) NoReqBody jsonResponse mempty putStrLn $ "Finished fetching all builds from Hydra, saving report as " <> fileName
fileName <- liftIO reportFileName now <- getCurrentTime
liftIO $ encodeFile fileName (eval, now, buildReports) encodeFile fileName (eval, now, buildReports)
where
myReq query option = responseBody <$> req GET query NoReqBody jsonResponse (header "User-Agent" "hydra-report.hs/v1 (nixkpgs;maintainers/scripts/haskell)" <> option)
hydraEvalCommand = "hydra-eval-jobs" hydraEvalCommand = "hydra-eval-jobs"
hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"] hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]