chunking

This changed the storage format, not that it matters because nobody is
using it yet.

1 files changed, 61 insertions, 40 deletions

diff --git a/keysafe.hs b/keysafe.hs
index f417319..7ec211f 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
 
 {- Copyright 2016 Joey Hess <id@joeyh.name>
  -
@@ -26,6 +26,7 @@ import Data.Monoid
 import Control.DeepSeq
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as BU8
+import qualified Data.Set as S
 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
 
 main :: IO ()
@@ -80,15 +81,14 @@ backup storagelocations ui tunables secretkeysource secretkey = do
 		kek <- promptkek name
 		let sis = shareIdents tunables name secretkeysource
 		let cost = getCreationCost kek <> getCreationCost sis
-		r <- withProgress ui "Encrypting and storing data"
-			(encryptdesc cost) $ \setpercent -> do
+		r <- withProgressIncremental ui "Encrypting and storing data"
+			(encryptdesc cost) $ \addpercent -> do
 				let esk = encrypt tunables kek secretkey
 				shares <- genShares esk tunables
-				_ <- esk `deepseq` setpercent 25
-				_ <- sis `deepseq` setpercent 50
-				let step = 50 `div` length shares
-				let percentsteps = map setpercent [50+step, 50+step*2..100]
-				storeShares storagelocations sis (zip percentsteps shares)
+				_ <- esk `deepseq` addpercent 25
+				_ <- sis `seq` addpercent 25
+				let step = 50 `div` sum (map S.size shares)
+				storeShares storagelocations sis shares (addpercent step)
 		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)
@@ -188,22 +188,35 @@ restore storagelocations ui possibletunables secretkeydest = do
 		<$> promptPassword ui True "Enter password" passworddesc
 	
 	let mksis tunables = shareIdents tunables name secretkeydest
-	(tunables, shares) <- downloadShares storagelocations ui mksis possibletunables
-
-	let candidatekeys = candidateKeyEncryptionKeys tunables name password
-	let cost = getCreationCost candidatekeys 
-		<> castCost (getDecryptionCost candidatekeys)
-	case combineShares tunables shares of
-		Left e -> showError ui e
-		Right esk -> withProgress ui "Decrypting"
-			(decryptdesc cost) $ \setpercent -> do
-				case decrypt candidatekeys esk of
-					Nothing -> showError ui "Decryption failed! Unknown why it would fail at this point."
-					Just secretkey -> do
-						setpercent 100
-						writeSecretKey secretkeydest secretkey
-						showInfo ui "Success" "Your secret key successfully restored!"
+	r <- downloadInitialShares storagelocations ui mksis possibletunables
+	case r of
+		Nothing -> showError ui "No shares could be downloaded. Perhaps you entered the wrong name or password?"
+		Just (tunables, shares, sis) -> do
+			let candidatekeys = candidateKeyEncryptionKeys tunables name password
+			let cost = getCreationCost candidatekeys 
+				<> castCost (getDecryptionCost candidatekeys)
+			case combineShares tunables [shares] of
+				Left e -> showError ui e
+				Right esk -> withProgress ui "Decrypting"
+					(decryptdesc cost) $ \setpercent ->
+						go tunables [shares] sis setpercent $
+							tryDecrypt candidatekeys esk
   where
+	go tunables firstshares sis setpercent r = case r of
+		DecryptFailed -> showError ui "Decryption failed! Unknown why it would fail at this point."
+		DecryptSuccess secretkey -> do
+			_ <- setpercent 100
+			writeSecretKey secretkeydest secretkey
+			showInfo ui "Success" "Your secret key successfully restored!"
+		DecryptIncomplete kek -> do
+			-- Download shares for another chunk.
+			(nextshares, sis') <- retrieveShares storagelocations sis (return ())
+			let shares = firstshares ++ [nextshares]
+			case combineShares tunables shares of
+				Left e -> showError ui e
+				Right esk -> 
+					go tunables shares sis' setpercent $
+						decrypt kek esk
 	namedesc = unlines
 		[ "When you backed up your secret key, you entered some information."
 		, "To restore it, you'll need to remember what you entered back then."
@@ -214,6 +227,7 @@ restore storagelocations ui possibletunables secretkeydest = do
 		[ "What other name did you enter when you backed up your secret key?"
 		, ""
 		, "Back then, you were given some suggestions, like these:"
+		, ""
 		, otherNameSuggestions
 		]
 	passworddesc = unlines
@@ -228,24 +242,31 @@ restore storagelocations ui possibletunables secretkeydest = do
 		, "Please wait..."
 		]
 
-downloadShares :: StorageLocations -> UI -> (Tunables -> ShareIdents) -> [Tunables] -> IO (Tunables, [Share])
-downloadShares storagelocations ui mksis possibletunables =
-	withProgress ui "Downloading encrypted data" message $
-		go possibletunables
+-- | Try each possible tunable until the initial set of 
+-- shares are found, the return the shares, and
+-- ShareIdents to download subsequent sets.
+downloadInitialShares
+	:: StorageLocations
+	-> UI
+	-> (Tunables -> ShareIdents)
+	-> [Tunables]
+	-> IO (Maybe (Tunables, S.Set Share, ShareIdents))
+downloadInitialShares storagelocations ui mksis possibletunables =
+	withProgressIncremental ui "Downloading encrypted data" message $ \addpercent -> do
+		go possibletunables addpercent
   where
-	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.
-		_ <- l `deepseq` setpercent 50
-		let step = 50 `div` length l
-		let percentsteps = map setpercent [50+step, 50+step*2..100]
-		shares <- retrieveShares storagelocations (zip percentsteps l)
-		if null shares
-			then go othertunables setpercent
-			else return (tunables, shares)
+	go [] _ = return Nothing
+	go (tunables:othertunables) addpercent = do
+		-- Just calculating the hash to generate the stream of idents
+		-- probably takes most of the time.
+		let !sis = mksis tunables
+		addpercent 50
+		let m = totalObjects (shareParams tunables)
+		let step = 50 `div` m
+		(shares, sis') <- retrieveShares storagelocations sis (addpercent step)
+		if S.null shares
+			then go othertunables addpercent
+			else return $ Just (tunables, shares, sis')
 
 	possiblesis = map mksis possibletunables
 	message = unlines