diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-19 16:36:46 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-19 16:36:46 -0400 |
commit | 0afe2e6177b48078db381d26334d3f4fd13363da (patch) | |
tree | ce23c42a9273394c0738978a6e0724d69b90777a /Storage.hs | |
parent | fdc80b7a2416782d3208acf154fb8afb7fb2279b (diff) | |
download | keysafe-0afe2e6177b48078db381d26334d3f4fd13363da.tar.gz |
chunking
This changed the storage format, not that it matters because nobody is
using it yet.
Diffstat (limited to 'Storage.hs')
-rw-r--r-- | Storage.hs | 54 |
1 files changed, 36 insertions, 18 deletions
@@ -14,6 +14,7 @@ import Data.Monoid import Data.Maybe import System.FilePath import Control.Monad +import qualified Data.Set as S allStorageLocations :: IO StorageLocations allStorageLocations = do @@ -29,50 +30,67 @@ localStorageLocations = StorageLocations $ type UpdateProgress = IO () -- | 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) +-- gets at most one share from each set. +-- +-- TODO: Add shuffling and queueing/chaffing to prevent +-- correlation of related shares. +storeShares :: StorageLocations -> ShareIdents -> [S.Set Share] -> UpdateProgress -> IO StoreResult +storeShares (StorageLocations locs) allsis shares updateprogress = do + (r, usedlocs) <- go allsis shares [] _ <- mapM_ obscureShares usedlocs return r where - go _ usedlocs _ [] = return (StoreSuccess, usedlocs) - go [] usedlocs lasterr _ = + go sis (s:rest) usedlocs = do + let (is, sis') = nextShareIdents sis + (r, usedlocs') <- storeset locs [] Nothing (zip (S.toList is) (S.toList s)) + case r of + StoreSuccess -> go sis' rest (usedlocs ++ usedlocs') + _ -> return (r, usedlocs ++ usedlocs') + go _ [] usedlocs = return (StoreSuccess, usedlocs) + + storeset _ usedlocs _ [] = return (StoreSuccess, usedlocs) + storeset [] usedlocs lasterr _ = return (fromMaybe (StoreFailure "no storage locations") lasterr, usedlocs) - go (loc:otherlocs) usedlocs _ tostore@((i,(showprogress, s)):rest) = do + storeset (loc:otherlocs) usedlocs _ ((i, s):rest) = do r <- storeShare loc i s case r of StoreSuccess -> do - _ <- showprogress - go otherlocs (loc:usedlocs) Nothing rest - StoreFailure _ -> go otherlocs usedlocs (Just r) tostore + _ <- updateprogress + storeset otherlocs (loc:usedlocs) Nothing rest -- Give up if any location complains a share -- already exists, because we have a name conflict. StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs) + -- Try storing it somewhere else on failure. + StoreFailure _ -> + storeset otherlocs usedlocs (Just r) ((i, s):rest) --- | Retrieves shares from among the storage locations, and returns all --- the shares it can find, which may not be all that were requested. +-- | Retrieves one set of shares from the storage locations. +-- Returns all the shares it can find, which may not be enough, +-- and the remaining Shareidents, to use to get subsequent sets. -- -- 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 [] +retrieveShares :: StorageLocations -> ShareIdents -> UpdateProgress -> IO (S.Set Share, ShareIdents) +retrieveShares (StorageLocations locs) sis updateprogress = do + let (is, sis') = nextShareIdents sis + let want = zip [1..] (S.toList is) + (shares, usedlocs, _unusedlocs) <- go locs [] want [] _ <- mapM_ obscureShares usedlocs - return shares + return (S.fromList shares, sis') where 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 + go (loc:otherlocs) usedlocs ((n, i):rest) shares = do r <- retrieveShare loc n i case r of RetrieveSuccess s -> do _ <- updateprogress go otherlocs (loc:usedlocs) rest (s:shares) RetrieveFailure _ -> do + -- Try to get the share from other locations. (shares', usedlocs', unusedlocs) <- - go otherlocs usedlocs [toretrieve] shares + go otherlocs usedlocs [(n, i)] shares -- May need to ask the location that didn't -- have the share for a later share, but -- ask it last. This way, the first |