include target ID in request to address individual vserver

- necessary for dispatching the request to a certain vserver
- also refactored request sending to use a common `mkRequest`
- contributes to #2

src/Hash2Pub/ASN1Coding.hs

@@ -227,10 +227,11 @@ encodeQueryResult FORWARD{} = Enumerated 1
 encodeMessage :: FediChordMessage   -- ^ the 'FediChordMessage to be encoded
               -> [ASN1]
 encodeMessage
-    (Request requestID sender part isFinalPart action requestPayload) =
+    (Request requestID receiverID sender part isFinalPart action requestPayload) =
         Start Sequence
       : (Enumerated . fromIntegral . fromEnum $ action)
       : IntVal requestID
+      : (IntVal . getNodeID $ receiverID)
       : encodeNodeState sender
       <> [IntVal part
         , Boolean isFinalPart]
@@ -274,6 +275,7 @@ parseMessage = do
 parseRequest :: Action -> ParseASN1 FediChordMessage
 parseRequest action = do
     requestID <- parseInteger
+    receiverID' <- fromInteger <$> parseInteger
     sender <- parseNodeState
     part <- parseInteger
     isFinalPart <- parseBool
@@ -286,7 +288,7 @@ parseRequest action = do
                  Ping      -> parsePingRequestPayload
                  QueryLoad -> parseLoadRequestPayload
 
-    pure $ Request requestID sender part isFinalPart action payload
+    pure $ Request requestID receiverID' sender part isFinalPart action payload
 
 parseResponse :: Integer -> ParseASN1 FediChordMessage
 parseResponse requestID = do

src/Hash2Pub/DHTProtocol.hs

@@ -15,6 +15,7 @@ module Hash2Pub.DHTProtocol
     , Action(..)
     , ActionPayload(..)
     , FediChordMessage(..)
+    , mkRequest
     , maximumParts
     , sendQueryIdMessages
     , requestQueryID
@@ -484,6 +485,21 @@ respondJoin nsSTM msgSet = do
 
 -- ....... request sending .......
 
+-- | defautl constructor for request messages, fills standard values like
+-- part number to avoid code repition
+mkRequest :: LocalNodeState s -> NodeID -> Action -> Maybe ActionPayload -> (Integer -> FediChordMessage)
+mkRequest ns targetID action pl rid = Request
+    { requestID = rid
+    , receiverID = targetID
+    , sender = toRemoteNodeState ns
+    -- part number and final flag can be changed by ASN1 encoder to make packet
+    -- fit the MTU restrictions
+    , part = 1
+    , isFinalPart = True
+    , action = action
+    , payload = pl
+    }
+
 -- | send a join request and return the joined 'LocalNodeState' including neighbours
 requestJoin :: (NodeState a, Service s (RealNodeSTM s)) => a             -- ^ currently responsible node to be contacted
             -> LocalNodeStateSTM s               -- ^ joining NodeState
@@ -495,7 +511,7 @@ requestJoin toJoinOn ownStateSTM = do
     let srcAddr = confIP nodeConf
     bracket (mkSendSocket srcAddr (getDomain toJoinOn) (getDhtPort toJoinOn)) close (\sock -> do
         -- extract own state for getting request information
-        responses <- sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid -> Request rid (toRemoteNodeState ownState) 1 True Join (Just JoinRequestPayload)) sock
+        responses <- sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (mkRequest ownState (getNid toJoinOn) Join (Just JoinRequestPayload)) sock
         (cacheInsertQ, joinedState) <- atomically $ do
             stateSnap <- readTVar ownStateSTM
             let
@@ -628,7 +644,7 @@ lookupMessage :: Integral i
               -> LocalNodeState s -- ^ sender node state
               -> Maybe i        -- ^ optionally provide a different l parameter
               ->  (Integer -> FediChordMessage)
