fix combining of pairing alerts

Assistant/Alert.hs

@@ -294,12 +294,8 @@ pairingAlert button = baseActivityAlert
 	}
 
 pairRequestReceivedAlert :: String -> AlertButton -> Alert
-pairRequestReceivedAlert repo button = Alert
-	{ alertClass = Message
-	, alertHeader = Nothing
-	, alertMessageRender = tenseWords
-	, alertData = [UnTensed $ T.pack $ repo ++ " is sending a pair request."]
-	, alertBlockDisplay = False
+pairRequestReceivedAlert repo button = baseActivityAlert
+	{ alertData = [UnTensed $ T.pack $ repo ++ " is sending a pair request."]
 	, alertPriority = High
 	, alertClosable = True
 	, alertIcon = Just InfoIcon
@@ -308,13 +304,13 @@ pairRequestReceivedAlert repo button = Alert
 	, alertButton = Just button
 	}
 
-pairRequestAcknowledgedAlert :: String -> AlertButton -> Alert
+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 = Just button
+	, alertButton = button
 	}
 
 fileAlert :: TenseChunk -> FilePath -> Alert

Assistant/Threads/PairListener.hs

@@ -109,10 +109,12 @@ pairReqReceived False dstatus urlrenderer msg = do
 		AlertButton
 			{ buttonUrl = url
 			, buttonLabel = T.pack "Respond"
-			, buttonAction = Nothing
+			, buttonAction = Just onclick
 			}
 	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,

Assistant/WebApp/Configurators/Pairing.hs

@@ -56,7 +56,7 @@ getFinishPairR msg = promptSecret (Just msg) $ \_ secret -> do
 	liftIO $ setup
 	startPairing PairAck cleanup alert uuid "" secret
 	where
-		alert = pairRequestAcknowledgedAlert $ pairRepo msg
+		alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just
 		setup  = setupAuthorizedKeys msg
 		cleanup = removeAuthorizedKeys False $
 			remoteSshPubKey $ pairMsgData msg