From 6e60b08060a79182a6ae0180dbb7aefbc6011299 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 8 Sep 2012 21:06:10 -0400
Subject: moved the PairStage inside the Verifiable data

---
 Assistant/Threads/PairListener.hs | 31 +++++++++++++++----------------
 1 file changed, 15 insertions(+), 16 deletions(-)

(limited to 'Assistant/Threads/PairListener.hs')

diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index 17826744f..d2f572d54 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -45,30 +45,29 @@ pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do
 				chunksz = 1024
 
 		dispatch Nothing = noop
-		dispatch (Just (PairReqM m@(PairReq v))) =
-			pairReqAlert dstatus urlrenderer m
-		dispatch (Just (PairAckM m)) =
-			pairAckAlert dstatus m
-		dispatch (Just (PairDoneM m)) =
-			pairDoneAlert dstatus m
+		dispatch (Just m) = case pairMsgStage m of
+			PairReq -> pairReqAlert dstatus urlrenderer m
+			PairAck -> pairAckAlert dstatus m
+			PairDone -> pairDoneAlert dstatus m
 
 {- 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) = unlessM myreq $ do
-	let pairdata = verifiableVal v
+pairReqAlert :: DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
+pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
+	let (_, pairdata) = verifiableVal v
 	let repo = remoteUserName pairdata ++ "@" ++
 		fromMaybe (showAddr $ remoteAddress pairdata)
 			(remoteHostName pairdata) ++
 			(remoteDirectory pairdata)
-	let msg = repo ++ " is sending a pair request."
-	url <- renderUrl urlrenderer (FinishPairR r) []
-	void $ addAlert dstatus $ pairRequestAlert repo msg $
+	url <- renderUrl urlrenderer (FinishPairR msg) []
+	void $ addAlert dstatus $ pairRequestAlert repo
+		(repo ++ " is sending a pair request.") $
 		AlertButton
 			{ buttonUrl = url
 			, buttonLabel = T.pack "Respond"
 			}
 	where
+		v = fromPairMsg msg
 		{- 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
@@ -82,8 +81,8 @@ pairReqAlert dstatus urlrenderer r@(PairReq v) = unlessM myreq $ do
  - a list of recently finished pairings, and re-send PairDone in
  - response to stale PairAcks for them.
  -}
-pairAckAlert :: DaemonStatusHandle -> PairAck -> IO ()
-pairAckAlert dstatus (PairAck v) = error "TODO"
+pairAckAlert :: DaemonStatusHandle -> PairMsg -> IO ()
+pairAckAlert 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.
@@ -94,5 +93,5 @@ pairAckAlert dstatus (PairAck v) = error "TODO"
  - 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"
+pairDoneAlert :: DaemonStatusHandle -> PairMsg -> IO ()
+pairDoneAlert dstatus msg = error "TODO"
-- 
cgit v1.2.3