From a1d5de397cd1b12080e4652965591827e6d50c86 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 26 Sep 2016 14:11:32 -0400 Subject: Randomize the server list. May help avoid some correlations. Once there are many servers, will spread the load out amoung them. This commit was sponsored by Ethan Aubin. --- Storage.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'Storage.hs') diff --git a/Storage.hs b/Storage.hs index b40a84a..c082c38 100644 --- a/Storage.hs +++ b/Storage.hs @@ -29,9 +29,9 @@ import Control.Concurrent.Async import qualified Data.Set as S import Network.Wai.Handler.Warp (Port) -networkStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations -networkStorageLocations d = StorageLocations $ - map (networkStorage d) networkServers +networkStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations +networkStorageLocations d = StorageLocations . map (networkStorage d) + <$> shuffleServers networkServers localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations localStorageLocations d = StorageLocations $ @@ -125,12 +125,12 @@ retrieveShares (StorageLocations locs) sis updateprogress = do -- | Returns descriptions of any failures. tryUploadQueued :: Maybe LocalStorageDirectory -> IO [String] tryUploadQueued d = do + StorageLocations locs <- networkStorageLocations d results <- forM locs $ \loc -> case uploadQueue loc of Nothing -> return [] Just q -> moveShares q loc return $ processresults (concat results) [] where - StorageLocations locs = networkStorageLocations d processresults [] c = nub c processresults (StoreSuccess:rs) c = processresults rs c processresults (StoreFailure e:rs) c = processresults rs (e:c) @@ -152,7 +152,7 @@ storeChaff hn port delayseconds = forever $ do [1..totalObjects (shareParams testModeTunables)] where server = networkStorage Nothing $ - Server (ServerName hn) Untrusted [ServerAddress hn port] + Server (ServerName hn) Untrusted [ServerAddress hn port] "chaff server" objsize = objectSize defaultTunables * shareOverhead defaultTunables maxmsdelay = ceiling $ 1000000 * fromMaybe 0 delayseconds go sis rng n = do -- cgit v1.2.3