fix repeated pause and resume of a transfer

I had an intuition that throwTo might be blocking because an exception was
caught and the exception handler was running. This seems to be the case,
and is avoided by using try. However, I can't really find anywhere in
throwTo's documentation that justifies this behavior.

2 files changed, 11 insertions, 9 deletions

diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 3dd29a823..30163dbde 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -73,7 +73,14 @@ runTransferThread dstatus s (Just (t, info, a)) = do
 	updateTransferInfo dstatus t $ info { transferTid = Just tid }
 	where
 		go = catchPauseResume a
-		pause = catchPauseResume $ runEvery (Seconds 86400) noop
-		catchPauseResume a' = E.catch a' handlePauseResume
-		handlePauseResume PauseTransfer = pause
-		handlePauseResume ResumeTransfer = go
+		pause = catchPauseResume $ runEvery (Seconds 1) $ print "paused"
+		{- Note: This must use E.try, rather than E.catch.
+		 - When E.catch is used, and has called go in its exception
+		 - handler, Control.Concurrent.throwTo will block sometimes
+		 - when signaling. Using E.try avoids the problem. -}
+		catchPauseResume a' = do
+			r <- E.try a'
+			case r of
+				Right v -> return v
+				Left PauseTransfer -> pause
+				Left ResumeTransfer -> go
diff --git a/doc/design/assistant/syncing.mdwn b/doc/design/assistant/syncing.mdwn
index 8677fdb84..9bd04e0ea 100644
--- a/doc/design/assistant/syncing.mdwn
+++ b/doc/design/assistant/syncing.mdwn
@@ -3,11 +3,6 @@ all the other git clones, at both the git level and the key/value level.
 
 ## immediate action items
 
-* pause, resume, and pause of a transfer fails... The first pause is ok,
-  and the first resume. The second pause seems to block forever when
-  it signals the transfer thread. I've checked: ThreadID is correct. Thread
-  is still running. No exception is thrown. WTF? (One or twice, it worked,
-  but then blocked next time paused.)
 
 ## longer-term TODO