add a PairDone message

Assistant/Pairing.hs

@@ -22,15 +22,24 @@ data PairReq = PairReq (Verifiable PairData)
 data PairAck = PairAck (Verifiable PairData)
 	deriving (Eq, Read, Show)
 
+{- "I saw your PairAck; you can stop sending them."
+ - (This is not repeated, it's just sent in response to a valid PairAck) -}
+data PairDone = PairDone (Verifiable PairData)
+	deriving (Eq, Read, Show)
+
 fromPairReq :: PairReq -> Verifiable PairData
 fromPairReq (PairReq v) = v
 
 fromPairAck :: PairAck -> Verifiable PairData
 fromPairAck (PairAck v) = v
 
+fromPairDone :: PairDone -> Verifiable PairData
+fromPairDone (PairDone v) = v
+
 data PairMsg
 	= PairReqM PairReq
 	| PairAckM PairAck
+	| PairDoneM PairDone
 	deriving (Eq, Read, Show)
 
 data PairData = PairData

Assistant/Threads/PairListener.hs

@@ -27,11 +27,14 @@ thisThread = "PairListener"
 pairListenerThread :: ThreadState -> DaemonStatusHandle -> UrlRenderer -> NamedThread
 pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do
 	sock <- multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort
-	forever $ do
+	go sock
-		msg <- getmsg sock []
-		dispatch $ readish msg
 	where
 		thread = NamedThread thisThread
+		
+		go sock = do
+			msg <- getmsg sock []
+			dispatch $ readish msg
+			go sock
 
 		getmsg sock c = do
 			(msg, n, _) <- recvFrom sock chunksz
@@ -42,22 +45,17 @@ pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do
 				chunksz = 1024
 
 		dispatch Nothing = noop
-		dispatch (Just (PairReqM r@(PairReq v))) =
+		dispatch (Just (PairReqM m@(PairReq v))) =
-			unlessM (mypair v) $
+			pairReqAlert dstatus urlrenderer m
-				pairReqAlert dstatus urlrenderer r
+		dispatch (Just (PairAckM m)) =
-		dispatch (Just (PairAckM r@(PairAck v))) =
+			pairAckAlert dstatus m
-			unlessM (mypair v) $
+		dispatch (Just (PairDoneM m)) =
-				pairAckAlert dstatus r
+			pairDoneAlert dstatus m
-
-		{- 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
 
 {- Pair request alerts from the same host combine,
  - so repeated requests do not add additional alerts. -}
 pairReqAlert :: DaemonStatusHandle -> UrlRenderer -> PairReq -> IO ()
-pairReqAlert dstatus urlrenderer r@(PairReq v) = do
+pairReqAlert dstatus urlrenderer r@(PairReq v) = unlessM myreq $ do
 	let pairdata = verifiableVal v
 	let repo = remoteUserName pairdata ++ "@" ++
 		fromMaybe (showAddr $ remoteAddress pairdata)
@@ -70,6 +68,31 @@ pairReqAlert dstatus urlrenderer r@(PairReq v) = do
 			{ buttonUrl = url
 			, buttonLabel = T.pack "Respond"
 			}
+	where
+		{- Filter out our own pair requests, by checking if we
+		 - can verify using the secrets of any of them. -}
+		myreq = any (verified v . inProgressSecret) . pairingInProgress
+			<$> getDaemonStatus dstatus
 
+{- When a valid PairAck is seen, a host has successfully paired with
+ - us, and we should finish pairing with them. Then send a 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 -> PairAck -> IO ()
-pairAckAlert dstatus r@(PairAck v) = error "TODO"
+pairAckAlert dstatus (PairAck v) = error "TODO"
+
+{- If we get a valid PairDone, and are sending PairAcks, we can stop
+ - sending them, as the message has been received.
+ -
+ - Also, now is the time to remove the pair request alert, as pairing is
+ - over. Do that even if the PairDone cannot be validated, as we might
+ - be a third host that did not participate in the pairing.
+ - Note: This does allow a bad actor to squelch pairing on a network
+ - by sending bogus PairDones.
+ -}
+pairDoneAlert :: DaemonStatusHandle -> PairDone -> IO ()
+pairDoneAlert dstatus (PairDone v) = error "TODO"