From fc8aa3e330280198d6a6a084f857d68ea3c9a54c Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Tue, 25 Aug 2020 22:01:01 +0200
Subject: [PATCH] bugfix: properly process QueryID responses so FOUND is
 conserved

fixes dproper discovery of announced responsibility by FOUND
---
 src/Hash2Pub/DHTProtocol.hs | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs
index 1cce94d..bc5d5e3 100644
--- a/src/Hash2Pub/DHTProtocol.hs
+++ b/src/Hash2Pub/DHTProtocol.hs
@@ -53,7 +53,7 @@ import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Except (MonadError(..), runExceptT)
 import qualified Data.ByteString                as BS
 import           Data.Either                    (rights)
-import           Data.Foldable                  (foldl', foldr')
+import           Data.Foldable                  (foldl', foldr', foldrM)
 import           Data.Functor.Identity
 import           Data.IP                        (IPv6, fromHostAddress6,
                                                  toHostAddress6)
@@ -596,8 +596,10 @@ sendQueryIdMessages targetID ns lParam targets = do
           -- insert new cache entries both into global cache as well as return accumulated QueryResponses for further processing
           now <- getPOSIXTime
           -- collect cache entries from all responses
-          foldM (\acc resp -> do
-            let entrySet = case queryResult <$> payload resp of
+          foldrM (\resp acc -> do
+            let 
+                responseResult = queryResult <$> payload resp
+                entrySet = case responseResult of
                              Just (FOUND result1) -> Set.singleton (RemoteCacheEntry result1 now)
                              Just (FORWARD resultset) -> resultset
                              _ -> Set.empty
@@ -607,10 +609,15 @@ sendQueryIdMessages targetID ns lParam targets = do
             -- return accumulated QueryResult
             pure $ case acc of
               -- once a FOUND as been encountered, return this as a result
-              isFound@FOUND{} -> isFound
-              FORWARD accSet  -> FORWARD $ entrySet `Set.union` accSet
+              FOUND{} -> acc
+              FORWARD accSet 
+                | maybe False isFound responseResult -> fromJust responseResult
+                | otherwise -> FORWARD $ entrySet `Set.union` accSet
 
                             ) (FORWARD Set.empty) responses
+  where
+      isFound FOUND{} = True
+      isFound _ = False
 
 -- | Create a QueryID message to be supplied to 'sendRequestTo'
 lookupMessage :: Integral i