bugfix: properly process QueryID responses so FOUND is conserved
fixes dproper discovery of announced responsibility by FOUND
This commit is contained in:
parent
b23201a49c
commit
fc8aa3e330
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue