responding to pair requests *almost* works

1 files changed, 18 insertions, 16 deletions

diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index e7104dc28..8b1cac2ba 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -46,15 +46,20 @@ pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do
 				chunksz = 1024
 
 		dispatch Nothing = noop
-		dispatch (Just m) = case pairMsgStage m of
-			PairReq -> pairReqAlert dstatus urlrenderer m
-			PairAck -> pairAckAlert dstatus m
-			PairDone -> pairDoneAlert dstatus m
+		dispatch (Just m@(PairMsg v)) = do
+			verified <- maybe False (verify v . inProgressSecret)
+				. pairingInProgress
+				<$> getDaemonStatus dstatus
+			case pairMsgStage m of
+				PairReq -> pairReqReceived verified dstatus urlrenderer m
+				PairAck -> pairAckReceived verified dstatus m
+				PairDone -> pairDoneReceived verified dstatus m
 
 {- Pair request alerts from the same host combine,
  - so repeated requests do not add additional alerts. -}
-pairReqAlert :: DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
-pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
+pairReqReceived :: Bool -> DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
+pairReqReceived True _ _ _ = noop -- ignore out own PairReq
+pairReqReceived False dstatus urlrenderer msg = do
 	url <- renderUrl urlrenderer (FinishPairR msg) []
 	void $ addAlert dstatus $ pairRequestReceivedAlert repo
 		(repo ++ " is sending a pair request.") $
@@ -74,11 +79,6 @@ pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
 			, ":"
 			, (remoteDirectory pairdata)
 			]
-		{- Filter out our own pair request, by checking if we
-		 - can verify using its secret. -}
-		myreq = maybe False (verified v . inProgressSecret)
-			. pairingInProgress
-				<$> getDaemonStatus dstatus
 		{- Remove the button when it's clicked, and change the
 		 - alert to be in progress. This alert cannot be entirely
 		 - removed since more pair request messages are coming in
@@ -91,15 +91,16 @@ pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
 			}
 
 {- When a valid PairAck is seen, a host has successfully paired with
- - us, and we should finish pairing with them. Then send a PairDone.
+ - us, and we should finish pairing with them. Then send a single PairDone.
  -
  - A stale PairAck might also be seen, after we've finished pairing.
  - Perhaps our PairDone was not received. To handle this, we keep
  - a list of recently finished pairings, and re-send PairDone in
  - response to stale PairAcks for them.
  -}
-pairAckAlert :: DaemonStatusHandle -> PairMsg -> IO ()
-pairAckAlert dstatus msg = error "TODO"
+pairAckReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO ()
+pairAckReceived False _ _ = noop -- not verified
+pairAckReceived True dstatus msg = error "TODO"
 
 {- If we get a valid PairDone, and are sending PairAcks, we can stop
  - sending them, as the message has been received.
@@ -110,5 +111,6 @@ pairAckAlert dstatus msg = error "TODO"
  - Note: This does allow a bad actor to squelch pairing on a network
  - by sending bogus PairDones.
  -}
-pairDoneAlert :: DaemonStatusHandle -> PairMsg -> IO ()
-pairDoneAlert dstatus msg = error "TODO"
+pairDoneReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO ()
+pairDoneReceived False _ _ = noop -- not verified
+pairDoneReceived True dstatus msg = error "TODO"