[ADP-3389] Skip deleted artifacts when collecting benchmark history (#…

…4706)

This task is about not blowing up during benchmark result collections
when the result artifacts were deleted.

- [x] Accept a 410 status when getting an artifact and interpret it as a
skip the result action

ADP-3389

lib/benchmarks/cardano-wallet-benchmarks.cabal

@@ -281,6 +281,7 @@ executable benchmark-history
     , http-client
     , http-client-tls
     , http-media
+    , http-types
     , monoidal-containers
     , optparse-applicative
     , pretty-simple

lib/benchmarks/exe/benchmark-history.hs

@@ -73,6 +73,9 @@ import Network.HTTP.Client.TLS
 import Network.HTTP.Media
     ( (//)
     )
+import Network.HTTP.Types.Status
+    ( status410
+    )
 import Options.Applicative
     ( Parser
     , ParserInfo
@@ -99,8 +102,9 @@ import Servant.API.ContentTypes
 import Servant.Client
     ( BaseUrl (..)
     , ClientEnv
-    , ClientError
+    , ClientError (FailureResponse)
     , ClientM
+    , ResponseF (..)
     , Scheme (..)
     , client
     , mkClientEnv
@@ -156,8 +160,13 @@ fetchArtifactContent
     :: WithAuthPipeline (Int -> Text -> Text -> ClientM BL8.ByteString)
 fetchArtifactContent = client (Proxy :: Proxy (GetArtifact CSV BL8.ByteString))
 
-queryBuildkite :: Query -> Day -> IO History
-queryBuildkite q d0 =
+queryBuildkite ::
+    (forall a . HandleClientError a -> ClientM a -> IO (Maybe a))
+    -> (forall a . WithAuthPipeline a -> a)
+    -> Day -> IO History
+queryBuildkite q w d0 = do
+    let skip410Q = Query (q skip410) w
+        bailoutQ = Query (q bailout) w
     S.foldMap_ Prelude.id
         $ flip
             S.for
@@ -166,7 +175,9 @@ queryBuildkite q d0 =
                 Left e -> error e
             )
         $ flip S.for historyPoints
-        $ flip S.for (\(a, j) -> getArtifactsContent q fetchArtifactContent j a)
+        $ flip S.for (\(a, j) -> getArtifactsContent
+            skip410Q
+            fetchArtifactContent j a)
         $ S.chain
             ( \(_, b) ->
                 putStrLn
@@ -178,8 +189,8 @@ queryBuildkite q d0 =
 
         $ S.filter (\(a, _) -> "bench-results.csv" `isSuffixOf` filename a)
         $ S.map (\(b, a) -> (a, b))
-        $ flip S.for (getArtifacts q)
-        $ getReleaseCandidateBuilds q d0
+        $ flip S.for (getArtifacts bailoutQ)
+        $ getReleaseCandidateBuilds bailoutQ d0
 
 mkReleaseCandidateName :: Day -> String
 mkReleaseCandidateName d = "release-candidate/v" ++ show d
@@ -224,15 +235,17 @@ optionsParser =
             <> header "benchmark-history - a tool for benchmark data analysis"
         )
 
+type HandleClientError a = IO (Either ClientError a) -> IO (Maybe a)
+
 main :: IO ()
 main = do
     bkToken <- getToken
     Options sinceDay outputDir <- execParser optionsParser
     manager <- newManager $ specialSettings False
     let env = buildkiteEnv manager
-        runQuery action = bailout $ runClientM action env
-        query = Query runQuery $ withAuthWallet bkToken
-    result <- queryBuildkite query sinceDay
+        runQuery :: HandleClientError a -> ClientM a -> IO (Maybe a)
+        runQuery f action = f $ runClientM action env
+    result <- queryBuildkite runQuery (withAuthWallet bkToken) sinceDay
     let eHarmonized = harmonizeHistory result
     case eHarmonized of
         Left rs -> error $ "Failed to harmonize history: " ++ show rs
@@ -242,12 +255,21 @@ main = do
             BL8.writeFile (outputDir </> "benchmark_history" <.> "csv") csv
             renderHarmonizedHistoryChartSVG outputDir harmonized
 
-bailout :: IO (Either ClientError a) -> IO a
-bailout f = do
+bailout :: HandleClientError a
+bailout = handle (error . show)
+
+handle :: (ClientError -> IO (Maybe a)) -> HandleClientError a
+handle g f = do
     res <- f
     case res of
-        Left e -> error $ show e
-        Right a -> pure a
+        Left e -> g e
+        Right a -> pure $ Just a
+
+skip410 :: HandleClientError a
+skip410 = handle $ \case
+    FailureResponse _ (Response s _ _ _)
+        | s == status410 -> pure Nothing
+    e -> error $ show e
 
 buildkiteEnv :: Manager -> ClientEnv
 buildkiteEnv manager =

lib/buildkite/src/Buildkite/Client.hs

@@ -64,24 +64,30 @@ import qualified Streaming.Prelude as S
 
 data Query
     = Query
-        (forall a. ClientM a -> IO a)
-        (forall a. WithAuthPipeline a -> a)
+        { query :: forall a. ClientM a -> IO (Maybe a)
+        , withAuth :: forall a. WithAuthPipeline a -> a
+        }
 
 type JobMap = Map Text Job
 
 type BuildJobsMap = BKAPI.Build (Map Text)
 
 type BuildAPI = BKAPI.Build []
 
-paging :: Monad m => (Maybe Int -> m [a]) -> Stream (Of a) m ()
+paging :: Monad m => (Maybe Int -> m (Maybe [a]))
+    -> Stream (Of a) m ()
 paging f = go 1
   where
     go page = do
-        bs <- lift $ f $ Just page
-        S.each bs
-        case bs of
-            [] -> pure ()
-            _ -> go $ page + 1
+        mbs <- lift $ f $ Just page
+        case mbs of
+            Nothing ->
+                pure () -- arbitrary choice ?
+            Just bs -> do
+                S.each bs
+                case bs of
+                    [] -> pure ()
+                    _ -> go $ page + 1
 
 getBuilds :: Query -> Stream (Of BuildAPI) IO ()
 getBuilds (Query q w) = paging $ q . w fetchBuilds
@@ -110,15 +116,17 @@ getArtifactsContent
     -> Artifact
     -> Stream (Of (BuildJobsMap, Artifact, r)) IO ()
 getArtifactsContent (Query q w) getArtifact build artifact = do
-    benchResults <-
+    mBenchResults <- do
         lift
             $ q
             $ w
                 getArtifact
                 (number build)
                 (job_id artifact)
                 (BKAPI.artifactId artifact)
-    S.yield (build, artifact, benchResults)
+    case mBenchResults of
+        Nothing -> pure ()
+        Just benchResults -> S.yield (build, artifact, benchResults)
 
 downloadArtifact :: ArtifactURL -> Stream (Of BL.ByteString) IO ()
 downloadArtifact (ArtifactURL url') = do