From 42af6afb86d2c292a75b018172657f1d5295a3c5 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Wed, 15 Jul 2020 01:26:10 +0200 Subject: [PATCH] generalise CacheEntry type contributes to #24 --- app/Main.hs | 2 +- src/Hash2Pub/FediChord.hs | 14 +++++++------- src/Hash2Pub/FediChordTypes.hs | 24 +++++++++++++----------- src/Hash2Pub/ProtocolTypes.hs | 4 ++-- 4 files changed, 23 insertions(+), 21 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index cdfc2b3..85db925 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 - cacheWriterThread <- forkIO $ cacheWriter thisNode + nodeCacheWriterThread <- forkIO $ nodeCacheWriter 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 479a3af..6f1be65 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -47,7 +47,7 @@ module Hash2Pub.FediChord ( , mkServerSocket , mkSendSocket , resolve - , cacheWriter + , nodeCacheWriter , joinOnNewEntriesThread ) where @@ -283,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. -cacheWriter :: LocalNodeStateSTM -> IO () -cacheWriter nsSTM = +nodeCacheWriter :: LocalNodeStateSTM -> IO () +nodeCacheWriter nsSTM = forever $ atomically $ do ns <- readTVar nsSTM cacheModifier <- readTQueue $ cacheWriteQueue ns @@ -297,8 +297,8 @@ maxEntryAge = 600 -- | Periodically iterate through cache, clean up expired entries and verify unverified ones -cacheVerifyThread :: LocalNodeStateSTM -> IO () -cacheVerifyThread nsSTM = forever $ do +nodeCacheVerifyThread :: LocalNodeStateSTM -> IO () +nodeCacheVerifyThread nsSTM = forever $ do putStrLn "cache verify run: begin" -- get cache (ns, cache) <- atomically $ do @@ -308,7 +308,7 @@ cacheVerifyThread nsSTM = forever $ do -- iterate entries: -- for avoiding too many time syscalls, get current time before iterating. now <- getPOSIXTime - forM_ (cacheEntries cache) (\(CacheEntry validated node ts) -> + forM_ (nodeCacheEntries cache) (\(CacheEntry validated node ts) -> -- case too old: delete (future work: decide whether pinging and resetting timestamp is better) if (now - ts) > maxEntryAge then @@ -541,7 +541,7 @@ fediMainThreads sock nsSTM = do concurrently_ (fediMessageHandler sendQ recvQ nsSTM) $ concurrently_ (stabiliseThread nsSTM) $ - concurrently_ (cacheVerifyThread nsSTM) $ + concurrently_ (nodeCacheVerifyThread nsSTM) $ concurrently_ (convergenceSampleThread nsSTM) $ concurrently_ (sendThread sock sendQ) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index 296ebfa..b5df0d4 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -18,6 +18,7 @@ module Hash2Pub.FediChordTypes ( , setSuccessors , setPredecessors , NodeCache + , NodeCacheEntry , CacheEntry(..) , RingEntry(..) , RingMap(..) @@ -39,7 +40,7 @@ module Hash2Pub.FediChordTypes ( , rMapToList , cacheGetNodeStateUnvalidated , initCache - , cacheEntries + , nodeCacheEntries , cacheLookup , cacheLookupSucc , cacheLookupPred @@ -284,13 +285,14 @@ class (Eq a, Show a) => HasKeyID a where instance HasKeyID RemoteNodeState where getKeyID = getNid -instance HasKeyID CacheEntry where - getKeyID (CacheEntry _ ns _) = getNid ns +instance HasKeyID a => HasKeyID (CacheEntry a) where + getKeyID (CacheEntry _ obj _) = getKeyID obj instance HasKeyID NodeID where getKeyID = id -type NodeCache = RingMap CacheEntry +type NodeCacheEntry = CacheEntry RemoteNodeState +type NodeCache = RingMap NodeCacheEntry -- | generic data structure for holding elements with a key and modular lookup newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } @@ -308,7 +310,7 @@ data RingEntry a = KeyEntry a deriving (Show, Eq) -- | 'RingEntry' type for usage as a node cache -data CacheEntry = CacheEntry Bool RemoteNodeState POSIXTime +data CacheEntry a = CacheEntry Bool a POSIXTime deriving (Show, Eq) @@ -338,8 +340,8 @@ extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry extractRingEntry _ = Nothing --- useful function for getting entries for a full cache transfer -cacheEntries :: NodeCache -> [CacheEntry] -cacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap +nodeCacheEntries :: NodeCache -> [NodeCacheEntry] +nodeCacheEntries = 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@ @@ -360,7 +362,7 @@ rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) cacheLookup :: NodeID -- ^lookup key -> NodeCache -- ^lookup cache - -> Maybe CacheEntry + -> Maybe NodeCacheEntry cacheLookup = rMapLookup -- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' @@ -419,7 +421,7 @@ rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards cacheLookupSucc :: NodeID -- ^lookup key -> NodeCache -- ^ring cache - -> Maybe CacheEntry + -> Maybe NodeCacheEntry cacheLookupSucc = rMapLookupSucc -- | find the predecessor node to a given key on a modular EpiChord ring. @@ -431,7 +433,7 @@ rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards cacheLookupPred :: NodeID -- ^lookup key -> NodeCache -- ^ring cache - -> Maybe CacheEntry + -> Maybe NodeCacheEntry cacheLookupPred = rMapLookupPred addRMapEntryWith :: HasKeyID a @@ -522,7 +524,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 +cacheGetNodeStateUnvalidated :: CacheEntry RemoteNodeState -> 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 15cb863..37c00e9 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 :: CacheEntry -> RemoteCacheEntry +toRemoteCacheEntry :: NodeCacheEntry -> 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 <$> cacheEntries cache +toRemoteCache cache = toRemoteCacheEntry <$> nodeCacheEntries cache -- | extract the 'NodeState' from a 'RemoteCacheEntry' remoteNode :: RemoteCacheEntry -> RemoteNodeState