generalise NodeCache implementation to make it usable for neighbour nodes as well

contributes to #48

src/Hash2Pub/FediChordTypes.hs

@@ -150,6 +150,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
@@ -224,22 +225,39 @@ setSuccessors succ' ns = ns {successors = take (kNeighbours ns) . nub . sortBy (
 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'}
 
-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 HasKeyID a where
+    getKeyID :: a -> NodeID
+
+instance HasKeyID RemoteNodeState where
+    getKeyID = getNid
+
+instance HasKeyID CacheEntry where
+    getKeyID (CacheEntry _ ns _) = getNid ns
+
+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) } deriving (Show, Eq)
 
 -- | 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
+data RingEntry a = KeyEntry a
-    | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
+    | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a))
     deriving (Show, Eq)
 
--- | as a compromise, only NodeEntry components are ordered by their NodeID
+-- | 'RingEntry' type for usage as a node cache
--- while ProxyEntry components should never be tried to be ordered.
+data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime
-instance Ord CacheEntry where
 
+
+-- | as a compromise, only KeyEntry components are ordered by their NodeID
+-- while ProxyEntry components should never be tried to be ordered.
+instance Ord RingEntry where
     a `compare` b = compare (extractID a) (extractID b)
         where
-            extractID (NodeEntry _ eState _) = getNid eState
+            extractID (KeyEntry e) = getKeyID e
-            extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache"
+            extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap"
 
 data ProxyDirection = Backwards
     | Forwards
@@ -254,32 +272,48 @@ instance Enum ProxyDirection where
 
 --- useful function for getting entries for a full cache transfer
 cacheEntries :: NodeCache -> [CacheEntry]
-cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache
+cacheEntries = mapMaybe extractNodeEntries . Map.elems . getRingMap
     where
   extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
+  extractNodeEntries (KeyEntry entry)             = Just entry
 
 -- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
 -- linking the modular name space together by connecting @minBound@ and @maxBound@
-initCache :: NodeCache
+initRMap :: HasKeyID a => RingMap a
-initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
+initRMap = 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
-cacheLookup :: NodeID       -- ^lookup key
+initCache = initRingMap
-            -> NodeCache    -- ^lookup cache
+
-            -> Maybe CacheEntry
+-- | Maybe returns the entry stored at given key
-cacheLookup key cache = case Map.lookup key cache of
+rMapLookup :: HasKeyID a
+           => NodeID       -- ^lookup key
+           -> RingMap a    -- ^lookup cache
+           -> Maybe a
+rMapLookup key rmap = case Map.lookup key $ getRingMap rmap of
                           Just (ProxyEntry _ result) -> result
                           res                        -> res
 
+cacheLookup :: NodeID       -- ^lookup key
+            -> NodeCache    -- ^lookup cache
+            -> Maybe CacheEntry
+cacheLookup = rMapLookup
+
 -- | 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 :: HasKeyID a
-lookupWrapper f fRepeat direction key cache =
+              => (NodeID -> Map.Map NodeID a -> Maybe (NodeID, a))
-    case f key cache of
+              -> (NodeID -> Map.Map NodeID a -> Maybe (NodeID, 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 entry@KeyEntry{})) -> 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,38 +322,50 @@ lookupWrapper f fRepeat direction key cache =
             let newKey = if pointerDirection == direction
                             then pointerID
                             else foundKey + (fromInteger . toInteger . fromEnum $ direction)
-            in if cacheNotEmpty cache
+            in if rMapNotEmpty rmap
-               then lookupWrapper fRepeat fRepeat direction newKey cache
+               then lookupWrapper fRepeat fRepeat direction newKey rmap
                else Nothing
         -- normal entries are returned
-        Just (_, entry@NodeEntry{}) -> Just entry
+        Just (_, entry@KeyEntry{}) -> Just entry
         Nothing -> Nothing
   where
-    cacheNotEmpty :: NodeCache -> Bool
+    rMapNotEmpty :: RingMap a -> Bool
-    cacheNotEmpty cache' = (Map.size cache' > 2)     -- there are more than the 2 ProxyEntries
+    rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2)     -- there are more than the 2 ProxyEntries
-                   || isJust ( cacheLookup minBound cache') -- or one of the ProxyEntries holds a node
+                   || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node
-                   || isJust (cacheLookup maxBound cache')
+                   || 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
 
 -- 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 :: RingEntry CacheEntry -> RemoteNodeState
-cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
+cacheGetNodeStateUnvalidated (KeyEntry (CacheEntry _ nState _)) = nState
 cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
 cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug"