app/Main.hs

@@ -20,7 +20,7 @@ main = do
     -- ToDo: load persisted caches, bootstrapping nodes …
     (serverSock, thisNode) <- fediChordInit conf
     -- currently no masking is necessary, as there is nothing to clean up
-    nodeCacheWriterThread <- forkIO $ nodeCacheWriter thisNode
+    cacheWriterThread <- forkIO $ cacheWriter thisNode
     -- try joining the DHT using one of the provided bootstrapping nodes
     joinedState <- tryBootstrapJoining thisNode
     either (\err -> do

src/Hash2Pub/FediChord.hs

@@ -47,7 +47,7 @@ module Hash2Pub.FediChord (
   , mkServerSocket
   , mkSendSocket
   , resolve
-  , nodeCacheWriter
+  , cacheWriter
   , joinOnNewEntriesThread
                            ) where
 
@@ -94,12 +94,10 @@ import           Debug.Trace                   (trace)
 -- ToDo: load persisted state, thus this function already operates in IO
 fediChordInit :: FediChordConf -> IO (Socket, LocalNodeStateSTM)
 fediChordInit initConf = do
-    emptyLookupCache <- newTVarIO Map.empty
     let realNode = RealNode {
             vservers = []
           , nodeConfig = initConf
           , bootstrapNodes = confBootstrapNodes initConf
-          , lookupCacheSTM = emptyLookupCache
                             }
     realNodeSTM <- newTVarIO realNode
     initialState <- nodeStateInit realNodeSTM
@@ -285,8 +283,8 @@ joinOnNewEntriesThread nsSTM = loop
 
 -- | cache updater thread that waits for incoming NodeCache update instructions on
 -- the node's cacheWriteQueue and then modifies the NodeCache as the single writer.
-nodeCacheWriter :: LocalNodeStateSTM -> IO ()
+cacheWriter :: LocalNodeStateSTM -> IO ()
-nodeCacheWriter nsSTM =
+cacheWriter nsSTM =
     forever $ atomically $ do
         ns <- readTVar nsSTM
         cacheModifier <- readTQueue $ cacheWriteQueue ns
@@ -299,8 +297,8 @@ maxEntryAge = 600
 
 
 -- | Periodically iterate through cache, clean up expired entries and verify unverified ones
-nodeCacheVerifyThread :: LocalNodeStateSTM -> IO ()
+cacheVerifyThread :: LocalNodeStateSTM -> IO ()
-nodeCacheVerifyThread nsSTM = forever $ do
+cacheVerifyThread nsSTM = forever $ do
     putStrLn "cache verify run: begin"
     -- get cache
     (ns, cache) <- atomically $ do
@@ -310,7 +308,7 @@ nodeCacheVerifyThread nsSTM = forever $ do
     -- iterate entries:
     -- for avoiding too many time syscalls, get current time before iterating.
     now <- getPOSIXTime
-    forM_ (nodeCacheEntries cache) (\(CacheEntry validated node ts) ->
+    forM_ (cacheEntries cache) (\(CacheEntry validated node ts) ->
         -- case too old: delete (future work: decide whether pinging and resetting timestamp is better)
         if (now - ts) > maxEntryAge
            then
@@ -543,7 +541,7 @@ fediMainThreads sock nsSTM = do
     concurrently_
         (fediMessageHandler sendQ recvQ nsSTM) $
         concurrently_ (stabiliseThread nsSTM) $
-            concurrently_ (nodeCacheVerifyThread nsSTM) $
+            concurrently_ (cacheVerifyThread nsSTM) $
                 concurrently_ (convergenceSampleThread nsSTM) $
                     concurrently_
                         (sendThread sock sendQ)

src/Hash2Pub/FediChordTypes.hs

@@ -18,7 +18,6 @@ module Hash2Pub.FediChordTypes (
   , setSuccessors
   , setPredecessors
   , NodeCache
-  , NodeCacheEntry
   , CacheEntry(..)
   , RingEntry(..)
   , RingMap(..)
@@ -40,7 +39,7 @@ module Hash2Pub.FediChordTypes (
   , rMapToList
   , cacheGetNodeStateUnvalidated
   , initCache
-  , nodeCacheEntries
+  , cacheEntries
   , cacheLookup
   , cacheLookupSucc
   , cacheLookupPred
@@ -145,8 +144,6 @@ data RealNode = RealNode
     -- ^ holds the initial configuration read at program start
     , bootstrapNodes :: [(String, PortNumber)]
     -- ^ nodes to be used as bootstrapping points, new ones learned during operation
-    , lookupCacheSTM :: TVar LookupCache
-    -- ^ a global cache of looked up keys and their associated nodes
     }
 
 type RealNodeSTM = TVar RealNode
@@ -287,17 +284,13 @@ class (Eq a, Show a) => HasKeyID a where
 instance HasKeyID RemoteNodeState where
     getKeyID = getNid
 
-instance HasKeyID a => HasKeyID (CacheEntry a) where
+instance HasKeyID CacheEntry where
-    getKeyID (CacheEntry _ obj _) = getKeyID obj
+    getKeyID (CacheEntry _ ns _) = getNid ns
 
 instance HasKeyID NodeID where
     getKeyID = id
 
-type NodeCacheEntry = CacheEntry RemoteNodeState
+type NodeCache = RingMap CacheEntry
-type NodeCache = RingMap NodeCacheEntry
-
-type LookupCacheEntry = CacheEntry (String, PortNumber)
-type LookupCache = Map.Map NodeID LookupCacheEntry
 
 -- | generic data structure for holding elements with a key and modular lookup
 newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
@@ -315,7 +308,7 @@ data RingEntry a = KeyEntry a
     deriving (Show, Eq)
 
 -- | 'RingEntry' type for usage as a node cache
-data CacheEntry a = CacheEntry Bool a POSIXTime
+data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime
     deriving (Show, Eq)
 
 
@@ -345,8 +338,8 @@ extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry
 extractRingEntry _                                      = Nothing
 
 --- useful function for getting entries for a full cache transfer
-nodeCacheEntries :: NodeCache -> [NodeCacheEntry]
+cacheEntries :: NodeCache -> [CacheEntry]
-nodeCacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap
+cacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap
 
 -- | An empty 'RingMap' needs to be initialised with 2 proxy entries,
 -- linking the modular name space together by connecting @minBound@ and @maxBound@
@@ -367,7 +360,7 @@ rMapLookup key rmap =  extractRingEntry =<< Map.lookup key (getRingMap rmap)
 
 cacheLookup :: NodeID       -- ^lookup key
             -> NodeCache    -- ^lookup cache
-            -> Maybe NodeCacheEntry
+            -> Maybe CacheEntry
 cacheLookup = rMapLookup
 
 -- | returns number of present 'KeyEntry' in a properly initialised 'RingMap'
@@ -426,7 +419,7 @@ rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
 
 cacheLookupSucc :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
-                -> Maybe NodeCacheEntry
+                -> Maybe CacheEntry
 cacheLookupSucc = rMapLookupSucc
 
 -- | find the predecessor node to a given key on a modular EpiChord ring.
@@ -438,7 +431,7 @@ rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
 
 cacheLookupPred :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
-                -> Maybe NodeCacheEntry
+                -> Maybe CacheEntry
 cacheLookupPred = rMapLookupPred
 
 addRMapEntryWith :: HasKeyID a
@@ -529,7 +522,7 @@ takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc
 -- transfer difference now - entry to other node
 
 -- | return the @NodeState@ data from a cache entry without checking its validation status
-cacheGetNodeStateUnvalidated :: CacheEntry RemoteNodeState -> RemoteNodeState
+cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState
 cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState
 
 -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString

src/Hash2Pub/ProtocolTypes.hs

@@ -89,12 +89,12 @@ data RemoteCacheEntry = RemoteCacheEntry RemoteNodeState POSIXTime
 instance Ord RemoteCacheEntry where
     (RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2
 
-toRemoteCacheEntry :: NodeCacheEntry -> RemoteCacheEntry
+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 = toRemoteCacheEntry <$> nodeCacheEntries cache
+toRemoteCache cache = toRemoteCacheEntry <$> cacheEntries cache
 
 -- | extract the 'NodeState' from a 'RemoteCacheEntry'
 remoteNode :: RemoteCacheEntry -> RemoteNodeState