Merge branch 'refactorSuccessorsPredecessors' into dhtNetworking

src/Hash2Pub/DHTProtocol.hs

@@ -54,15 +54,20 @@ import           System.Timeout
 
 import           Hash2Pub.ASN1Coding
 import           Hash2Pub.FediChordTypes        (CacheEntry (..),
+                                                 CacheEntry (..), HasKeyID (..),
                                                  LocalNodeState (..),
                                                  LocalNodeStateSTM, NodeCache,
                                                  NodeID, NodeState (..),
                                                  RemoteNodeState (..),
+                                                 RingEntry (..), RingMap (..),
+                                                 addRMapEntry, addRMapEntryWith,
                                                  cacheGetNodeStateUnvalidated,
                                                  cacheLookup, cacheLookupPred,
-                                                 cacheLookupSucc, localCompare,
-                                                 localCompare, setPredecessors,
-                                                 setSuccessors)
+                                                 cacheLookupSucc, getKeyID,
+                                                 localCompare, localCompare,
+                                                 rMapFromList, rMapLookupPred,
+                                                 rMapLookupSucc,
+                                                 setPredecessors, setSuccessors)
 import           Hash2Pub.ProtocolTypes
 
 import           Debug.Trace                    (trace)
@@ -74,7 +79,7 @@ import           Debug.Trace                    (trace)
 queryLocalCache :: LocalNodeState -> NodeCache -> Int -> NodeID -> QueryResponse
 queryLocalCache ownState nCache lBestNodes targetID
     -- as target ID falls between own ID and first predecessor, it is handled by this node
-      | (targetID `localCompare`  ownID) `elem` [LT, EQ] && maybe False (\p -> targetID `localCompare` p  == GT) (getNid <$> headMay preds) = FOUND . toRemoteNodeState $ ownState
+      | isInOwnResponsibilitySlice ownState targetID = FOUND . toRemoteNodeState $ ownState
     -- my interpretation: the "l best next hops" are the l-1 closest preceding nodes and
     -- the closest succeeding node (like with the p initiated parallel queries
       | otherwise = FORWARD $ closestSuccessor `Set.union` closestPredecessors
@@ -83,10 +88,10 @@ queryLocalCache ownState nCache lBestNodes targetID
     preds = predecessors ownState
 
     closestSuccessor :: Set.Set RemoteCacheEntry
-    closestSuccessor = maybe Set.empty Set.singleton $ toRemoteCacheEntry =<< cacheLookupSucc targetID nCache
+    closestSuccessor = maybe Set.empty (Set.singleton . toRemoteCacheEntry) $ cacheLookupSucc targetID nCache
 
     closestPredecessors :: Set.Set RemoteCacheEntry
-    closestPredecessors = closestPredecessor (lBestNodes-1) $ getNid ownState
+    closestPredecessors = closestPredecessor (lBestNodes-1) targetID
     closestPredecessor :: (Integral n, Show n) => n -> NodeID -> Set.Set RemoteCacheEntry
     closestPredecessor 0 _ = Set.empty
     closestPredecessor remainingLookups lastID
@@ -94,10 +99,24 @@ queryLocalCache ownState nCache lBestNodes targetID
       | otherwise =
         let result = cacheLookupPred lastID nCache
       in
-        case toRemoteCacheEntry =<< result of
+        case toRemoteCacheEntry <$> result of
           Nothing -> Set.empty
           Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns)
 
+-- | Determines whether a lookup key is within the responsibility slice of a node,
+-- as it falls between its first predecessor and the node itself.
+-- Looks up the successor of the lookup key on a 'RingMap' representation of the
+-- predecessor list with the node itself added. If the result is the same as the node
+-- itself then it falls into the responsibility interval.
+isInOwnResponsibilitySlice :: HasKeyID a => LocalNodeState -> a -> Bool
+isInOwnResponsibilitySlice ownNs lookupTarget = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget) predecessorRMap) == pure (getNid ownNs)
+  where
+    predecessorList = predecessors ownNs
+    -- add node itself to RingMap representation, to distinguish between
+    -- responsibility of own node and predecessor
+    predecessorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList predecessorList
+    closestPredecessor = headMay predecessorList
+
 -- cache operations
 
 -- | update or insert a 'RemoteCacheEntry' into the cache,
@@ -111,18 +130,18 @@ addCacheEntry entry cache = do
 
 -- | pure version of 'addCacheEntry' with current time explicitly specified as argument
 addCacheEntryPure :: POSIXTime      -- ^ current time
