From 0afe2e6177b48078db381d26334d3f4fd13363da Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 19 Aug 2016 16:36:46 -0400
Subject: chunking

This changed the storage format, not that it matters because nobody is
using it yet.
---
 Storage.hs | 54 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 36 insertions(+), 18 deletions(-)

(limited to 'Storage.hs')

diff --git a/Storage.hs b/Storage.hs
index 56d68a8..85e52a6 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -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
-- 
cgit v1.2.3