From 4d592aaec2dd73e0244182872ad5f7ac270a73df Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 11 Sep 2012 16:11:28 -0400
Subject: fixed all pairing alert issues

---
 Assistant/Alert.hs                |  9 ++++++---
 Assistant/Threads/PairListener.hs | 31 ++++++++++++++-----------------
 2 files changed, 20 insertions(+), 20 deletions(-)

(limited to 'Assistant')

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index fc1dff353..118c5e43d 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -294,8 +294,12 @@ pairingAlert button = baseActivityAlert
 	}
 
 pairRequestReceivedAlert :: String -> AlertButton -> Alert
-pairRequestReceivedAlert repo button = baseActivityAlert
-	{ alertData = [UnTensed $ T.pack $ repo ++ " is sending a pair request."]
+pairRequestReceivedAlert repo button = Alert
+	{ alertClass = Message
+	, alertHeader = Nothing
+	, alertMessageRender = tenseWords
+	, alertData = [UnTensed $ T.pack $ repo ++ " is sending a pair request."]
+	, alertBlockDisplay = False
 	, alertPriority = High
 	, alertClosable = True
 	, alertIcon = Just InfoIcon
@@ -308,7 +312,6 @@ pairRequestAcknowledgedAlert :: String -> (Maybe AlertButton) -> Alert
 pairRequestAcknowledgedAlert repo button = baseActivityAlert
 	{ alertData = ["Pair request with", UnTensed (T.pack repo), Tensed "in progress" "complete"]
 	, alertPriority = High
-	, alertName = Just $ PairAlert repo
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertButton = button
 	}
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index 7f4368925..e8ce3f857 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -29,12 +29,12 @@ thisThread = "PairListener"
 pairListenerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> UrlRenderer -> NamedThread
 pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ do
 	sock <- multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort
-	go sock []
+	go sock [] []
 	where
 		thread = NamedThread thisThread
 		
-		go sock cache = getmsg sock [] >>= \msg -> case readish msg of
-			Nothing -> go sock cache
+		go sock reqs cache = getmsg sock [] >>= \msg -> case readish msg of
+			Nothing -> go sock reqs cache
 			Just m -> do
 				sane <- checkSane msg
 				(pip, verified) <- verificationCheck m
@@ -43,17 +43,19 @@ pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $
 				case (wrongstage, sane, pairMsgStage m) of
 					-- ignore our own messages, and
 					-- out of order messages
-					(True, _, _) -> go sock cache
-					(_, False, _) -> go sock cache
-					(_, _, PairReq) -> do
-						pairReqReceived verified dstatus urlrenderer m
-						go sock $ invalidateCache m cache
+					(True, _, _) -> go sock reqs cache
+					(_, False, _) -> go sock reqs cache
+					(_, _, PairReq) -> if m `elem` reqs
+						then go sock reqs (invalidateCache m cache)
+						else do
+							pairReqReceived verified dstatus urlrenderer m
+							go sock (m:take 10 reqs) (invalidateCache m cache)
 					(_, _, PairAck) -> do
 						pairAckReceived verified pip st dstatus scanremotes m cache
-							>>= go sock
+							>>= go sock reqs
 					(_, _, PairDone) -> do
 						pairDoneReceived verified pip st dstatus scanremotes m
-						go sock	cache
+						go sock	reqs cache
 
 		{- As well as verifying the message using the shared secret,
 		 - check its UUID against the UUID we have stored. If
@@ -97,10 +99,7 @@ pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $
 			where
 				chunksz = 1024
 
-{- Show an alert when a PairReq is seen.
- -
- - Pair request alerts from the same host combine,
- - so repeated requests do not add additional alerts. -}
+{- Show an alert when a PairReq is seen. -}
 pairReqReceived :: Bool -> DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
 pairReqReceived True _ _ _ = noop -- ignore our own PairReq
 pairReqReceived False dstatus urlrenderer msg = do
@@ -109,12 +108,10 @@ pairReqReceived False dstatus urlrenderer msg = do
 		AlertButton
 			{ buttonUrl = url
 			, buttonLabel = T.pack "Respond"
-			, buttonAction = Just onclick
+			, buttonAction = Just $ removeAlert dstatus
 			}
 	where
 		repo = pairRepo msg
-		onclick = \i -> updateAlert dstatus i $ const $ Just $
-			pairRequestAcknowledgedAlert repo Nothing
 
 {- When a verified PairAck is seen, a host is ready to pair with us, and has
  - already configured our ssh key. Stop sending PairReqs, finish the pairing,
-- 
cgit v1.2.3