-              -> RemoteCacheEntry   -- ^ a remote cache entry received from network
-              -> NodeCache          -- ^ node cache to insert to
-              -> NodeCache       -- ^ new node cache with the element inserted
+                  -> RemoteCacheEntry   -- ^ a remote cache entry received from network
+                  -> NodeCache          -- ^ node cache to insert to
+                  -> NodeCache       -- ^ new node cache with the element inserted
 addCacheEntryPure now (RemoteCacheEntry ns ts) cache =
     let
         -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity
         timestamp' = if ts <= now then ts else now
-        newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache
-        insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal =
+        newCache = addRMapEntryWith insertCombineFunction (CacheEntry False ns timestamp') cache
+        insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal =
             case oldVal of
               ProxyEntry n _ -> ProxyEntry n (Just newVal)
-              NodeEntry oldValidationState _ oldTimestamp  -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp)
+              KeyEntry (CacheEntry oldValidationState _ oldTimestamp)  -> KeyEntry (CacheEntry oldValidationState newNode (max oldTimestamp newTimestamp))
     in
       newCache
 
@@ -130,10 +149,10 @@ addCacheEntryPure now (RemoteCacheEntry ns ts) cache =
 deleteCacheEntry :: NodeID      -- ^ID of the node to be deleted
                  -> NodeCache   -- ^cache to delete from
                  -> NodeCache   -- ^cache without the specified element
-deleteCacheEntry = Map.update modifier
+deleteCacheEntry nid = RingMap . Map.update modifier nid . getRingMap
   where
     modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
-    modifier NodeEntry {}             = Nothing
+    modifier KeyEntry {}              = Nothing
 
 -- | Mark a cache entry as verified after pinging it, possibly bumping its timestamp.
 markCacheEntryAsVerified :: Maybe POSIXTime     -- ^ the (current) timestamp to be
@@ -141,9 +160,9 @@ markCacheEntryAsVerified :: Maybe POSIXTime     -- ^ the (current) timestamp to
                          -> NodeID              -- ^ which node to mark
                          -> NodeCache           -- ^ current node cache
                          -> NodeCache           -- ^ new NodeCache with the updated entry
-markCacheEntryAsVerified timestamp = Map.adjust adjustFunc
+markCacheEntryAsVerified timestamp nid = RingMap . Map.adjust adjustFunc nid . getRingMap
     where
-        adjustFunc (NodeEntry _ ns ts) = NodeEntry True ns $ fromMaybe ts timestamp
+        adjustFunc (KeyEntry (CacheEntry _ ns ts)) = KeyEntry (CacheEntry True ns $ fromMaybe ts timestamp)
         adjustFunc (ProxyEntry _ (Just entry)) = adjustFunc entry
         adjustFunc entry = entry
 

src/Hash2Pub/FediChordTypes.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
 
 module Hash2Pub.FediChordTypes (
     NodeID -- abstract, but newtype constructors cannot be hidden
@@ -15,8 +16,25 @@ module Hash2Pub.FediChordTypes (
   , setPredecessors
   , NodeCache
   , CacheEntry(..)
+  , RingEntry(..)
+  , RingMap(..)
+  , HasKeyID
+                               , getKeyID
+  , rMapSize
+  , rMapLookup
+  , rMapLookupPred
+  , rMapLookupSucc
+  , addRMapEntry
+  , addRMapEntryWith
+  , takeRMapPredecessors
+  , takeRMapSuccessors
+  , deleteRMapEntry
+  , setRMapEntries
+                               , rMapFromList
+                               , rMapToList
   , cacheGetNodeStateUnvalidated
   , initCache
+  , cacheEntries
   , cacheLookup
   , cacheLookupSucc
   , cacheLookupPred
@@ -32,10 +50,12 @@ module Hash2Pub.FediChordTypes (
                            ) where
 
 import           Control.Exception
+import           Data.Foldable                 (foldr')
 import           Data.Function                 (on)
 import           Data.List                     (delete, nub, sortBy)
 import qualified Data.Map.Strict               as Map
-import           Data.Maybe                    (fromMaybe, isJust, mapMaybe)
+import           Data.Maybe                    (fromJust, fromMaybe, isJust,
+                                                isNothing, mapMaybe)
 import qualified Data.Set                      as Set
 import           Data.Time.Clock.POSIX
 import           Network.Socket
@@ -150,6 +170,7 @@ data LocalNodeState = LocalNodeState
     }
     deriving (Show, Eq)
 
+-- | for concurrent access, LocalNodeState is wrapped in a TVar
 type LocalNodeStateSTM = TVar LocalNodeState
 
 -- | class for various NodeState representations, providing
@@ -216,30 +237,58 @@ instance Typeable a => Show (TVar a) where
 instance Typeable a => Show (TQueue a) where
     show x = show (typeOf x)
 
+
 -- | convenience function that updates the successors of a 'LocalNodeState'
 setSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-setSuccessors succ' ns = ns {successors = take (kNeighbours ns) . nub . sortBy (localCompare `on` getNid) . filter ((== LT) . (localCompare `on` getNid) (toRemoteNodeState ns)) $ succ'}
+setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList $ succs}
 
 -- | convenience function that updates the predecessors of a 'LocalNodeState'
 setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-setPredecessors pred' ns = ns {predecessors = take (kNeighbours ns) . nub . sortBy (flip localCompare `on` getNid) . filter ((== GT) . (localCompare `on` getNid) (toRemoteNodeState ns)) $ pred'}
+setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList $ preds}
 
-type NodeCache = Map.Map NodeID CacheEntry
+-- | Class for all types that can be identified via an EpiChord key.
+-- Used for restricting the types a 'RingMap' can store
+class (Eq a, Show a) => HasKeyID a where
+    getKeyID :: a -> NodeID
 
--- | An entry of the 'nodeCache' can hold 2 different kinds of data.
--- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here.
-data CacheEntry = NodeEntry Bool RemoteNodeState POSIXTime
-    | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
+instance HasKeyID RemoteNodeState where
+    getKeyID = getNid
+
+instance HasKeyID CacheEntry where
+    getKeyID (CacheEntry _ ns _) = getNid ns
+
+instance HasKeyID NodeID where
+    getKeyID = id
+
+type NodeCache = RingMap CacheEntry
+
+-- | generic data structure for holding elements with a key and modular lookup
+newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
+
+instance (HasKeyID a) => Eq (RingMap a) where
+    a == b = getRingMap a == getRingMap b
+
+instance (HasKeyID a) => Show (RingMap a) where
+    show rmap = shows "RingMap " (show $ getRingMap rmap)
+
+-- | entry of a 'RingMap' that holds a value and can also
+-- wrap around the lookup direction at the edges of the name space.
+data RingEntry a = KeyEntry a
+    | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a))
     deriving (Show, Eq)
 
--- | as a compromise, only NodeEntry components are ordered by their NodeID
--- while ProxyEntry components should never be tried to be ordered.
-instance Ord CacheEntry where
+-- | 'RingEntry' type for usage as a node cache
+data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime
+    deriving (Show, Eq)
 
+
+-- | as a compromise, only KeyEntry components are ordered by their NodeID
+-- while ProxyEntry components should never be tried to be ordered.
+instance (HasKeyID a, Eq a) => Ord (RingEntry a) where
     a `compare` b = compare (extractID a) (extractID b)
         where
-            extractID (NodeEntry _ eState _) = getNid eState
-            extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache"
+            extractID (KeyEntry e) = getKeyID e
+            extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap"
 
 data ProxyDirection = Backwards
     | Forwards
@@ -252,34 +301,63 @@ instance Enum ProxyDirection where
     fromEnum Backwards = - 1
     fromEnum Forwards  = 1
 
+-- | helper function for getting the a from a RingEntry a
+extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a
+extractRingEntry (KeyEntry entry)                       = Just entry
+extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry
+extractRingEntry _                                      = Nothing
+
 --- useful function for getting entries for a full cache transfer
 cacheEntries :: NodeCache -> [CacheEntry]
-cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache
-    where
-  extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
+cacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap
 
--- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
+-- | An empty 'RingMap' needs to be initialised with 2 proxy entries,
 -- linking the modular name space together by connecting @minBound@ and @maxBound@
-initCache :: NodeCache
-initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
+emptyRMap :: HasKeyID a => RingMap a
+emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
   where
     proxyEntry (from,to) = (from, ProxyEntry to Nothing)
 
--- | Maybe returns the cache entry stored at given key
+initCache :: NodeCache
+initCache = emptyRMap
+
+-- | Maybe returns the entry stored at given key
+rMapLookup :: HasKeyID a
+           => NodeID       -- ^lookup key
+           -> RingMap a    -- ^lookup cache
+           -> Maybe a
+rMapLookup key rmap =  extractRingEntry =<< Map.lookup key (getRingMap rmap)
+
 cacheLookup :: NodeID       -- ^lookup key
             -> NodeCache    -- ^lookup cache
             -> Maybe CacheEntry
