diff options
author | 2012-09-10 17:53:51 -0400 | |
---|---|---|
committer | 2012-09-10 17:53:51 -0400 | |
commit | c20d6f4189e1e0c3a1e8339f772df587fac38748 (patch) | |
tree | 9ea59000b21fa1d24904f843dedbab717bfdccbb /Assistant/Threads/PairListener.hs | |
parent | b573d91aa27a315fe9b155349a0a90805dc01181 (diff) |
responding to pair requests *almost* works
Diffstat (limited to 'Assistant/Threads/PairListener.hs')
-rw-r--r-- | Assistant/Threads/PairListener.hs | 34 |
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" |