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.

1 files changed, 15 insertions, 11 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