digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-20 01:07:18 +03:00
Code Issues Projects Releases Wiki Activity

Retry asset downloads in check_releases (#8730)

Browse Source 
We’ve seen a number of "resource vanished (connection reset by peer)"
errors. Slapping some retries on that should hopefully make the CI job
a bit more robust.

changelog_begin
changelog_end
This commit is contained in:
Moritz Kiefer 2021-02-03 12:04:59 +01:00 committed by GitHub
parent 42e071f2c2
commit d7d954335e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ci/cron/BUILD.bazel
View File

@ -28,6 +28,7 @@ da_haskell_binary(
"proto3-suite", "proto3-suite",
"regex-tdfa", "regex-tdfa",
"resourcet", "resourcet",
"retry",
"safe", "safe",
"safe-exceptions", "safe-exceptions",
"semver", "semver",

23
ci/cron/src/Main.hs
View File

@ -14,6 +14,7 @@ import Control.Exception.Safe
import qualified Control.Monad as Control import qualified Control.Monad as Control
import qualified Control.Monad.Extra import qualified Control.Monad.Extra
import qualified Control.Monad.Loops import qualified Control.Monad.Loops
import Control.Retry
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString import qualified Data.ByteString
import qualified Data.ByteString.UTF8 as BS import qualified Data.ByteString.UTF8 as BS
@ -317,20 +318,32 @@ download_assets :: FilePath -> GitHubRelease -> IO ()
download_assets tmp release = do download_assets tmp release = do
manager <- HTTP.newManager TLS.tlsManagerSettings manager <- HTTP.newManager TLS.tlsManagerSettings
tokens <- Control.Concurrent.QSem.newQSem 20 tokens <- Control.Concurrent.QSem.newQSem 20
Control.Concurrent.Async.forConcurrently_ (map uri $ assets release) (\url -> Control.Concurrent.Async.forConcurrently_ (map uri $ assets release) $ \url ->
bracket_ bracket_
(Control.Concurrent.QSem.waitQSem tokens) (Control.Concurrent.QSem.waitQSem tokens)
(Control.Concurrent.QSem.signalQSem tokens) (Control.Concurrent.QSem.signalQSem tokens)
(do (do
req <- add_github_contact_header <$> HTTP.parseRequest (show url) req <- add_github_contact_header <$> HTTP.parseRequest (show url)
HTTP.withResponse req manager (\resp -> do recovering
let body = HTTP.responseBody resp retryPolicy
IO.withBinaryFile (tmp </> (last $ Network.URI.pathSegments url)) IO.AppendMode (\handle -> do [retryHandler]
while (readFrom body) (writeTo handle))))) (\_ -> downloadFile req manager url)
)
where while = Control.Monad.Loops.whileJust_ where while = Control.Monad.Loops.whileJust_
readFrom body = ifNotEmpty <$> HTTP.brRead body readFrom body = ifNotEmpty <$> HTTP.brRead body
ifNotEmpty bs = if Data.ByteString.null bs then Nothing else Just bs ifNotEmpty bs = if Data.ByteString.null bs then Nothing else Just bs
writeTo = Data.ByteString.hPut writeTo = Data.ByteString.hPut
-- Retry for 5 minutes total, doubling delay starting with 20ms
retryPolicy = limitRetriesByCumulativeDelay (5 * 60 * 1000 * 1000) (exponentialBackoff (20 * 1000))
retryHandler status =
logRetries
(\(_ :: IOException) -> pure True) -- Don’t try to be clever, just retry
(\shouldRetry err status -> IO.hPutStrLn IO.stderr $ defaultLogMsg shouldRetry err status)
status
downloadFile req manager url = HTTP.withResponse req manager $ \resp -> do
let body = HTTP.responseBody resp
IO.withBinaryFile (tmp </> (last $ Network.URI.pathSegments url)) IO.AppendMode $ \handle -> do
while (readFrom body) (writeTo handle)
verify_signatures :: FilePath -> FilePath -> String -> IO String verify_signatures :: FilePath -> FilePath -> String -> IO String
verify_signatures bash_lib tmp version_tag = do verify_signatures bash_lib tmp version_tag = do