From b66b497244ab2a094bec5c3a678f448f23c8404d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 17 Aug 2016 16:09:06 -0400 Subject: probe knownTunings on restore --- keysafe.hs | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) (limited to 'keysafe.hs') 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.)" -- cgit v1.2.3