diff options
Diffstat (limited to 'keysafe.hs')
| -rw-r--r-- | keysafe.hs | 27 |
1 files changed, 21 insertions, 6 deletions
@@ -88,15 +88,31 @@ dispatch cmdline ui tunables possibletunables = do backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () backup cmdline ui tunables secretkeysource secretkey = do installAutoStartFile + + let m = totalObjects (shareParams tunables) + StorageLocations allocs <- cmdLineStorageLocations cmdline + let locs = StorageLocations (take m allocs) + case problemStoringIn locs tunables of + Nothing -> return () + Just (FatalProblem p) -> do + showError ui p + error "aborting" + Just (OverridableProblem p) -> do + ok <- promptQuestion ui "Server problem" + p "Continue anyway?" + if ok + then return () + else error "aborting" + username <- userName Name theirname <- case CmdLine.name cmdline of Just n -> pure n Nothing -> fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" usernamedesc (Just username) validateName - go theirname + go theirname locs where - go theirname = do + go theirname locs = do cores <- fromMaybe 1 <$> getNumCores Name othername <- case CmdLine.name cmdline of Just n -> pure n @@ -107,16 +123,15 @@ backup cmdline ui tunables secretkeysource secretkey = do (kek, passwordentropy) <- promptpassword name let sis = shareIdents tunables name secretkeysource let cost = getCreationCost kek <> getCreationCost sis - (r, queued, locs) <- withProgressIncremental ui "Encrypting and storing data" + (r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data" (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey shares <- genShares esk tunables _ <- esk `deepseq` addpercent 25 _ <- sis `seq` addpercent 25 let step = 50 `div` sum (map S.size shares) - locs <- cmdLineStorageLocations cmdline storeShares locs sis shares (addpercent step) - backuplog <- mkBackupLog $ backupMade (mapMaybe getServer locs) secretkeysource passwordentropy + backuplog <- mkBackupLog $ backupMade (mapMaybe getServer usedlocs) secretkeysource passwordentropy case r of StoreSuccess -> do storeBackupLog backuplog @@ -132,7 +147,7 @@ backup cmdline ui tunables secretkeysource secretkey = do [ "Another secret key is already being stored under the name you entered." , "Please try again with a different name." ] - go theirname + go theirname locs promptpassword name = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc |