fix memory leak

I'm unsure why this fixed it, but it did. Seems to suggest that the
memory leak is not due to a bug in my code, but that ghc didn't manage
to take full advantage of laziness, or was failing to gc something it
could have.

3 files changed, 20 insertions, 38 deletions

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index d55d69bdb..3b95c8c02 100644
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -72,15 +72,15 @@ runLocal runmode runner a = case a of
 					Right b -> runner (next b)
 			Right Nothing -> return (Left "content not available")
 			Left e -> return (Left (show e))
-	StoreContent k af o l b next -> do
+	StoreContent k af o l getb next -> do
 		ok <- flip catchNonAsync (const $ return False) $
 			transfer download k af $
 				getViaTmp AlwaysVerify k $ \tmp ->
-					unVerified $ storefile tmp o l b
+					unVerified $ storefile tmp o l getb
 		runner (next ok)
-	StoreContentTo dest o l b next -> do
+	StoreContentTo dest o l getb next -> do
 		ok <- flip catchNonAsync (const $ return False) $
-			storefile dest o l b
+			storefile dest o l getb
 		runner (next ok)
 	SetPresent k u next -> do
 		v <- tryNonAsync $ logChange k u InfoPresent
@@ -120,10 +120,14 @@ runLocal runmode runner a = case a of
 		-- Transfer logs are updated higher in the stack when
 		-- a client.
 		Client -> ta
-	storefile dest (Offset o) (Len l) b = liftIO $ do
-		withBinaryFile dest ReadWriteMode $ \h -> do
-			when (o /= 0) $
-				hSeek h AbsoluteSeek o
-			L.hPut h b
-		sz <- getFileSize dest
-		return (toInteger sz == l + o)
+	storefile dest (Offset o) (Len l) getb = do
+		v <- runner getb
+		case v of
+			Right b -> liftIO $ do
+				withBinaryFile dest ReadWriteMode $ \h -> do
+					when (o /= 0) $
+						hSeek h AbsoluteSeek o
+					L.hPut h b
+				sz <- liftIO $ getFileSize dest
+				return (toInteger sz == l + o)
+			Left e -> error e
diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index 8aabb37d7..5d6c6fcc5 100644
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -200,7 +200,7 @@ data LocalF c
 	| ReadContent Key AssociatedFile Offset (L.ByteString -> c)
 	-- ^ Lazily reads the content of a key. Note that the content
 	-- may change while it's being sent.
-	| StoreContent Key AssociatedFile Offset Len L.ByteString (Bool -> c)
+	| StoreContent Key AssociatedFile Offset Len (Proto L.ByteString) (Bool -> c)
 	-- ^ Stores content to the key's temp file starting at an offset.
 	-- Once the whole content of the key has been stored, moves the
 	-- temp file into place as the content of the key, and returns True.
@@ -208,7 +208,7 @@ data LocalF c
 	-- Note: The ByteString may not contain the entire remaining content
 	-- of the key. Only once the temp file size == Len has the whole
 	-- content been transferred.
-	| StoreContentTo FilePath Offset Len L.ByteString (Bool -> c)
+	| StoreContentTo FilePath Offset Len (Proto L.ByteString) (Bool -> c)
 	-- ^ Stores the content to a temp file starting at an offset.
 	-- Once the whole content of the key has been stored, returns True.
 	--
@@ -388,7 +388,7 @@ sendContent key af offset@(Offset n) p = do
 	net $ sendBytes len content p'
 	checkSuccess
 
-receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
+receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> Proto L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
 receiveContent p sizer storer mkmsg = do
 	Len n <- local sizer
 	let p' = offsetMeterUpdate p (toBytesProcessed n)
@@ -397,8 +397,8 @@ receiveContent p sizer storer mkmsg = do
 	r <- net receiveMessage
 	case r of
 		DATA len -> do
-			ok <- local . storer offset len
-				=<< net (receiveBytes len p')
+			ok <- local $ storer offset len
+				(net (receiveBytes len p'))
 			sendSuccess ok
 			return ok
 		_ -> do
diff --git a/doc/todo/tor.mdwn b/doc/todo/tor.mdwn
index a4700fd5d..79822ab19 100644
--- a/doc/todo/tor.mdwn
+++ b/doc/todo/tor.mdwn
@@ -4,28 +4,6 @@ Mostly working!
 
 Current todo list:
 
-* copy --to peer of a 100 mb file causes the memory of the remotedaemon
-  to creep up from 40 mb to 136 mb. Once the transfer is done, the
-  remotedaemon continues using all that memory. Memory leak. Profile it.  
-  (The sending process creeps up some initially, but stops at 45 mb used.
-  That could just be buffering.)  
-  (copy --from peer does not leak on either end; the remotedaemon uses 34
-  mb and the receiver 44 mb.)
-
-  Profiling results: Leak is in hGetMetered, or perhaps in
-  the consumer of the data it reads. Graph shows `ARR_WORDS` is
-  the type; that must be a bytestring.
-
-<pre>                                                                                                                   individual      inherited
-COST CENTRE                                               MODULE                               no.      entries  %time %alloc   %time %alloc
-                     tryNonAsync                          Utility.Exception                    3241          0    0.0    0.1    49.3   65.8
-                      receiveExactly                      P2P.IO                               3429          0    0.0    0.0    49.3   65.7
-                       hGetMetered                        Utility.Metered                      3430          0   49.1   65.6    49.3   65.7
-</pre>
-
-  Switching to L.hGet, it still leaks, so seems hGetMetered is not at fault
-  and the bytestring is being buffered excessively somehow.
-
 * When a transfer can't be done because another transfer of the same 
   object is already in progress, the message about this is output by the
   remotedaemon --debug, but not forwarded to the peer, which shows