filter out our own pairing requests

Due to being multicast, requests sent by one thread are received by the
listener in another thread.

2 files changed, 12 insertions, 4 deletions

diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs
index eced43793..a157e28f8 100644
--- a/Assistant/Pairing.hs
+++ b/Assistant/Pairing.hs
@@ -47,7 +47,10 @@ type UserName = String
 
 {- A pairing that is in progress has a secret, and a thread that is
  - broadcasting pairing requests. -}
-data PairingInProgress = PairingInProgress Secret ThreadId
+data PairingInProgress = PairingInProgress
+	{ inProgressSecret :: Secret
+	, inProgressThreadId :: ThreadId
+	}
 
 data SomeAddr = IPv4Addr HostAddress | IPv6Addr HostAddress6
 	deriving (Ord, Eq, Read, Show)
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index bb9ab6d0f..58d8fd969 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -39,13 +39,18 @@ pairListenerThread st dstatus = thread $ withSocketsDo $ do
 				chunksz = 1024
 
 		dispatch Nothing = noop
-		dispatch (Just (PairReqM (PairReq r))) = void $ do
-			let pairdata = verifiableVal r
+		dispatch (Just (PairReqM (PairReq v))) = unlessM (mypair v) $ do
+			let pairdata = verifiableVal v
 			let repo = remoteUserName pairdata ++ "@" ++
 				fromMaybe (showAddr $ remoteAddress pairdata)
 					(remoteHostName pairdata)
 			let msg = repo ++ " is sending a pair request."
 			{- Pair request alerts from the same host combine,
 			 - so repeated requests do not add additional alerts. -}
-			addAlert dstatus $ pairRequestAlert repo msg
+			void $ addAlert dstatus $ pairRequestAlert repo msg
 		dispatch (Just (PairAckM _)) = noop -- TODO
+
+		{- Filter out our own pair requests, by checking if we
+		 - can verify using the secrets of any of them. -}
+		mypair v = any (verified v . inProgressSecret) . pairingInProgress
+			<$> getDaemonStatus dstatus