add missing leave request sending function

src/Hash2Pub/DHTProtocol.hs

@@ -338,15 +338,15 @@ respondLeave nsSTM msgSet = do
                                               )
                                               ([],[]) msgSet
         aRequestPart = Set.elemAt 0 msgSet
-        senderID = getNid . sender $ aRequestPart
+        leaveSenderID = getNid . sender $ aRequestPart
     responseMsg <- atomically $ do
         nsSnap <- readTVar nsSTM
         -- remove leaving node from successors, predecessors and NodeCache
-        writeTQueue (cacheWriteQueue nsSnap) $ deleteCacheEntry senderID
+        writeTQueue (cacheWriteQueue nsSnap) $ deleteCacheEntry leaveSenderID
         writeTVar nsSTM $
             -- add predecessors and successors of leaving node to own lists
-            setPredecessors (filter ((/=) senderID . getNid) $ requestPreds <> predecessors nsSnap)
+            setPredecessors (filter ((/=) leaveSenderID . getNid) $ requestPreds <> predecessors nsSnap)
-          . setSuccessors (filter ((/=) senderID . getNid) $ requestSuccs <> successors nsSnap) $ nsSnap
+          . setSuccessors (filter ((/=) leaveSenderID . getNid) $ requestSuccs <> successors nsSnap) $ nsSnap
         -- TODO: handle handover of key data
         let leaveResponse = Response {
                 requestID = requestID aRequestPart
@@ -625,6 +625,36 @@ requestStabilise ns neighbour = do
         ) responses
 
 
+-- | Send a Leave request to the specified node.
+-- Service data transfer needs to be done separately, as not all neighbours
+-- that need to know about the leaving handle the new service data.
+requestLeave :: LocalNodeState s
+             -> RemoteNodeState     -- target node
+             -> IO (Either String ())   -- error or success
+requestLeave ns target = do
+    srcAddr <- confIP . nodeConfig <$> readTVarIO (parentRealNode ns)
+    let leavePayload = LeaveRequestPayload {
+        leaveSuccessors = successors ns
+      , leavePredecessors = predecessors ns
+                                           }
+    responses <- bracket (mkSendSocket srcAddr (getDomain target) (getDhtPort target)) close (fmap Right . sendRequestTo 5000 3 (\rid ->
+        Request {
+            requestID = rid
+          , sender = toRemoteNodeState ns
+          , part = 1
+          , isFinalPart = False
+          , action = Leave
+          , payload = Just leavePayload
+                }
+                         )
+                                                                                           ) `catch`  (\e -> pure . Left $ displayException (e :: IOException))
+    either
+        -- forward IO error messages
+        (pure . Left)
+        -- empty payload, so no processing required
+        (const . pure . Right $ ())
+        responses
+
 requestPing :: LocalNodeState s      -- ^ sending node
                  -> RemoteNodeState     -- ^ node to be PINGed
                  -> IO (Either String [RemoteNodeState])   -- ^ all active vServers of the pinged node