-lookupMessage targetID ns lParam = \rID -> Request rID (toRemoteNodeState ns) 1 True QueryID (Just $ pl ns targetID)
+lookupMessage targetID ns lParam = mkRequest ns targetID QueryID (Just $ pl ns targetID)
   where
     pl ns' targetID' = QueryIDRequestPayload { queryTargetID = targetID', queryLBestNodes = maybe (fromIntegral $ lNumBestNodes ns) fromIntegral lParam }
 
@@ -641,16 +657,7 @@ requestStabilise :: LocalNodeState s      -- ^ sending node
 requestStabilise ns neighbour = do
     nodeConf <- nodeConfig <$> readTVarIO (parentRealNode ns)
     let srcAddr = confIP nodeConf
-    responses <- bracket (mkSendSocket srcAddr (getDomain neighbour) (getDhtPort neighbour)) close (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid ->
-        Request {
-            requestID = rid
-          , sender = toRemoteNodeState ns
-          , part = 1
-          , isFinalPart = False
-          , action = Stabilise
-          , payload = Just StabiliseRequestPayload
-                }
-                         )
+    responses <- bracket (mkSendSocket srcAddr (getDomain neighbour) (getDhtPort neighbour)) close (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (mkRequest ns (getNid neighbour) Stabilise (Just StabiliseRequestPayload))
                                                                                            ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
     either
         -- forward IO error messages
@@ -685,17 +692,12 @@ requestLeave ns doMigration target = do
       , leavePredecessors = predecessors ns
       , leaveDoMigration = doMigration
                                            }
-    responses <- bracket (mkSendSocket srcAddr (getDomain target) (getDhtPort target)) close (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid ->
-        Request {
-            requestID = rid
-          , sender = toRemoteNodeState ns
-          , part = 1
-          , isFinalPart = False
-          , action = Leave
-          , payload = Just leavePayload
-                }
-                         )
-                                                                                           ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
+    responses <- bracket
+        (mkSendSocket srcAddr (getDomain target) (getDhtPort target))
+        close
+        (fmap Right
+        . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (mkRequest ns (getNid target) Leave (Just leavePayload))
+        ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
     either
         -- forward IO error messages
         (pure . Left)
@@ -711,16 +713,7 @@ requestPing ns target = do
     let srcAddr = confIP nodeConf
     responses <- bracket (mkSendSocket srcAddr (getDomain target) (getDhtPort target)) close
         (\sock -> do
-            resp <- sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid ->
-                Request {
-                    requestID = rid
-                  , sender = toRemoteNodeState ns
-                  , part = 1
-                  , isFinalPart = False
-                  , action = Ping
-                  , payload = Just PingRequestPayload
-                        }
-                             ) sock
+            resp <- sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (mkRequest ns (getNid target) Ping (Just PingRequestPayload)) sock
             (SockAddrInet6 _ _ peerAddr _) <- getPeerName sock
             pure $ Right (peerAddr, resp)
                                                                                                ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
@@ -761,16 +754,7 @@ requestQueryLoad ns upperIdBound target = do
             { loadSegmentUpperBound = upperIdBound
             }
     responses <- liftIO $ bracket (mkSendSocket srcAddr (getDomain target) (getDhtPort target)) close
-        (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid ->
-                Request {
-                    requestID = rid
-                  , sender = toRemoteNodeState ns
-                  , part = 1
-                  , isFinalPart = False
-                  , action = QueryLoad
-                  , payload = Just loadReqPl
-                        }
-                                                                                                        )
+        (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (mkRequest ns (getNid target) QueryLoad (Just loadReqPl))
         ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
     responseMsgSet <- liftEither responses
     -- throws an error if an exception happened

src/Hash2Pub/ProtocolTypes.hs

@@ -21,6 +21,7 @@ data Action = QueryID
 
 data FediChordMessage = Request
     { requestID   :: Integer
+    , receiverID  :: NodeID
     , sender      :: RemoteNodeState
     , part        :: Integer
     , isFinalPart :: Bool