-cacheLookup key cache = case Map.lookup key cache of
-                          Just (ProxyEntry _ result) -> result
-                          res                        -> res
+cacheLookup = rMapLookup
+
+-- | returns number of present 'KeyEntry' in a properly initialised 'RingMap'
+rMapSize :: (HasKeyID a, Integral i)
+         => RingMap a
+         -> i
+rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound
+  where
+    innerMap = getRingMap rmap
+    oneIfEntry :: Integral i => NodeID -> i
+    oneIfEntry nid
+      | isNothing (rMapLookup nid rmap) = 1
+      | otherwise = 0
 
 -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
 -- to simulate a modular ring
-lookupWrapper :: (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> ProxyDirection -> NodeID -> NodeCache -> Maybe CacheEntry
-lookupWrapper f fRepeat direction key cache =
-    case f key cache of
+lookupWrapper :: HasKeyID a
+              => (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
+              -> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
+              -> ProxyDirection
+              -> NodeID
+              -> RingMap a
+              -> Maybe a
+lookupWrapper f fRepeat direction key rmap =
+    case f key $ getRingMap rmap of
         -- the proxy entry found holds a
-        Just (_, ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry
+        Just (_, ProxyEntry _ (Just (KeyEntry entry))) -> Just entry
         -- proxy entry holds another proxy entry, this should not happen
         Just (_, ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing
         -- proxy entry without own entry is a pointer on where to continue
@@ -288,40 +366,134 @@ lookupWrapper f fRepeat direction key cache =
             let newKey = if pointerDirection == direction
                             then pointerID
                             else foundKey + (fromInteger . toInteger . fromEnum $ direction)
-            in if cacheNotEmpty cache
-               then lookupWrapper fRepeat fRepeat direction newKey cache
+            in if rMapNotEmpty rmap
+               then lookupWrapper fRepeat fRepeat direction newKey rmap
                else Nothing
         -- normal entries are returned
-        Just (_, entry@NodeEntry{}) -> Just entry
+        Just (_, (KeyEntry entry)) -> Just entry
         Nothing -> Nothing
   where
-    cacheNotEmpty :: NodeCache -> Bool
-    cacheNotEmpty cache' = (Map.size cache' > 2)     -- there are more than the 2 ProxyEntries
-                   || isJust ( cacheLookup minBound cache') -- or one of the ProxyEntries holds a node
-                   || isJust (cacheLookup maxBound cache')
+    rMapNotEmpty :: (HasKeyID a) => RingMap a -> Bool
+    rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2)     -- there are more than the 2 ProxyEntries
+                   || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node
+                   || isJust (rMapLookup maxBound rmap')
 
--- | find the successor node to a given key on a modular EpiChord ring cache.
+-- | find the successor node to a given key on a modular EpiChord ring.
 -- Note: The EpiChord definition of "successor" includes the node at the key itself,
 -- if existing.
+rMapLookupSucc :: HasKeyID a
+               => NodeID           -- ^lookup key
+               -> RingMap a        -- ^ring cache
+               -> Maybe a
+rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
+
 cacheLookupSucc :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe CacheEntry
-cacheLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
+cacheLookupSucc = rMapLookupSucc
+
+-- | find the predecessor node to a given key on a modular EpiChord ring.
+rMapLookupPred :: HasKeyID a
+               => NodeID           -- ^lookup key
+               -> RingMap a        -- ^ring cache
+               -> Maybe a
+rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
 
--- | find the predecessor node to a given key on a modular EpiChord ring cache.
 cacheLookupPred :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe CacheEntry
-cacheLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
+cacheLookupPred = rMapLookupPred
+
+addRMapEntryWith :: HasKeyID a
+                 => (RingEntry a -> RingEntry a -> RingEntry a)
+                 -> a
+                 -> RingMap a
+                 -> RingMap a
+addRMapEntryWith combineFunc entry = RingMap
+    . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry)
+    . getRingMap
+
+addRMapEntry :: HasKeyID a
+             => a
+             -> RingMap a
+             -> RingMap a
+addRMapEntry = addRMapEntryWith insertCombineFunction
+  where
+    insertCombineFunction newVal oldVal =
+        case oldVal of
+          ProxyEntry n _ -> ProxyEntry n (Just newVal)
+          KeyEntry _     -> newVal
+
+
+addRMapEntries :: (Foldable t, HasKeyID a)
+               => t a
+               -> RingMap a
+               -> RingMap a
+addRMapEntries entries rmap = foldr' addRMapEntry rmap entries
+
+setRMapEntries :: (Foldable t, HasKeyID a)
+               => t a
+               -> RingMap a
+setRMapEntries entries = addRMapEntries entries emptyRMap
+
+deleteRMapEntry :: (HasKeyID a)
+                => NodeID
+                -> RingMap a
+                -> RingMap a
+deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap
+  where
+    modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
+    modifier KeyEntry {}              = Nothing
+
+rMapToList :: (HasKeyID a) => RingMap a -> [a]
+rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap
+
+rMapFromList :: (HasKeyID a) => [a] -> RingMap a
+rMapFromList = setRMapEntries
+
+-- | takes up to i entries from a 'RingMap' by calling a getter function on a
+-- *startAt* value and after that on the previously returned value.
+-- Stops once i entries have been taken or an entry has been encountered twice
+-- (meaning the ring has been traversed completely).
+-- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'.
+takeRMapEntries_ :: (HasKeyID a, Integral i)
+                 => (NodeID -> RingMap a -> Maybe a)
+                 -> NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+-- TODO: might be more efficient with dlists
+takeRMapEntries_ getterFunc startAt num rmap = reverse $
+    case getterFunc startAt rmap of
+      Nothing -> []
+      Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry]
+  where
+    takeEntriesUntil havingReached previousEntry remaining takeAcc
+      | remaining <= 0 = takeAcc
+      | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
+      | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap
+                    in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
+
+takeRMapPredecessors :: (HasKeyID a, Integral i)
+                 => NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+takeRMapPredecessors = takeRMapEntries_ rMapLookupPred
+
+takeRMapSuccessors :: (HasKeyID a, Integral i)
+                 => NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc
 
 -- clean up cache entries: once now - entry > maxAge
 -- transfer difference now - entry to other node
 
 -- | return the @NodeState@ data from a cache entry without checking its validation status
 cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState
-cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
-cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
-cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug"
+cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState
 
 -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
 ipAddrAsBS :: HostAddress6 -> BS.ByteString

src/Hash2Pub/ProtocolTypes.hs

@@ -89,15 +89,12 @@ data RemoteCacheEntry = RemoteCacheEntry RemoteNodeState POSIXTime
 instance Ord RemoteCacheEntry where
     (RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2
 
--- | Extracts a 'RemoteCacheEntry' from the indirections of a 'CacheEntry', if it holds one
-toRemoteCacheEntry :: CacheEntry -> Maybe RemoteCacheEntry
-toRemoteCacheEntry (NodeEntry _ ns ts) = Just $ RemoteCacheEntry ns ts
-toRemoteCacheEntry (ProxyEntry _ (Just entry@NodeEntry{})) = toRemoteCacheEntry entry
-toRemoteCacheEntry _ = Nothing
+toRemoteCacheEntry :: CacheEntry -> RemoteCacheEntry
+toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts
 
 -- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers
 toRemoteCache :: NodeCache -> [RemoteCacheEntry]
-toRemoteCache cache = mapMaybe toRemoteCacheEntry $ Map.elems cache
+toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache
 
 -- | extract the 'NodeState' from a 'RemoteCacheEntry'
 remoteNode :: RemoteCacheEntry -> RemoteNodeState

test/FediChordSpec.hs

@@ -2,11 +2,11 @@
 module FediChordSpec where
 
 import           Control.Exception
-import           Data.ASN1.Parse       (runParseASN1)
-import qualified Data.ByteString       as BS
-import qualified Data.Map.Strict       as Map
-import           Data.Maybe            (fromJust, isJust)
-import qualified Data.Set              as Set
+import           Data.ASN1.Parse         (runParseASN1)
+import qualified Data.ByteString         as BS
+import qualified Data.Map.Strict         as Map
+import           Data.Maybe              (fromJust, isJust)
+import qualified Data.Set                as Set
 import           Data.Time.Clock.POSIX
 import           Network.Socket
 import           Test.Hspec
@@ -14,6 +14,7 @@ import           Test.Hspec
 import           Hash2Pub.ASN1Coding
 import           Hash2Pub.DHTProtocol
 import           Hash2Pub.FediChord
+import           Hash2Pub.FediChordTypes
 
 spec :: Spec
 spec = do
@@ -79,8 +80,8 @@ spec = do
             newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache)
             exampleID = nid exampleNodeState
         it "entries can be added to a node cache and looked up again" $ do
-            -- the cache includes 2 additional proxy elements right from the start
-            Map.size newCache - Map.size emptyCache `shouldBe` 2
+            rMapSize emptyCache `shouldBe` 0
+            rMapSize newCache `shouldBe` 2
             -- normal entry lookup
             nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID
             nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing
@@ -126,28 +127,51 @@ spec = do
             node3 = exampleNodeState { nid = nid3}
             nid4 = toNodeID 2^(9::Integer)+100
             node4 = exampleNodeState { nid = nid4}
-            cacheWith2Entries :: IO NodeCache
-            cacheWith2Entries = addCacheEntryPure 10 <$> (RemoteCacheEntry <$> (toRemoteNodeState <$> node1) <*> pure 10) <*> pure (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
-            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) <$> (addCacheEntryPure 10 (RemoteCacheEntry node4 10) <$> cacheWith2Entries)
-        it "works on an empty cache" $ do
-            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FORWARD Set.empty
-            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FORWARD Set.empty
+            nid5 = toNodeID 2^(25::Integer)+100
+            node5 = exampleNodeState { nid = nid5}
+            cacheWith2Entries :: NodeCache
+            cacheWith2Entries = addCacheEntryPure 10 (RemoteCacheEntry node5 10) (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
+            cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) (addCacheEntryPure 10 (RemoteCacheEntry node4 10) cacheWith2Entries)
+        it "nodes not joined provide the default answer FOUND" $ do
+            exampleLocalNodeAsRemote <- toRemoteNodeState <$> exampleLocalNode
+            queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FOUND exampleLocalNodeAsRemote
+            queryLocalCache <$> exampleLocalNode <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FOUND exampleLocalNodeAsRemote
+        it "joined nodes do not fall back to the default" $
+            queryLocalCache <$> node1 <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 3) `shouldReturn` FORWARD Set.empty
         it "works on a cache with less entries than needed" $ do
-            (FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
+            (FORWARD nodeset) <- queryLocalCache <$> node1 <*> pure cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
+            Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid5, nid2 ]
         it "works on a cache with sufficient entries" $ do
-            (FORWARD nodeset1) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
-            (FORWARD nodeset2) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
-            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3]
+            (FORWARD nodeset1) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
+            (FORWARD nodeset2) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
+            Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid5]
             Set.map (nid . remoteNode) nodeset2 `shouldBe` Set.fromList [nid4]
         it "recognises the node's own responsibility" $ do
