From b40d441c52f37584653e74fada9906cc8105c9f7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 6 Oct 2016 13:54:52 -0400
Subject: move level from Server to Storage

This allows local storage locations to have levels too, and also get
shuffled nicely.

This commit was sponsored by Ethan Aubin.
---
 Storage.hs | 29 +++++++++++++++--------------
 1 file changed, 15 insertions(+), 14 deletions(-)

(limited to 'Storage.hs')

diff --git a/Storage.hs b/Storage.hs
index 10e6bfe..de6eab3 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -13,14 +13,12 @@ import Types.Server
 import Types.Cost
 import Output
 import Share
-import Storage.Local
 import Storage.Network
 import Servers
 import Tunables
 import Data.Maybe
 import Data.List
 import Data.Monoid
-import System.FilePath
 import Control.Monad
 import Crypto.Random
 import System.Random
@@ -28,15 +26,11 @@ import Control.Concurrent.Thread.Delay
 import Control.Concurrent.Async
 import qualified Data.Set as S
 import Network.Wai.Handler.Warp (Port)
+import System.Random.Shuffle
 
 networkStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations
-networkStorageLocations d = StorageLocations . map (networkStorage d)
-	<$> shuffleServers networkServers
-
-localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations
-localStorageLocations d = StorageLocations $
-	map (localStorage (storageDir d) . ("local" </>) . show)
-		[1..100 :: Int]
+networkStorageLocations = shuffleStorageLocations 
+	. StorageLocations . serverList
 
 type UpdateProgress = IO ()
 
@@ -67,12 +61,11 @@ problemStoringIn (StorageLocations locs) tunables
 		, "If you continue, some of the following less secure"
 		, "servers will be used:"
 		, ""
-		] ++ map descserver alternates
+		] ++ map descserver (mapMaybe getServer alternates)
 	| otherwise = Nothing
   where
 	ps = shareParams tunables
-	getlevel sl = filter (\s -> serverLevel s == sl) $
-		mapMaybe getServer locs
+	getlevel sl = filter (\s -> storageLevel s == sl) locs
 	alternates = getlevel Alternate
 	descserver (Server { serverName = ServerName n, serverDesc = d}) = 
 		"* " ++ n ++ " -- " ++ d
@@ -188,8 +181,8 @@ storeChaff hn port delayseconds = forever $ do
 	mapConcurrently (go sis rng')
 		[1..totalObjects (shareParams testModeTunables)]
   where
-	server = networkStorage Nothing $ 
-		Server (ServerName hn) Untrusted [ServerAddress hn port] "chaff server"
+	server = networkStorage Untrusted Nothing $ 
+		Server (ServerName hn) [ServerAddress hn port] "chaff server"
 	objsize = objectSize defaultTunables * shareOverhead defaultTunables
 	maxmsdelay = ceiling $ 1000000 * fromMaybe 0 delayseconds
 	go sis rng n = do
@@ -205,3 +198,11 @@ storeChaff hn port delayseconds = forever $ do
 			StoreSuccess -> progress "+"
 			_ -> progress "!"
 		go sis' rng' n
+
+-- | Shuffles the list, keeping Recommended first, then
+-- Alternate, and finally Untrusted.
+shuffleStorageLocations :: StorageLocations -> IO StorageLocations
+shuffleStorageLocations (StorageLocations l) = 
+	StorageLocations . concat <$> mapM shuf [minBound..maxBound]
+  where
+	shuf sl = shuffleM (filter (\s -> storageLevel s == sl) l)
-- 
cgit v1.2.3