diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-10-06 13:54:52 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-10-06 13:54:52 -0400 |
commit | b40d441c52f37584653e74fada9906cc8105c9f7 (patch) | |
tree | 737396d6ab61212cad52555c7bc99dedd167b330 /Storage.hs | |
parent | 54d3bfbb98958cb49399f1a7f092fa43593ef4c8 (diff) | |
download | keysafe-b40d441c52f37584653e74fada9906cc8105c9f7.tar.gz |
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.
Diffstat (limited to 'Storage.hs')
-rw-r--r-- | Storage.hs | 29 |
1 files changed, 15 insertions, 14 deletions
@@ -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) |