only specify upper key bound when querying load

As a querying node does not always know the lower bound of the queried
segment – determined by the predecessor – let the currently responsible
node provide that bound instead.

affects #71

FediChord.asn1

@@ -104,13 +104,13 @@ PingRequestPayload ::= NULL		-- do not include a node/ vserver ID, so that
 PingResponsePayload ::= SEQUENCE OF NodeState
 
 LoadRequestPayload ::= SEQUENCE {
-	lowerBound		NodeID,
+	upperSegmentBound		NodeID
-	upperBound		NodeID
 	}
 
 LoadResponsePayload ::= SEQUENCE {
 	loadSum					REAL,
-	remainingLoadTarget		REAL
+	remainingLoadTarget		REAL,
+	lowerBound				NodeID
 	}
 
 END

src/Hash2Pub/ASN1Coding.hs

@@ -186,14 +186,14 @@ encodePayload payload'@PingResponsePayload{} =
   <> [End Sequence]
 encodePayload payload'@LoadRequestPayload{} =
   [ Start Sequence
-  , IntVal . getNodeID $ loadLowerBound payload'
+  , IntVal . getNodeID $ loadSegmentUpperBound payload'
-  , IntVal . getNodeID $ loadUpperBound payload'
   , End Sequence
   ]
 encodePayload payload'@LoadResponsePayload{} =
   [ Start Sequence
   , Real $ loadSum payload'
   , Real $ loadRemainingTarget payload'
+  , IntVal . getNodeID $ loadSegmentLowerBound payload'
   , End Sequence
   ]
 
@@ -461,19 +461,19 @@ parsePingResponsePayload = onNextContainer Sequence $ do
 
 parseLoadRequestPayload :: ParseASN1 ActionPayload
 parseLoadRequestPayload = onNextContainer Sequence $ do
-    loadLowerBound' <- fromInteger <$> parseInteger
     loadUpperBound' <- fromInteger <$> parseInteger
     pure LoadRequestPayload
-        { loadLowerBound = loadLowerBound'
+        { loadSegmentUpperBound = loadUpperBound'
-        , loadUpperBound = loadUpperBound'
         }
 
 parseLoadResponsePayload :: ParseASN1 ActionPayload
 parseLoadResponsePayload = onNextContainer Sequence $ do
     loadSum' <- parseReal
     loadRemainingTarget' <- parseReal
+    loadSegmentLowerBound' <- fromInteger <$> parseInteger
     pure LoadResponsePayload
         { loadSum = loadSum'
         , loadRemainingTarget = loadRemainingTarget'
+        , loadSegmentLowerBound = loadSegmentLowerBound'
         }
 

src/Hash2Pub/DHTProtocol.hs

@@ -751,16 +751,14 @@ requestPing ns target = do
 requestQueryLoad :: (MonadError String m, MonadIO m)
                  => LocalNodeState s
                  -> NodeID
-                 -> NodeID
                  -> RemoteNodeState
                  -> m SegmentLoadStats
-requestQueryLoad ns lowerIdBound upperIdBound target = do
+requestQueryLoad ns upperIdBound target = do
     nodeConf <- nodeConfig <$> liftIO (readTVarIO $ parentRealNode ns)
     let
         srcAddr = confIP nodeConf
-        loadPl = LoadRequestPayload
+        loadReqPl = LoadRequestPayload
-            { loadLowerBound = lowerIdBound
+            { loadSegmentUpperBound = upperIdBound
-            , loadUpperBound = upperIdBound
             }
     responses <- liftIO $ bracket (mkSendSocket srcAddr (getDomain target) (getDhtPort target)) close
         (fmap Right . sendRequestTo (confRequestTimeout nodeConf) (confRequestRetries nodeConf) (\rid ->
@@ -770,13 +768,13 @@ requestQueryLoad ns lowerIdBound upperIdBound target = do
                   , part = 1
                   , isFinalPart = False
                   , action = QueryLoad
-                  , payload = Just loadPl
+                  , payload = Just loadReqPl
                         }
                                                                                                         )
         ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
     responseMsgSet <- liftEither responses
     -- throws an error if an exception happened
-    loadPl <- maybe (throwError "no load response payload found") pure
+    loadResPl <- maybe (throwError "no load response payload found") pure
         (foldr' (\msg acc -> case payload msg of
             -- just extract the first found LoadResponsePayload
               Just pl@LoadResponsePayload{} | isNothing acc -> Just pl
@@ -786,10 +784,10 @@ requestQueryLoad ns lowerIdBound upperIdBound target = do
             responseMsgSet
         )
     pure SegmentLoadStats
-        { segmentLowerKeyBound = lowerIdBound
+        { segmentLowerKeyBound = loadSegmentLowerBound loadResPl
         , segmentUpperKeyBound = upperIdBound
-        , segmentLoad = loadSum loadPl
+        , segmentLoad = loadSum loadResPl
-        , segmentOwnerLoadTarget = loadRemainingTarget loadPl
+        , segmentOwnerLoadTarget = loadRemainingTarget loadResPl
         }
 
 

src/Hash2Pub/ProtocolTypes.hs

@@ -58,6 +58,10 @@ data ActionPayload = QueryIDRequestPayload
     }
     | StabiliseRequestPayload
     | PingRequestPayload
+    | LoadRequestPayload
+    { loadSegmentUpperBound :: NodeID
+    -- ^ upper bound of segment interested in,
+    }
     | QueryIDResponsePayload
     { queryResult :: QueryResponse
     }
@@ -74,13 +78,10 @@ data ActionPayload = QueryIDRequestPayload
     | PingResponsePayload
     { pingNodeStates :: [RemoteNodeState]
     }
-    | LoadRequestPayload
-    { loadLowerBound :: NodeID
-    , loadUpperBound :: NodeID
-    }
     | LoadResponsePayload
     { loadSum               :: Double
     , loadRemainingTarget   :: Double
+    , loadSegmentLowerBound :: NodeID
     }
     deriving (Show, Eq)
 

test/FediChordSpec.hs

@@ -222,12 +222,12 @@ spec = do
                                  ]
                                               }
             qLoadReqPayload = LoadRequestPayload
-                { loadLowerBound = fromInteger 12
+                { loadSegmentUpperBound = 1025
-                , loadUpperBound = fromInteger 1025
                 }
             qLoadResPayload = LoadResponsePayload
                 { loadSum = 3.141
                 , loadRemainingTarget = -1.337
+                , loadSegmentLowerBound = 12
                 }
             requestTemplate = Request {
                 requestID = 2342