respond to and handle QueryID requests

closes #28

src/Hash2Pub/DHTProtocol.hs

@@ -40,8 +40,8 @@ import           Data.IP                        (IPv6, fromHostAddress6,
                                                  toHostAddress6)
 import           Data.List                      (delete, nub, sortBy)
 import qualified Data.Map                       as Map
-import           Data.Maybe                     (fromJust, fromMaybe, mapMaybe,
-                                                 maybe)
+import           Data.Maybe                     (fromJust, fromMaybe, isJust,
+                                                 isNothing, mapMaybe, maybe)
 import qualified Data.Set                       as Set
 import           Data.Time.Clock.POSIX
 import           Network.Socket                 hiding (recv, recvFrom, send,
@@ -192,11 +192,10 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
             =<< (case action aPart of
                 Ping -> Just <$> respondPing nsSTM msgSet
                 Join -> Just <$> respondJoin nsSTM msgSet
---                -- ToDo: figure out what happens if not joined
---                QueryID -> Just <$> respondQueryID nsSTM msgSet
---                -- only when joined
---                Leave -> if isJoined_ ns then Just <$> respondLeave nsSTM msgSet else pure Nothing
---                -- only when joined
+                -- ToDo: figure out what happens if not joined
+                QueryID -> Just <$> respondQueryID nsSTM msgSet
+                -- only when joined
+                Leave -> if isJoined_ ns then Just <$> respondLeave nsSTM msgSet else pure Nothing
                 Stabilise -> if isJoined_ ns then Just <$> respondStabilise nsSTM msgSet else pure Nothing
             )
       -- for single part request, response starts with part number 1. For multipart requests, response starts with part number n+1.
@@ -209,6 +208,41 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
 
 -- TODO: could all these respond* functions be in STM instead of IO?
 
+
+-- | execute a key ID lookup on local cache and respond with the result
+respondQueryID :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString)
+respondQueryID nsSTM msgSet = do
+    -- this message cannot be split reasonably, so just
+    -- consider the first payload
+    let
+        aRequestPart = Set.elemAt 0 msgSet
+        senderID = getNid . sender $ aRequestPart
+        senderPayload = foldr' (\msg plAcc ->
+            if isNothing plAcc && isJust (payload msg)
+               then payload msg
+               else plAcc
+                               ) Nothing msgSet
+    -- return only empty message serialisation if no payload was included in parts
+    maybe (pure Map.empty) (\senderPayload' -> do
+        responseMsg <- atomically $ do
+            nsSnap <- readTVar nsSTM
+            cache <- readTVar $ nodeCacheSTM nsSnap
+            let
+                responsePayload = QueryIDResponsePayload {
+                    queryResult = queryLocalCache nsSnap cache (fromIntegral $ queryLBestNodes senderPayload') (queryTargetID senderPayload')
+                                                        }
+                queryResponseMsg = Response {
+                    responseTo = requestID aRequestPart
+                  , senderID = getNid nsSnap
+                  , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
+                  , isFinalPart = False
+                  , action = QueryID
+                  , payload = Just responsePayload
+                                             }
+            pure queryResponseMsg
+        pure $ serialiseMessage sendMessageSize responseMsg
+                           ) senderPayload
+
 -- | Respond to a Leave request by removing the leaving node from local data structures
 -- and confirming with response.
 -- TODO: copy over key data from leaver and confirm