add support for multiple storage locattions

also, server upload queues in ~/.keysafe

1 files changed, 23 insertions, 38 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 2ac765f..c1ed35a 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -23,10 +23,7 @@ import Data.Maybe
 import Data.Time.Clock
 import Data.Time.Calendar
 import Data.Monoid
-import Control.Monad
 import Control.DeepSeq
-import Control.Exception
-import System.IO
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as BU8
 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
@@ -42,29 +39,31 @@ main = do
 				"Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!"
 			return (mkt testModeTunables, [mkt testModeTunables])
 		else return (mkt defaultTunables, map (mkt . snd) knownTunings)
-	dispatch cmdline ui tunables possibletunables
+	storagelocations <- if CmdLine.localstorage cmdline
+		then return localStorageLocations
+		else allStorageLocations
+	dispatch cmdline ui storagelocations tunables possibletunables
 
-dispatch :: CmdLine.CmdLine -> UI -> Tunables -> [Tunables] -> IO ()
-dispatch cmdline ui tunables possibletunables = do
+dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO ()
+dispatch cmdline ui storagelocations tunables possibletunables = do
 	mode <- CmdLine.selectMode cmdline
 	go mode (CmdLine.secretkeysource cmdline)
   where
-	storage = CmdLine.storage cmdline
 	go CmdLine.Backup (Just secretkeysource) =
-		backup storage ui tunables secretkeysource
+		backup storagelocations ui tunables secretkeysource
 			=<< getSecretKey secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
-		restore storage ui possibletunables secretkeydest
+		restore storagelocations ui possibletunables secretkeydest
 	go CmdLine.Backup Nothing =
-		backup storage ui tunables Gpg.anyKey
+		backup storagelocations ui tunables Gpg.anyKey
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
-		restore storage ui possibletunables Gpg.anyKey
+		restore storagelocations ui possibletunables Gpg.anyKey
 	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 
-backup :: Storage -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
-backup storage ui tunables secretkeysource secretkey = do
+backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
+backup storagelocations ui tunables secretkeysource secretkey = do
 	username <- userName
 	Name theirname <- fromMaybe (error "Aborting on no username") 
 		<$> promptName ui "Enter your name"
@@ -84,7 +83,7 @@ backup storage ui tunables secretkeysource secretkey = do
 			_ <- sis `deepseq` setpercent 50
 			let step = 50 `div` length shards
 			let percentsteps = map setpercent [50+step, 50+step*2..100]
-			storeShards storage sis (zip percentsteps shards)
+			storeShards storagelocations sis (zip percentsteps shards)
 	case r of
 		StoreSuccess -> showInfo ui "Success" "Your secret key successfully encrypted and backed up."
 		StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s)
@@ -93,7 +92,7 @@ backup storage ui tunables secretkeysource secretkey = do
 				[ "Another secret key is already being stored under the name you entered."
 				, "Please try again with a different name."
 				]
-			backup storage ui tunables secretkeysource secretkey
+			backup storagelocations ui tunables secretkeysource secretkey
   where
 	promptkek name = do
 		password <- fromMaybe (error "Aborting on no password") 
@@ -168,8 +167,8 @@ otherNameSuggestions = unlines $ map ("  * " ++)
 	, "Your college roomate."
 	]
 
-restore :: Storage -> UI -> [Tunables] -> SecretKeySource -> IO ()
-restore storage ui possibletunables secretkeydest = do
+restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO ()
+restore storagelocations ui possibletunables secretkeydest = do
 	username <- userName
 	Name theirname <- fromMaybe (error "Aborting on no username") 
 		<$> promptName ui "Enter your name"
@@ -182,7 +181,7 @@ restore storage ui possibletunables secretkeydest = do
 		<$> promptPassword ui True "Enter password" passworddesc
 	
 	let mksis tunables = shardIdents tunables name secretkeydest
-	(tunables, shards) <- downloadShards storage ui mksis possibletunables
+	(tunables, shards) <- downloadShards storagelocations ui mksis possibletunables
 
 	let candidatekeys = candidateKeyEncryptionKeys tunables name password
 	let cost = getCreationCost candidatekeys 
@@ -222,14 +221,11 @@ restore storage ui possibletunables secretkeydest = do
 		, "Please wait..."
 		]
 
-downloadShards :: Storage -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard])
-downloadShards storage ui mksis possibletunables =
-	bracket_ setup cleanup download
+downloadShards :: StorageLocations -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard])
+downloadShards storagelocations ui mksis possibletunables =
+	withProgress ui "Downloading encrypted data" message $
+		go possibletunables
   where
-	setup = return ()
-	download = withProgress ui "Downloading encrypted data" message (go possibletunables)
-	cleanup = obscureShards storage
-
 	go [] _ = return (defaultTunables, [])
 	go (tunables:othertunables) setpercent = do
 		let sis = mksis tunables
@@ -238,19 +234,8 @@ downloadShards storage ui mksis possibletunables =
 		-- most of the time.
 		_ <- l `deepseq` setpercent 50
 		let step = 50 `div` length l
-		let percentsteps = [50+step, 50+step*2..100]
-
-		mshards <- forM (zip percentsteps l) $ \(pct, (n, i)) -> do
-			r <- retrieveShard storage n i
-			case r of
-				RetrieveSuccess s -> do
-					_ <- setpercent pct
-					return (Just s)
-				RetrieveFailure f -> do
-					hPutStrLn stderr $
-						"warning: retrieval of shard " ++ show n ++ " failed: " ++ f
-					return Nothing
-		let shards = catMaybes mshards
+		let percentsteps = map setpercent [50+step, 50+step*2..100]
+		shards <- retrieveShards storagelocations (zip percentsteps l)
 		if null shards
 			then go othertunables setpercent
 			else return (tunables, shards)