avoid queuing transfers that are currently running

1 files changed, 12 insertions, 8 deletions

diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 0afe3cb19..ac9ed3216 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -136,14 +136,18 @@ enqueue reason schedule t info
 		notifyTransfer
 	add modlist = do
 		q <- getAssistant transferQueue
-		liftIO $ atomically $ do
-			l <- readTVar (queuelist q)
-			if (t `notElem` map fst l)
-				then do	
-					void $ modifyTVar' (queuesize q) succ
-					void $ modifyTVar' (queuelist q) modlist
-					return True
-				else return False
+		dstatus <- getAssistant daemonStatusHandle
+		liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
+			( return False
+			, do
+				l <- readTVar (queuelist q)
+				if (t `notElem` map fst l)
+					then do	
+						void $ modifyTVar' (queuesize q) succ
+						void $ modifyTVar' (queuelist q) modlist
+						return True
+					else return False
+			)
 
 {- Adds a transfer to the queue. -}
 queueTransfer :: Reason -> Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()