From b0f154a451f5b23d574009950405c08bf2177d0d Mon Sep 17 00:00:00 2001
From: Shae Erisson <shae@scannedinavian.com>
Date: Wed, 28 Jun 2023 16:06:57 -0500
Subject: [PATCH] mapConcurrently when downloading shares
---
gbs-downloader.cabal | 2 ++
src/Tahoe/Download.hs | 3 ++-
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal
index 56b04e1..e2bc507 100644
--- a/gbs-downloader.cabal
+++ b/gbs-downloader.cabal
@@ -95,6 +95,7 @@ library
-- Other library packages from which modules are imported.
build-depends:
, aeson
+ , async
, base
, base32
, base64-bytestring
@@ -218,6 +219,7 @@ test-suite gbs-downloader-test
-- The entrypoint to the test suite.
main-is: Spec.hs
+ ghc-options: -threaded
-- Test dependencies.
build-depends:
diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index c5a64c4..dc7eafd 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -16,6 +16,7 @@ module Tahoe.Download (
getShareNumbers,
) where
+import Control.Concurrent.Async
import Control.Exception (Exception (displayException), SomeException, try)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bifunctor (Bifunctor (first, second))
@@ -121,7 +122,7 @@ executeDownloadTasks ::
-- | The results of all successful downloads.
m [DownloadedShare]
executeDownloadTasks storageIndex tasks = do
- downloadResults <- mapM (downloadShare storageIndex) tasks
+ downloadResults <- liftIO $ mapConcurrently (downloadShare storageIndex) tasks
pure . rights $ inject <$> downloadResults
where
inject (a, b) = (a,) <$> b
--
GitLab