From b40d441c52f37584653e74fada9906cc8105c9f7 Mon Sep 17 00:00:00 2001 From: Joey Hess 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. --- Servers.hs | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) (limited to 'Servers.hs') diff --git a/Servers.hs b/Servers.hs index 08789ce..ab31838 100644 --- a/Servers.hs +++ b/Servers.hs @@ -6,8 +6,8 @@ module Servers where import Types.Server -import Servant.Client -import System.Random.Shuffle +import Types.Storage +import Storage.Network -- | Keysafe's server list. -- @@ -17,29 +17,20 @@ import System.Random.Shuffle -- -- Also, avoid changing the ServerName of any server, as that will -- cause any uploads queued under that name to not go through. -networkServers :: [Server] -networkServers = - [ Server (ServerName "keysafe.joeyh.name") Alternate +serverList :: Maybe LocalStorageDirectory -> [Storage] +serverList d = + [ mk Alternate $ Server (ServerName "keysafe.joeyh.name") [ServerAddress "vzgrspuxbtnlrtup.onion" 4242] "Provided by Joey Hess. Digital Ocean VPS, located in Indonesia" - , Server (ServerName "keysafe.puri.sm") Alternate + , mk Alternate $ Server (ServerName "keysafe.puri.sm") [] "Purism server is not yet deployed, but planned." - , Server (ServerName "thirdserver") Alternate -- still being vetted + -- still being vetted + , mk Alternate $ Server (ServerName "thirdserver") [ServerAddress "eqi7glyxe5ravak5.onion" 4242] "Provided by Marek Isalski at Faelix. Currently located in UK, but planned move to CH" ] - --- | Shuffles the server list, keeping Recommended first, then --- Alternate, and finally Untrusted. -shuffleServers :: [Server] -> IO [Server] -shuffleServers l = concat <$> mapM shuf [minBound..maxBound] - where - shuf sl = shuffleM (filter (\s -> serverLevel s == sl) l) - -serverUrls :: Server -> [BaseUrl] -serverUrls srv = map go (serverAddress srv) where - go (ServerAddress addr port) = BaseUrl Http addr port "" + mk l s = networkStorage l d s -- cgit v1.2.3