responding to pair requests *almost* works
This commit is contained in:
parent
b573d91aa2
commit
c20d6f4189
9 changed files with 189 additions and 122 deletions
|
@ -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"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue