probe knownTunings on restore

1 files changed, 29 insertions, 16 deletions

diff --git a/keysafe.hs b/keysafe.hs
index efdd068..3551cb4 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -53,12 +53,12 @@ dispatch cmdline ui tunables = do
 		backup storage ui tunables secretkeysource
 			=<< getSecretKey secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
-		restore storage ui secretkeydest
+		restore storage ui (CmdLine.testMode cmdline) secretkeydest
 	go CmdLine.Backup Nothing =
 		backup storage ui tunables Gpg.anyKey
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
-		restore storage ui Gpg.anyKey
+		restore storage ui (CmdLine.testMode cmdline) Gpg.anyKey
 	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 
@@ -143,8 +143,8 @@ backup storage ui tunables secretkeysource secretkey = do
 		, "Please wait..."
 		]
 
-restore :: Storage -> UI -> SecretKeySource -> IO ()
-restore storage ui secretkeydest = do
+restore :: Storage -> UI -> Bool -> SecretKeySource -> IO ()
+restore storage ui testmode secretkeydest = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
 		<$> promptName ui "Enter name"
@@ -152,8 +152,9 @@ restore storage ui secretkeydest = do
 	password <- fromMaybe (error "Aborting on no password") 
 		<$> promptPassword ui True "Enter password" passworddesc
 	
-	let sis = shardIdents tunables name secretkeydest
-	shards <- catMaybes <$> downloadShards storage ui sis
+	let mksis tunables = shardIdents tunables name secretkeydest
+	(tunables, shards) <- downloadShards storage ui mksis possibletunables
+
 	let candidatekeys = candidateKeyEncryptionKeys tunables name password
 	let cost = getCreationCost candidatekeys 
 		<> castCost (getDecryptionCost candidatekeys)
@@ -168,8 +169,9 @@ restore storage ui secretkeydest = do
 						writeSecretKey secretkeydest secretkey
 						showInfo ui "Success" "Your secret key successfully restored!"
   where
-	-- TODO: derive by probing to find objects
-	tunables = testModeTunables -- defaultTunables
+	possibletunables
+		| testmode = [testModeTunables]
+		| otherwise = map snd knownTunings
 	namedesc = unlines
 		[ "When you backed up your secret key, you entered a name and a password."
 		, "Now it's time to remember what you entered back then."
@@ -188,11 +190,17 @@ restore storage ui secretkeydest = do
 		, "Please wait..."
 		]
 
-downloadShards :: Storage -> UI -> ShardIdents -> IO [Maybe Shard]
-downloadShards storage ui sis = bracket_ (return ()) cleanup
-	(withProgress ui "Downloading encrypted data" message go)
+downloadShards :: Storage -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard])
+downloadShards storage ui mksis possibletunables =
+	bracket_ setup cleanup download
   where
-	go setpercent = do
+	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
 		let l = zip [1..] (getIdents sis)
 		-- Just calculating the idents probably takes
 		-- most of the time.
@@ -200,20 +208,25 @@ downloadShards storage ui sis = bracket_ (return ()) cleanup
 		let step = 50 `div` length l
 		let percentsteps = [50+step, 50+step*2..100]
 
-		forM (zip percentsteps l) $ \(pct, (n, i)) -> do
+		mshards <- forM (zip percentsteps l) $ \(pct, (n, i)) -> do
 			r <- retrieveShard storage n i
-			_ <- setpercent pct
 			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
-	cleanup = obscureShards storage
+		let shards = catMaybes mshards
+		if null shards
+			then go othertunables setpercent
+			else return (tunables, shards)
+
+	possiblesis = map mksis possibletunables
 	message = unlines
 		[ "This will probably take around "
-			++ showCostMinutes (getCreationCost sis)
+			++ showCostMinutes (mconcat $ map getCreationCost possiblesis)
 		, ""
 		, "(It's a feature that this takes a while; it makes it hard"
 		, "for anyone else to find your data.)"