-            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure nid1
+            FOUND selfQueryRes <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure nid1
             getNid <$> node1 `shouldReturn` getNid selfQueryRes
-            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
+            FOUND responsibilityResult <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
             getNid <$> node1 `shouldReturn` getNid responsibilityResult
-        it "does not fail on nodes without neighbours (initial state)" $ do
-            (FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 11)
-            Set.map (nid . remoteNode ) nodeset `shouldBe` Set.fromList [nid4, nid2, nid3]
+    describe "successors and predecessors do not disturb the ring characteristics of EpiChord operations (see #48)" $ do
+        let
+            emptyCache = initCache
+            -- implicitly relies on kNieghbours to be <= 3
+            thisNid = toNodeID 1000
+            thisNode = setNid thisNid <$> exampleLocalNode
+            nid2 = toNodeID 1003
+            node2 = exampleNodeState { nid = nid2}
+            nid3 = toNodeID 1010
+            node3 = exampleNodeState { nid = nid3}
+            nid4 = toNodeID 1020
+            node4 = exampleNodeState { nid = nid4}
+            nid5 = toNodeID 1025
+            node5 = exampleNodeState { nid = nid5}
+            allRemoteNodes = [node2, node3, node4, node5]
+        it "lookups also work for slices larger than 1/2 key space" $ do
+            node <- setSuccessors allRemoteNodes . setPredecessors allRemoteNodes <$> thisNode
+            -- do lookup on empty cache but with successors for a key > 1/2 key space
+            -- succeeding the node
+            queryLocalCache node emptyCache 1 (nid5 + 10) `shouldBe` FOUND (toRemoteNodeState node)
+
 
     describe "Messages can be encoded to and decoded from ASN.1" $ do
         -- define test messages