keep track of satisfied requests, and summarize

2 files changed, 34 insertions, 14 deletions

diff --git a/doc/design/requests_routing.mdwn b/doc/design/requests_routing.mdwn
index 8e9324d39..2391cfae9 100644
--- a/doc/design/requests_routing.mdwn
+++ b/doc/design/requests_routing.mdwn
@@ -90,6 +90,11 @@ For a node that only transfers files between the immobile nodes:
 
 	requestedby=1
 
+For an immobile node that only accumulates files it requests, but never
+stores files requested by other nodes:
+
+	present or requested
+
 TODO: Would be nice to be able to prioritize files that more nodes are
 requesting, or that have some urgent flag set. But currently there is no
 way to do that; content is either preferred or not preferred.
diff --git a/doc/design/requests_routing/simroutes.hs b/doc/design/requests_routing/simroutes.hs
index 90ab03d40..d91125935 100644
--- a/doc/design/requests_routing/simroutes.hs
+++ b/doc/design/requests_routing/simroutes.hs
@@ -87,6 +87,7 @@ data TransferNode = TransferNode
 data NodeRepo = NodeRepo
 	{ wantFiles :: [Request]
 	, haveFiles :: S.Set File
+	, satisfiedRequests :: S.Set Request
 	}
 	deriving (Show, Eq)
 
@@ -97,7 +98,7 @@ randomFile :: (RandomGen g) => Rand g File
 randomFile = File <$> getRandomR (0, totalFiles)
 
 data Request = Request File TTL
-	deriving (Show)
+	deriving (Show, Ord)
 
 -- compare ignoring TTL
 instance Eq Request where
@@ -164,30 +165,42 @@ step (Network immobiles transfers) = go immobiles [] transfers
 			then case M.lookup (currentlocation t) is of
 				Nothing -> go is (c ++ [t]) ts
 				Just currentloc -> do
-					let (currentloc', t') = exchangeRequestsFiles currentloc t
+					let (currentloc', t') = merge currentloc t
 					t'' <- move t'
 					go (M.insert (currentlocation t) currentloc' is) (c ++ [t'']) ts
 			else go is (c ++ [t]) ts
 
-type Exchanger = ImmobileNode -> TransferNode -> (ImmobileNode, TransferNode)
-
-exchangeRequestsFiles :: Exchanger
-exchangeRequestsFiles (ImmobileNode ir) t@(TransferNode { transferrepo = tr }) =
+merge :: ImmobileNode -> TransferNode -> (ImmobileNode, TransferNode)
+merge (ImmobileNode ir) t@(TransferNode { transferrepo = tr }) =
 	( ImmobileNode (go ir tr)
 	, t { transferrepo = go tr ir }
 	)
   where
 	go r1 r2 = r1
-		{ wantFiles = foldr addRequest (wantFiles r1) (wantFiles r2)
-		, haveFiles = S.foldr (addFile (wantFiles r1)) (haveFiles r1) (haveFiles r2)
+		{ wantFiles = wantFiles'
+		, haveFiles = haveFiles'
+		, satisfiedRequests = satisfiedRequests' `S.union` checkSatisfied wantFiles' haveFiles'
 		}
-
--- Adds a file to the set, when there's a request for it.
-addFile :: [Request] -> File -> S.Set File -> S.Set File
-addFile rs f fs
+	  where
+	  	wantFiles' = foldr addRequest (wantFiles r1) (wantFiles r2)
+		haveFiles' = S.foldr (addFile wantFiles' satisfiedRequests') (haveFiles r1) (haveFiles r2)
+		satisfiedRequests' = satisfiedRequests r1 `S.union` satisfiedRequests r2
+
+-- Adds a file to the set, when there's a request for it, and the request
+-- has not already been satisfied.
+addFile :: [Request] -> S.Set Request -> File -> S.Set File -> S.Set File
+addFile rs srs f fs
+	| any (\sr -> f == requestedFile sr) (S.toList srs) = fs
 	| any (\r -> f == requestedFile r) rs = S.insert f fs
 	| otherwise = fs
 
+-- Checks if any requests have been satisfied, and returns them,
+-- to be added to satisfidRequests
+checkSatisfied :: [Request] -> S.Set File -> S.Set Request
+checkSatisfied want have = S.fromList (filter satisfied want)
+  where
+	satisfied r = requestTTL r == originTTL && S.member (requestedFile r) have
+
 -- Decrements TTL, and avoids adding request with a stale TTL, or a
 -- request for an already added file with the same or a lower TTL.
 addRequest :: Request -> [Request] -> [Request]
@@ -212,7 +225,7 @@ genNetwork = do
 	return $ Network immobiles transfers
 
 emptyImmobile :: ImmobileNode
-emptyImmobile = ImmobileNode (NodeRepo [] S.empty)
+emptyImmobile = ImmobileNode (NodeRepo [] S.empty S.empty)
 
 mkTransfer :: (RandomGen g) => [NodeName] -> Rand g TransferNode
 mkTransfer immobiles = do
@@ -227,7 +240,7 @@ mkTransferBetween possiblelocs = do
 	currentloc <- randomfrom possiblelocs
 	movefreq <- getRandomR transferMoveFrequencyRange
 	-- transfer nodes start out with no files or requests in their repo
-	let repo = (NodeRepo [] S.empty)
+	let repo = (NodeRepo [] S.empty S.empty)
 	return $ TransferNode currentloc possiblelocs movefreq repo
 
 randomfrom :: (RandomGen g) => [a] -> Rand g a
@@ -265,6 +278,8 @@ summarize _initial@(Network origis _) _final@(Network is _ts) = format
 	, ("Nodes that failed to get files",
 		show (map withinitiallocs $ filter (not . S.null . snd)
 			(M.toList $ M.map (findunsatisfied . repo) is)))
+	, ("Total number of files on immobile nodes at end",
+		show (overis (S.size . haveFiles . repo)))
 	--, ("Immobile nodes at end", show is)
 	]
   where