WIP: implement adding, setting and taking RingMap entries.

contributes to #48

src/Hash2Pub/DHTProtocol.hs

@@ -121,13 +121,13 @@ 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) (KeyEntry (CacheEntry False ns timestamp')) $ getRingMap cache
+        newCache = addRMapEntryWith insertCombineFunction (KeyEntry (CacheEntry False ns timestamp')) cache
         insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal =
             case oldVal of
               ProxyEntry n _ -> ProxyEntry n (Just newVal)
               KeyEntry (CacheEntry oldValidationState _ oldTimestamp)  -> KeyEntry (CacheEntry oldValidationState newNode (max oldTimestamp newTimestamp))
     in
-      RingMap newCache
+      newCache
 
 -- | delete the node with given ID from cache
 deleteCacheEntry :: NodeID      -- ^ID of the node to be deleted

src/Hash2Pub/FediChordTypes.hs

@@ -19,6 +19,10 @@ module Hash2Pub.FediChordTypes (
   , RingEntry(..)
   , RingMap(..)
   , rMapSize
+  , addRMapEntry
+  , addRMapEntryWith
+  , takeRMapPredecessors
+  , takeRMapSuccessors
   , cacheGetNodeStateUnvalidated
   , initCache
   , cacheEntries
@@ -37,11 +41,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, isNothing,
+import           Data.Maybe                    (fromJust, fromMaybe, isJust,
-                                                mapMaybe)
+                                                isNothing, mapMaybe)
 import qualified Data.Set                      as Set
 import           Data.Time.Clock.POSIX
 import           Network.Socket
@@ -141,9 +146,9 @@ data LocalNodeState = LocalNodeState
     -- ^ EpiChord node cache with expiry times for nodes
     , cacheWriteQueue     :: TQueue (NodeCache -> NodeCache)
     -- ^ cache updates are not written directly to the  'nodeCache' but queued and
-    , successors          :: [RemoteNodeState] -- could be a set instead as these are ordered as well
+    , successors          :: RingMap RemoteNodeState -- could be a set instead as these are ordered as well
     -- ^ successor nodes in ascending order by distance
-    , predecessors        :: [RemoteNodeState]
+    , predecessors        :: RingMap RemoteNodeState
     -- ^ predecessor nodes in ascending order by distance
     , kNeighbours         :: Int
     -- ^ desired length of predecessor and successor list
@@ -233,7 +238,7 @@ setPredecessors pred' ns = ns {predecessors = take (kNeighbours ns) . nub . sort
 
 -- | Class for all types that can be identified via an EpiChord key.
 -- Used for restricting the types a 'RingMap' can store
-class HasKeyID a where
+class (Eq a, Show a) => HasKeyID a where
     getKeyID :: a -> NodeID
 
 instance HasKeyID RemoteNodeState where
@@ -247,8 +252,14 @@ 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) }
 
--- | An entry of the 'nodeCache' can hold 2 different kinds of data.
+instance Eq (RingMap a) where
--- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here.
+    a == b = getRingMap a == getRingMap b
+
+instance Show (RingMap a) where
+    show rmap = shows (getRingMap rmap) "RingMap "
+
+-- | 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)
@@ -286,15 +297,15 @@ cacheEntries = mapMaybe extractNodeEntries . Map.elems . getRingMap
   extractNodeEntries (KeyEntry entry)                       = Just entry
   extractNodeEntries _                                      = Nothing
 
--- | 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@
-initRMap :: HasKeyID a => RingMap a
+emptyRMap :: HasKeyID a => RingMap a
-initRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
+emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
   where
     proxyEntry (from,to) = (from, ProxyEntry to Nothing)
 
 initCache :: NodeCache
-initCache = initRMap
+initCache = emptyRMap
 
 -- | Maybe returns the entry stored at given key
 rMapLookup :: HasKeyID a
@@ -382,6 +393,77 @@ cacheLookupPred :: NodeID           -- ^lookup key
                 -> Maybe CacheEntry
 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
+
+-- | 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
+    -- TODO: figure out correct type signature once it compiles
+    --takeEntriesUntil :: (HasKeyID b, Integral i) => NodeID -> NodeID -> i -> [b] -> [b]
+    takeEntriesUntil havingReached previousEntry remaining takeAcc
+      | remaining <= 0 = takeAcc
+      | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
+      | otherwise = let (Just gotEntry) = getterFunc (getKeyID previousEntry) rmap
+                    in takeEntriesUntil (getKeyID 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