diff options
Diffstat (limited to 'keysafe.hs')
-rw-r--r-- | keysafe.hs | 55 |
1 files changed, 48 insertions, 7 deletions
@@ -35,9 +35,12 @@ main :: IO () main = do cmdline <- CmdLine.get ui <- selectUI (CmdLine.gui cmdline) - let tunables = if CmdLine.testMode cmdline - then testModeTunables - else defaultTunables + tunables <- if CmdLine.testMode cmdline + then do + showInfo ui "Test mode" + "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" + return testModeTunables + else return defaultTunables mode <- CmdLine.selectMode cmdline go mode (CmdLine.secretkeysource cmdline) tunables ui where @@ -89,11 +92,26 @@ backup ui tunables secretkeysource secretkey = do <$> promptName ui "Enter name" namedesc username validateName kek <- promptkek name - let esk = encrypt tunables kek secretkey let sis = shardIdents tunables name secretkeysource - shards <- genShards esk tunables - print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards) - print =<< obscureShards localFiles + let cost = getCreationCost kek <> getCreationCost sis + r <- withProgress ui "Encrypting and storing data" + (encryptdesc cost) $ \setpercent -> do + let esk = encrypt tunables kek secretkey + shards <- genShards esk tunables + _ <- esk `deepseq` setpercent 25 + _ <- sis `deepseq` setpercent 50 + let step = 50 `div` length shards + let percentsteps = map setpercent [50+step, 50+step*2..100] + storeShards 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) + StoreAlreadyExists -> do + showError ui $ unlines + [ "Another secret key is already being stored under the name you entered." + , "Please try again with a different name." + ] + backup ui tunables secretkeysource secretkey where promptkek name = do password <- fromMaybe (error "Aborting on no password") @@ -139,6 +157,14 @@ backup ui tunables secretkeysource secretkey = do crackdesc crackcost thisyear = unlines $ "Rough estimate of the cost to crack your password: " : costOverTimeTable crackcost thisyear + encryptdesc cost = unlines + [ "This will probably take around " ++ showCostMinutes cost + , "" + , "(It's a feature that this takes a while; it makes it hard" + , "for anyone to find your data, or crack your password.)" + , "" + , "Please wait..." + ] restore :: UI -> SecretKeySource -> IO () restore ui secretkeydest = do @@ -164,6 +190,7 @@ restore ui secretkeydest = do setpercent 100 -- TODO save print secretkey + showInfo ui "Success" "Your secret key successfully restored!" where -- TODO: derive by probing to find objects tunables = testModeTunables -- defaultTunables @@ -185,6 +212,20 @@ restore ui secretkeydest = do , "Please wait..." ] +storeShards :: ShardIdents -> [(IO (), Shard)] -> IO StoreResult +storeShards sis shards = do + r <- go (zip (getIdents sis) shards) + _ <- obscureShards localFiles + return r + where + go [] = return StoreSuccess + go ((i,(showprogress, s)):rest) = do + r <- storeShard localFiles i s + _ <- showprogress + case r of + StoreSuccess -> go rest + _ -> return r + downloadShards :: UI -> ShardIdents -> IO [Maybe Shard] downloadShards ui sis = bracket_ (return ()) cleanup (withProgress ui "Downloading encrypted data" message go) |