maintainers/scripts/haskell/hydra-report.hs: Use only 2 queries to get report
This commit is contained in:
parent
912c7bd20d
commit
277bb664de
|
@ -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"]
|
||||||
|
|
Loading…
Reference in New Issue