diff --git a/app/Main.hs b/app/Main.hs index 85db925..cdfc2b3 100644 --- a/app/Main.hs +++ b/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 diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index dc32c77..479a3af 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/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 () -nodeCacheWriter nsSTM = +cacheWriter :: LocalNodeStateSTM -> IO () +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 () -nodeCacheVerifyThread nsSTM = forever $ do +cacheVerifyThread :: LocalNodeStateSTM -> IO () +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) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index 9366a3f..296ebfa 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/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 - getKeyID (CacheEntry _ obj _) = getKeyID obj +instance HasKeyID CacheEntry where + getKeyID (CacheEntry _ ns _) = getNid ns instance HasKeyID NodeID where getKeyID = id -type NodeCacheEntry = CacheEntry RemoteNodeState -type NodeCache = RingMap NodeCacheEntry - -type LookupCacheEntry = CacheEntry (String, PortNumber) -type LookupCache = Map.Map NodeID LookupCacheEntry +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) } @@ -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] -nodeCacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap +cacheEntries :: NodeCache -> [CacheEntry] +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 diff --git a/src/Hash2Pub/ProtocolTypes.hs b/src/Hash2Pub/ProtocolTypes.hs index 37c00e9..15cb863 100644 --- a/src/Hash2Pub/ProtocolTypes.hs +++ b/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