fix transfer slots blocking and refilling when transfers are stopped

There's a bug, if a transfer process notices it needs to do nothing,
it never starts the transfer, so the slot is never freed.

Assistant/TransferSlots.hs

@@ -24,7 +24,17 @@ newTransferSlots :: IO TransferSlots
 newTransferSlots = newQSemN numSlots
 
 {- Waits until a transfer slot becomes available, and runs a transfer
- - action in the slot.
+ - action in the slot. If the action throws an exception, its slot is
+ - freed here, otherwise it should be freed by the TransferWatcher when
+ - the transfer is complete.
  -}
 inTransferSlot :: TransferSlots -> IO a -> IO a
-inTransferSlot s = bracket_ (waitQSemN s 1) (signalQSemN s 1)
+inTransferSlot s a = bracketOnError start abort run
+	where
+		start = waitQSemN s 1
+		abort = const $ transferComplete s
+		run = const a
+
+{- Call when a transfer is complete. -}
+transferComplete :: TransferSlots -> IO ()
+transferComplete s = signalQSemN s 1