check server levels

Don't upload more than neededshares-1 shares to Alternate servers without
asking the user if they want to do this potentially dangerous action.

Never allow uploads to Untrusted servers.

This commit was sponsored by Ignacio on Patreon.

1 files changed, 37 insertions, 0 deletions

diff --git a/Storage.hs b/Storage.hs
index 484df56..59da0d1 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -40,6 +40,43 @@ localStorageLocations d = StorageLocations $
 
 type UpdateProgress = IO ()
 
+data StorageProblem
+	= FatalProblem String
+	| OverridableProblem String
+	deriving (Show)
+
+-- | Check if there is a problem with storing shares amoung the provided
+-- storage locations, assuming that some random set of the storage
+-- locations will be used.
+--
+-- It's always a problem to store anything on an Untrusted server.
+--
+-- It should not be possible to reconstruct the encrypted
+-- secret key using only objects from Alternate servers, so
+-- fewer than neededObjects Alternate servers can be used.
+problemStoringIn :: StorageLocations -> Tunables -> Maybe StorageProblem
+problemStoringIn (StorageLocations locs) tunables
+	| not (null (getlevel Untrusted)) || length locs < totalObjects ps = 
+		Just $ FatalProblem
+			"Not enough servers are available to store your encrypted secret key."
+	| length alternates >= neededObjects ps = Just $ OverridableProblem $ unlines $
+		[ "Not enough keysafe servers are available that can store"
+		, "your encrypted secret key with a recommended level of"
+		, "security."
+		, "" 
+		, "If you continue, some of the following less secure"
+		, "servers will be used:"
+		, ""
+		] ++ map descserver alternates
+	| otherwise = Nothing
+  where
+	ps = shareParams tunables
+	getlevel sl = filter (\s -> serverLevel s == sl) $
+		mapMaybe getServer locs
+	alternates = getlevel Alternate
+	descserver (Server { serverName = ServerName n, serverDesc = d}) = 
+		"* " ++ n ++ " -- " ++ d
+
 -- | Stores the shares amoung the storage locations. Each location
 -- gets at most one share from each set.
 --