diff options
| -rw-r--r-- | CmdLine.hs | 18 | ||||
| -rw-r--r-- | Serialization.hs | 8 | ||||
| -rw-r--r-- | Share.hs (renamed from Shard.hs) | 53 | ||||
| -rw-r--r-- | Storage.hs | 60 | ||||
| -rw-r--r-- | Storage/Local.hs | 64 | ||||
| -rw-r--r-- | Storage/Network.hs | 14 | ||||
| -rw-r--r-- | TODO | 4 | ||||
| -rw-r--r-- | Tunables.hs | 10 | ||||
| -rw-r--r-- | Types.hs | 10 | ||||
| -rw-r--r-- | Types/Storage.hs | 20 | ||||
| -rw-r--r-- | keysafe.cabal | 2 | ||||
| -rw-r--r-- | keysafe.hs | 28 |
12 files changed, 146 insertions, 145 deletions
@@ -18,7 +18,7 @@ data CmdLine = CmdLine , localstorage :: Bool , gui :: Bool , testMode :: Bool - , customShardParams :: Maybe ShardParams + , customShareParams :: Maybe ShareParams } data Mode = Backup | Restore | UploadQueued | Benchmark @@ -31,7 +31,7 @@ parse = CmdLine <*> localstorageswitch <*> guiswitch <*> testmodeswitch - <*> optional (ShardParams <$> totalobjects <*> neededobjects) + <*> optional (ShareParams <$> totalobjects <*> neededobjects) where backup = flag' Backup ( long "backup" @@ -72,14 +72,14 @@ parse = CmdLine <> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise." ) totalobjects = option auto - ( long "totalshards" + ( long "totalshares" <> metavar "M" - <> help ("Configure the number of shards to split encrypted secret key into. Default: " ++ show (totalObjects (shardParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") + <> help ("Configure the number of shares to split encrypted secret key into. Default: " ++ show (totalObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") ) neededobjects = option auto - ( long "neededshards" + ( long "neededshares" <> metavar "N" - <> help ("Configure the number of shards needed to restore. Default: " ++ show (neededObjects (shardParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") + <> help ("Configure the number of shares needed to restore. Default: " ++ show (neededObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") ) get :: IO CmdLine @@ -102,7 +102,7 @@ selectMode cmdline = case mode cmdline of present True = Backup present False = Restore -customizeShardParams :: CmdLine -> Tunables -> Tunables -customizeShardParams cmdline t = case customShardParams cmdline of +customizeShareParams :: CmdLine -> Tunables -> Tunables +customizeShareParams cmdline t = case customShareParams cmdline of Nothing -> t - Just ps -> t { shardParams = ps } + Just ps -> t { shareParams = ps } diff --git a/Serialization.hs b/Serialization.hs index 8177821..eb6394c 100644 --- a/Serialization.hs +++ b/Serialization.hs @@ -44,10 +44,10 @@ instance Encodable StorableObject where toByteString (StorableObject b) = b fromByteString = Just . StorableObject --- | A shard is serialized without its shard number. This prevents --- an attacker from partitioning their shards by shard number. -instance Encodable Shard where - toByteString (Shard _n o) = toByteString o +-- | A share is serialized without its share number. This prevents +-- an attacker from partitioning their shares by share number. +instance Encodable Share where + toByteString (Share _n o) = toByteString o fromByteString _ = Nothing sepChar :: Word8 @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Shard where +module Share where import Types import Tunables @@ -21,30 +21,31 @@ import qualified Data.Text.Encoding as E import Data.Monoid import Control.DeepSeq -data ShardIdents = ShardIdents +data ShareIdents = ShareIdents { getIdents :: [StorableObjectIdent] + -- ^ An infinite list of idents to use for shares. , identsCreationCost :: Cost CreationOp , identsBruteForceCalc :: CostCalc BruteForceOp UnknownName } -instance NFData ShardIdents where +instance NFData ShareIdents where rnf = rnf . getIdents -instance HasCreationCost ShardIdents where +instance HasCreationCost ShareIdents where getCreationCost = identsCreationCost -instance Bruteforceable ShardIdents UnknownName where +instance Bruteforceable ShareIdents UnknownName where getBruteCostCalc = identsBruteForceCalc --- | Generates identifiers to use for storing shards. +-- | Generates identifiers to use for storing shares. -- -- This is an expensive operation, to make it difficult for an attacker --- to brute force known/guessed names and find matching shards. +-- to brute force known/guessed names and find matching shares. -- The keyid or filename is used as a salt, to avoid collisions -- when the same name is chosen for multiple keys. -shardIdents :: Tunables -> Name -> SecretKeySource -> ShardIdents -shardIdents tunables (Name name) keyid = - ShardIdents idents creationcost bruteforcecalc +shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents +shareIdents tunables (Name name) keyid = + ShareIdents idents creationcost bruteforcecalc where (ExpensiveHash creationcost basename) = expensiveHash hashtunables (Salt keyid) name @@ -52,37 +53,37 @@ shardIdents tunables (Name name) keyid = E.encodeUtf8 $ basename <> T.pack (show n) mksha :: B.ByteString -> Raaz.Base16 mksha = Raaz.encode . Raaz.sha256 - idents = map mk [1..totalObjects (shardParams tunables)] + idents = map mk [1..] bruteforcecalc = bruteForceLinearSearch creationcost hashtunables = nameGenerationHash $ nameGenerationTunable tunables -genShards :: EncryptedSecretKey -> Tunables -> IO [Shard] -genShards (EncryptedSecretKey esk _) tunables = do +genShares :: EncryptedSecretKey -> Tunables -> IO [Share] +genShares (EncryptedSecretKey esk _) tunables = do shares <- SS.encode - (neededObjects $ shardParams tunables) - (totalObjects $ shardParams tunables) + (neededObjects $ shareParams tunables) + (totalObjects $ shareParams tunables) (BL.fromStrict esk) - return $ map (\(n, share) -> Shard n (StorableObject $ encodeShare share)) + return $ map (\(n, share) -> Share n (StorableObject $ encodeShare share)) (zip [1..] shares) -combineShards :: Tunables -> [Shard] -> Either String EncryptedSecretKey -combineShards tunables shards - | null shards = - Left "No shards could be downloaded. Perhaps you entered the wrong name or password?" - | length shards < neededObjects (shardParams tunables) = - Left "Not enough are shards currently available to reconstruct your data." - | otherwise = Right $ mk $ SS.decode $ map decodeshard shards +combineShares :: Tunables -> [Share] -> Either String EncryptedSecretKey +combineShares tunables shares + | null shares = + Left "No shares could be downloaded. Perhaps you entered the wrong name or password?" + | length shares < neededObjects (shareParams tunables) = + Left "Not enough shares are currently available to reconstruct your data." + | otherwise = Right $ mk $ SS.decode $ map decodeshare shares where mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc - decodeshard (Shard sharenum so) = decodeShare sharenum sharesneeded $ + decodeshare (Share sharenum so) = decodeShare sharenum sharesneeded $ fromStorableObject so - sharesneeded = neededObjects $ shardParams tunables + sharesneeded = neededObjects $ shareParams tunables -- | This efficient encoding relies on the share using a finite field of -- size 256, so it maps directly to bytes. -- -- Note that this does not include the share number in the encoded --- bytestring. This prevents an attacker from partitioning their shards +-- bytestring. This prevents an attacker from partitioning their shares -- by share number. encodeShare :: SS.Share -> B.ByteString encodeShare = B.pack . map (fromIntegral . SS.shareValue) . SS.theShare @@ -7,7 +7,7 @@ module Storage (module Storage, module Types.Storage) where import Types import Types.Storage -import Shard +import Share import Storage.Local import Storage.Network import Data.Monoid @@ -28,60 +28,60 @@ localStorageLocations = StorageLocations $ type UpdateProgress = IO () --- | Stores the shards amoung the storage locations. Each location --- gets at most one shard. -storeShards :: StorageLocations -> ShardIdents -> [(UpdateProgress, Shard)] -> IO StoreResult -storeShards (StorageLocations locs) sis shards = do - (r, usedlocs) <- go locs [] Nothing (zip (getIdents sis) shards) - _ <- mapM_ obscureShards usedlocs +-- | Stores the shares amoung the storage locations. Each location +-- gets at most one share. +storeShares :: StorageLocations -> ShareIdents -> [(UpdateProgress, Share)] -> IO StoreResult +storeShares (StorageLocations locs) sis shares = do + (r, usedlocs) <- go locs [] Nothing (zip (getIdents sis) shares) + _ <- mapM_ obscureShares usedlocs return r where go _ usedlocs _ [] = return (StoreSuccess, usedlocs) go [] usedlocs lasterr _ = return (fromMaybe (StoreFailure "no storage locations") lasterr, usedlocs) go (loc:otherlocs) usedlocs _ tostore@((i,(showprogress, s)):rest) = do - r <- storeShard loc i s + r <- storeShare loc i s case r of StoreSuccess -> do _ <- showprogress go otherlocs (loc:usedlocs) Nothing rest StoreFailure _ -> go otherlocs usedlocs (Just r) tostore - -- Give up if any location complains a shard + -- Give up if any location complains a share -- already exists, because we have a name conflict. StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs) --- | Retrieves shards from among the storage locations, and returns all --- the shards it can find, which may not be all that were requested. +-- | Retrieves shares from among the storage locations, and returns all +-- the shares it can find, which may not be all that were requested. -- --- Assumes that each location only contains one shard. So, once a --- shard has been found on a location, can avoid asking that location --- for any other shards. -retrieveShards :: StorageLocations -> [(UpdateProgress, (ShardNum, StorableObjectIdent))] -> IO [Shard] -retrieveShards (StorageLocations locs) l = do - (shards, usedlocs, _unusedlocs) <- go locs [] l [] - _ <- mapM_ obscureShards usedlocs - return shards +-- Assumes that each location only contains one share. So, once a +-- share has been found on a location, can avoid asking that location +-- for any other shares. +retrieveShares :: StorageLocations -> [(UpdateProgress, (ShareNum, StorableObjectIdent))] -> IO [Share] +retrieveShares (StorageLocations locs) l = do + (shares, usedlocs, _unusedlocs) <- go locs [] l [] + _ <- mapM_ obscureShares usedlocs + return shares where - go unusedlocs usedlocs [] shards = return (shards, usedlocs, unusedlocs) - go [] usedlocs _ shards = return (shards, usedlocs, []) - go (loc:otherlocs) usedlocs (toretrieve@(updateprogress, (n, i)):rest) shards = do - r <- retrieveShard loc n i + go unusedlocs usedlocs [] shares = return (shares, usedlocs, unusedlocs) + go [] usedlocs _ shares = return (shares, usedlocs, []) + go (loc:otherlocs) usedlocs (toretrieve@(updateprogress, (n, i)):rest) shares = do + r <- retrieveShare loc n i case r of RetrieveSuccess s -> do _ <- updateprogress - go otherlocs (loc:usedlocs) rest (s:shards) + go otherlocs (loc:usedlocs) rest (s:shares) RetrieveFailure _ -> do - (shards', usedlocs', unusedlocs) <- - go otherlocs usedlocs [toretrieve] shards + (shares', usedlocs', unusedlocs) <- + go otherlocs usedlocs [toretrieve] shares -- May need to ask the location that didn't - -- have the shard for a later shard, but + -- have the share for a later share, but -- ask it last. This way, the first -- location on the list can't deny having - -- all shards and so learn the idents of + -- all shares and so learn the idents of -- all of them. - go (unusedlocs++[loc]) usedlocs' rest shards' + go (unusedlocs++[loc]) usedlocs' rest shares' uploadQueued :: IO () uploadQueued = do servers <- networkServers - forM_ servers $ \s -> moveShards (uploadQueue s) (networkStorage s) + forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s) diff --git a/Storage/Local.hs b/Storage/Local.hs index bbc3c41..510b8ef 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -27,11 +27,11 @@ newtype Section = Section String localStorage :: String -> Storage localStorage n = Storage - { storeShard = store section - , retrieveShard = retrieve section - , obscureShards = obscure section - , countShards = count section - , moveShards = move section + { storeShare = store section + , retrieveShare = retrieve section + , obscureShares = obscure section + , countShares = count section + , moveShares = move section } where section = Section n @@ -39,11 +39,11 @@ localStorage n = Storage uploadQueue :: Server -> Storage uploadQueue s = localStorage ("uploadqueue" </> serverName s) -store :: Section -> StorableObjectIdent -> Shard -> IO StoreResult +store :: Section -> StorableObjectIdent -> Share -> IO StoreResult store section i s = onError (StoreFailure . show) $ do - dir <- shardDir section + dir <- shareDir section createDirectoryIfMissing True dir - let dest = dir </> shardFile i + let dest = dir </> shareFile i exists <- doesFileExist dest if exists then return StoreAlreadyExists @@ -57,14 +57,14 @@ store section i s = onError (StoreFailure . show) $ do renameFile tmp dest return StoreSuccess -retrieve :: Section -> ShardNum -> StorableObjectIdent -> IO RetrieveResult +retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult retrieve section n i = onError (RetrieveFailure . show) $ do - dir <- shardDir section - fd <- openFd (dir </> shardFile i) ReadOnly Nothing defaultFileFlags + dir <- shareDir section + fd <- openFd (dir </> shareFile i) ReadOnly Nothing defaultFileFlags h <- fdToHandle fd b <- B.hGetContents h b `deepseq` hClose h - return $ RetrieveSuccess $ Shard n (StorableObject b) + return $ RetrieveSuccess $ Share n (StorableObject b) -- | Set atime and mtime to epoch, to obscure access and modification -- patterns. @@ -73,37 +73,37 @@ retrieve section n i = onError (RetrieveFailure . show) $ do -- times does at least set it to the current time, which makes all -- currently stored files look alike. -- --- Note that the contents of shards is never changed, so it's ok to set the +-- Note that the contents of shares is never changed, so it's ok to set the -- mtime to the epoch; backup programs won't be confused. obscure :: Section -> IO ObscureResult obscure section = onError (ObscureFailure . show) $ do - dir <- shardDir section - fs <- filter isShardFile <$> getDirectoryContents dir + dir <- shareDir section + fs <- filter isShareFile <$> getDirectoryContents dir mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs return ObscureSuccess count :: Section -> IO CountResult count section = onError (CountFailure . show) $ do - dir <- shardDir section - CountResult . genericLength . filter isShardFile + dir <- shareDir section + CountResult . genericLength . filter isShareFile <$> getDirectoryContents dir move :: Section -> Storage -> IO () move section storage = do - dir <- shardDir section + dir <- shareDir section fs <- getDirectoryContents dir - forM_ fs $ \f -> case fromShardFile f of + forM_ fs $ \f -> case fromShareFile f of Nothing -> return () Just i -> do - -- Use a dummy shard number of 0; it doesn't + -- Use a dummy share number of 0; it doesn't -- matter because we're not going to be - -- recombining the shard, just sending its contents + -- recombining the share, just sending its contents -- on the the server. r <- retrieve section 0 i case r of RetrieveFailure _ -> return () - RetrieveSuccess shard -> do - s <- storeShard storage i shard + RetrieveSuccess share -> do + s <- storeShare storage i share case s of StoreFailure _ -> return () _ -> removeFile f @@ -115,21 +115,21 @@ onError f a = do Left e -> f e Right r -> r -shardDir :: Section -> IO FilePath -shardDir (Section section) = do +shareDir :: Section -> IO FilePath +shareDir (Section section) = do u <- getUserEntryForID =<< getEffectiveUserID return $ homeDirectory u </> dotdir </> section -shardFile :: StorableObjectIdent -> FilePath -shardFile i = U8.toString (toByteString i) <> ext +shareFile :: StorableObjectIdent -> FilePath +shareFile i = U8.toString (toByteString i) <> ext -fromShardFile :: FilePath -> Maybe StorableObjectIdent -fromShardFile f - | isShardFile f = fromByteString $ U8.fromString $ dropExtension f +fromShareFile :: FilePath -> Maybe StorableObjectIdent +fromShareFile f + | isShareFile f = fromByteString $ U8.fromString $ dropExtension f | otherwise = Nothing -isShardFile :: FilePath -> Bool -isShardFile f = ext `isSuffixOf` f +isShareFile :: FilePath -> Bool +isShareFile f = ext `isSuffixOf` f ext :: String ext = ".keysafe" diff --git a/Storage/Network.hs b/Storage/Network.hs index 2b837dc..16ed97d 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -17,17 +17,17 @@ networkServers = return [] -- none yet networkStorage :: Server -> Storage networkStorage server = Storage - { storeShard = store server - , retrieveShard = retrieve server - , obscureShards = obscure server - , countShards = count server - , moveShards = move server + { storeShare = store server + , retrieveShare = retrieve server + , obscureShares = obscure server + , countShares = count server + , moveShares = move server } -store :: Server -> StorableObjectIdent -> Shard -> IO StoreResult +store :: Server -> StorableObjectIdent -> Share -> IO StoreResult store _server _i _s = return $ StoreFailure "network storage not implemented yet" -retrieve :: Server -> ShardNum -> StorableObjectIdent -> IO RetrieveResult +retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult retrieve _server _n _i = return $ RetrieveFailure "network storage not implemented yet" -- | Servers should automatically obscure, so do nothing. @@ -7,5 +7,5 @@ (Raaz makes this possible to do.) Would be nice, but not super-important, since gpg secret keys are passphrase protected anyway.. -* If we retrieved enough shards successfully, but decrypt failed, must - be a wrong password, so prompt for re-entry and retry with those shards. +* If we retrieved enough shares successfully, but decrypt failed, must + be a wrong password, so prompt for re-entry and retry with those shares. diff --git a/Tunables.hs b/Tunables.hs index 2e8d43b..77c3296 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -33,7 +33,7 @@ knownTunings = map (\t -> (nameGenerationHash (nameGenerationTunable t), t)) -- So, every parameter that can be tuned is configured in this data -- structure. data Tunables = Tunables - { shardParams :: ShardParams + { shareParams :: ShareParams , objectSize :: Int -- ^ a StorableObject is exactly this many bytes in size -- (must be a multiple of AES block size 16) @@ -43,9 +43,9 @@ data Tunables = Tunables } deriving (Show) --- | Parameters for sharding. The secret is split into +-- | Parameters for shareing. The secret is split into -- N objects, such that only M are needed to reconstruct it. -data ShardParams = ShardParams +data ShareParams = ShareParams { totalObjects :: Int -- ^ N , neededObjects :: Int -- ^ M } @@ -80,7 +80,7 @@ data EncryptionTunable = UseAES256 defaultTunables :: Tunables defaultTunables = Tunables - { shardParams = ShardParams { totalObjects = 3, neededObjects = 2 } + { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 } , objectSize = 1024*64 -- 64 kb -- The nameGenerationHash was benchmarked at 661 seconds CPU time -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. @@ -112,7 +112,7 @@ defaultTunables = Tunables -- Not for production use! testModeTunables :: Tunables testModeTunables = Tunables - { shardParams = ShardParams { totalObjects = 3, neededObjects = 2 } + { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 } , objectSize = 1024*64 , nameGenerationTunable = NameGenerationTunable { nameGenerationHash = weakargon2 (CPUCost (Seconds (2*600))) @@ -19,10 +19,10 @@ newtype SecretKey = SecretKey B.ByteString data EncryptedSecretKey = EncryptedSecretKey B.ByteString (CostCalc BruteForceOp UnknownPassword) instance NFData EncryptedSecretKey where - rnf (EncryptedSecretKey b _) = rnf b + rnf (EncryptedSecretKey bs _) = rnf bs instance Show EncryptedSecretKey where - show (EncryptedSecretKey b _) = show b + show (EncryptedSecretKey bs _) = show bs instance Bruteforceable EncryptedSecretKey UnknownPassword where getBruteCostCalc (EncryptedSecretKey _ cc) = cc @@ -35,10 +35,10 @@ newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString } newtype StorableObjectIdent = StorableObjectIdent B.ByteString deriving (Show, NFData) --- | A shard, with a known number (N of M). -data Shard = Shard ShardNum StorableObject +-- | A Shamir secret share, with a known number (N of M). +data Share = Share ShareNum StorableObject -type ShardNum = Int +type ShareNum = Int -- | A password used to encrypt a key stored in keysafe. newtype Password = Password B.ByteString diff --git a/Types/Storage.hs b/Types/Storage.hs index b3f714a..01ae0ad 100644 --- a/Types/Storage.hs +++ b/Types/Storage.hs @@ -9,7 +9,7 @@ module Types.Storage where import Types --- | All known locations where shards can be stored, ordered with +-- | All known locations where shares can be stored, ordered with -- preferred locations first. newtype StorageLocations = StorageLocations [Storage] deriving (Monoid) @@ -17,23 +17,23 @@ newtype StorageLocations = StorageLocations [Storage] -- | Storage interface. This can be used both for local storage, -- an upload queue, or a remote server. -- --- Note that there is no interface to enumerate shards. +-- Note that there is no interface to enumerate shares. -- This is intentional; servers should not allow that. data Storage = Storage - { storeShard :: StorableObjectIdent -> Shard -> IO StoreResult - , retrieveShard :: ShardNum -> StorableObjectIdent -> IO RetrieveResult - , obscureShards :: IO ObscureResult - -- ^ Run after making some calls to storeShard/retrieveShard, + { storeShare :: StorableObjectIdent -> Share -> IO StoreResult + , retrieveShare :: ShareNum -> StorableObjectIdent -> IO RetrieveResult + , obscureShares :: IO ObscureResult + -- ^ Run after making some calls to storeShare/retrieveShare, -- to avoid correlation attacks. - , countShards :: IO CountResult - , moveShards :: Storage -> IO () - -- ^ Tries to move all shards from this storage to another one. + , countShares :: IO CountResult + , moveShares :: Storage -> IO () + -- ^ Tries to move all shares from this storage to another one. } data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String deriving (Show) -data RetrieveResult = RetrieveSuccess Shard | RetrieveFailure String +data RetrieveResult = RetrieveSuccess Share | RetrieveFailure String data ObscureResult = ObscureSuccess | ObscureFailure String deriving (Show) diff --git a/keysafe.cabal b/keysafe.cabal index 0cd9bc7..92613a4 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -67,7 +67,7 @@ Executable keysafe Gpg SecretKey Serialization - Shard + Share Storage Storage.Local Storage.Network @@ -16,7 +16,7 @@ import Entropy import ExpensiveHash import Cost import SecretKey -import Shard +import Share import Storage import qualified Gpg import Data.Maybe @@ -32,7 +32,7 @@ main :: IO () main = do cmdline <- CmdLine.get ui <- selectUI (CmdLine.gui cmdline) - let mkt = CmdLine.customizeShardParams cmdline + let mkt = CmdLine.customizeShareParams cmdline (tunables, possibletunables) <- if CmdLine.testMode cmdline then do showInfo ui "Test mode" @@ -78,17 +78,17 @@ backup storagelocations ui tunables secretkeysource secretkey = do othernamedesc Nothing validateName let name = Name (theirname <> " " <> othername) kek <- promptkek name - let sis = shardIdents tunables name secretkeysource + let sis = shareIdents tunables name secretkeysource 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 + shares <- genShares esk tunables _ <- esk `deepseq` setpercent 25 _ <- sis `deepseq` setpercent 50 - let step = 50 `div` length shards + let step = 50 `div` length shares let percentsteps = map setpercent [50+step, 50+step*2..100] - storeShards storagelocations sis (zip percentsteps shards) + storeShares storagelocations sis (zip percentsteps shares) 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) @@ -187,13 +187,13 @@ restore storagelocations ui possibletunables secretkeydest = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc - let mksis tunables = shardIdents tunables name secretkeydest - (tunables, shards) <- downloadShards storagelocations ui mksis possibletunables + 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 combineShards tunables shards of + case combineShares tunables shares of Left e -> showError ui e Right esk -> withProgress ui "Decrypting" (decryptdesc cost) $ \setpercent -> do @@ -228,8 +228,8 @@ restore storagelocations ui possibletunables secretkeydest = do , "Please wait..." ] -downloadShards :: StorageLocations -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard]) -downloadShards storagelocations ui mksis possibletunables = +downloadShares :: StorageLocations -> UI -> (Tunables -> ShareIdents) -> [Tunables] -> IO (Tunables, [Share]) +downloadShares storagelocations ui mksis possibletunables = withProgress ui "Downloading encrypted data" message $ go possibletunables where @@ -242,10 +242,10 @@ downloadShards storagelocations ui mksis possibletunables = _ <- l `deepseq` setpercent 50 let step = 50 `div` length l let percentsteps = map setpercent [50+step, 50+step*2..100] - shards <- retrieveShards storagelocations (zip percentsteps l) - if null shards + shares <- retrieveShares storagelocations (zip percentsteps l) + if null shares then go othertunables setpercent - else return (tunables, shards) + else return (tunables, shares) possiblesis = map mksis possibletunables message = unlines |