forked from schmittlauch/Hash2Pub
WIP: implement adding, setting and taking RingMap entries.
contributes to #48
This commit is contained in:
parent
22a6becf6b
commit
6142ee61d7
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
mapMaybe)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust,
|
||||
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.
|
||||
-- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here.
|
||||
instance Eq (RingMap a) where
|
||||
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
|
||||
initRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
|
||||
emptyRMap :: HasKeyID a => RingMap a
|
||||
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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue