From e1b26d27ad1a766597bdc224aefb8f4d88495b79 Mon Sep 17 00:00:00 2001 From: Gary Verhaegen Date: Fri, 16 Oct 2020 11:37:50 +0200 Subject: [PATCH] ci/cron/check: limit simultaneous downloads (#7703) As requested in review of #7696. CHANGELOG_BEGIN CHANGELOG_END --- ci/cron/src/Main.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/ci/cron/src/Main.hs b/ci/cron/src/Main.hs index 0b31a161548..159b812da62 100644 --- a/ci/cron/src/Main.hs +++ b/ci/cron/src/Main.hs @@ -8,6 +8,7 @@ import Data.Semigroup ((<>)) import System.FilePath.Posix (()) import qualified Control.Concurrent.Async +import qualified Control.Concurrent.QSem import qualified Control.Exception import qualified Control.Monad as Control import qualified Control.Monad.Extra @@ -23,11 +24,11 @@ import qualified Data.Ord import qualified Data.SemVer import qualified Data.Set as Set import qualified Data.Text as Text -import qualified Options.Applicative as Opt import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.TLS as TLS import qualified Network.HTTP.Types.Status as Status import qualified Network.URI +import qualified Options.Applicative as Opt import qualified System.Directory as Directory import qualified System.Exit as Exit import qualified System.IO.Extra as IO @@ -270,13 +271,18 @@ docs = do download_assets :: FilePath -> GitHubRelease -> IO () download_assets tmp release = do - Control.Concurrent.Async.forConcurrently_ (map uri $ assets release) (\url -> do + tokens <- Control.Concurrent.QSem.newQSem 20 + Control.Concurrent.Async.forConcurrently_ (map uri $ assets release) (\url -> + Control.Exception.bracket_ + (Control.Concurrent.QSem.waitQSem tokens) + (Control.Concurrent.QSem.signalQSem tokens) + (do shell_ $ unlines ["bash -c '", "set -euo pipefail", "eval \"$(dev-env/bin/dade assist)\"", "cd \"" <> tmp <> "\"", "wget --quiet \"" <> show url <> "\"", - "'"]) + "'"])) verify_signatures :: FilePath -> FilePath -> String -> IO String verify_signatures bash_lib tmp version_tag = do