respond to Ping requests

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)