diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index b759093..983fdc2 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -190,7 +190,7 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do mapM_ (\resp -> atomically $ writeTQueue sendQ (resp, sourceAddr)) ) =<< (case action aPart of --- Ping -> Just <$> respondPing nsSTM msgSet + Ping -> Just <$> respondPing nsSTM msgSet Join -> Just <$> respondJoin nsSTM msgSet -- -- ToDo: figure out what happens if not joined -- QueryID -> Just <$> respondQueryID nsSTM msgSet @@ -209,6 +209,25 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do -- ....... response sending ....... +-- TODO: could all these respond* functions be in STM instead of IO? + +respondPing :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString) +respondPing nsSTM msgSet = do + -- TODO: respond with all active VS when implementing k-choices + nsSnap <- readTVarIO nsSTM + let + aRequestPart = Set.elemAt 0 msgSet + responsePayload = PingResponsePayload { pingNodeStates = [ toRemoteNodeState nsSnap ] } + pingResponse = Response { + responseTo = requestID aRequestPart + , senderID = getNid nsSnap + , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 + , isFinalPart = False + , action = Ping + , payload = Just responsePayload + } + pure $ serialiseMessage sendMessageSize pingResponse + -- this modifies node state, so locking and IO seems to be necessary. -- Still try to keep as much code as possible pure respondJoin :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString)