adjust rest of code to refactored RingMap

src/Hash2Pub/DHTProtocol.hs

@@ -130,23 +130,25 @@ closestCachePredecessors remainingLookups lastID nCache
 -- Looks up the successor of the lookup key on a 'RingMap' representation of the
 -- predecessor list with the node itself added. If the result is the same as the node
 -- itself then it falls into the responsibility interval.
-isInOwnResponsibilitySlice :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
+isInOwnResponsibilitySlice :: HasKeyID NodeID a => a -> LocalNodeState -> Bool
-isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget :: NodeID) predecessorRMap) == pure (getNid ownNs)
+isInOwnResponsibilitySlice lookupTarget ownNs = (fst <$> rMapLookupSucc (getKeyID lookupTarget :: NodeID) predecessorRMap) == pure (getNid ownNs)
   where
     predecessorList = predecessors ownNs
     -- add node itself to RingMap representation, to distinguish between
     -- responsibility of own node and predecessor
-    predecessorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList predecessorList
+    predecessorRMap = addRMapEntry (getKeyID ownRemote) ownRemote $ rMapFromList (keyValuePair <$> predecessorList) :: RingMap NodeID RemoteNodeState
+    ownRemote = toRemoteNodeState ownNs
     closestPredecessor = headMay predecessorList
 
-isPossiblePredecessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
+isPossiblePredecessor :: HasKeyID NodeID a => a -> LocalNodeState -> Bool
 isPossiblePredecessor = isInOwnResponsibilitySlice
 
-isPossibleSuccessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
+isPossibleSuccessor :: HasKeyID NodeID a => a -> LocalNodeState -> Bool
-isPossibleSuccessor lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget :: NodeID) successorRMap) == pure (getNid ownNs)
+isPossibleSuccessor lookupTarget ownNs = (fst <$> rMapLookupPred (getKeyID lookupTarget :: NodeID) successorRMap) == pure (getNid ownNs)
   where
     successorList = successors ownNs
-    successorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList successorList
+    successorRMap = addRMapEntry (getKeyID ownRemote) ownRemote $ rMapFromList (keyValuePair <$> successorList)
+    ownRemote = toRemoteNodeState ownNs
     closestSuccessor = headMay successorList
 
 -- cache operations
@@ -169,7 +171,8 @@ 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 = addRMapEntryWith insertCombineFunction (CacheEntry False ns timestamp') cache
+        newEntry = CacheEntry False ns timestamp'
+        newCache = addRMapEntryWith insertCombineFunction (getKeyID newEntry) newEntry cache
         insertCombineFunction newVal@(KeyEntry (CacheEntry newValidationState newNode newTimestamp)) oldVal =
             case oldVal of
               ProxyEntry n _ -> ProxyEntry n (Just newVal)
@@ -202,7 +205,7 @@ addNodeAsVerifiedPure :: POSIXTime
                       -> RemoteNodeState
                       -> NodeCache
                       -> NodeCache
-addNodeAsVerifiedPure now node = addRMapEntry (CacheEntry True node now)
+addNodeAsVerifiedPure now node = addRMapEntry (getKeyID node) (CacheEntry True node now)
 
 
 

src/Hash2Pub/FediChordTypes.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
@@ -26,8 +27,7 @@ module Hash2Pub.FediChordTypes (
   , CacheEntry(..)
   , RingEntry(..)
   , RingMap(..)
-  , HasKeyID
+  , HasKeyID(..)
-  , getKeyID
   , rMapSize
   , rMapLookup
   , rMapLookupPred
@@ -271,31 +271,31 @@ instance Typeable a => Show (TQueue a) where
 
 -- | convenience function that replaces the predecessors of a 'LocalNodeState' with the k closest nodes from the provided list
 setPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList . filter ((/=) (getNid ns) . getNid) $ preds}
+setPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . rMapFromList . fmap keyValuePair . filter ((/=) (getNid ns) . getNid) $ preds}
 
 -- | convenience function that replaces the successors of a 'LocalNodeState' with the k closest nodes from the provided list
 setSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList . filter ((/=) (getNid ns) . getNid) $ succs}
+setSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . rMapFromList . fmap keyValuePair . filter ((/=) (getNid ns) . getNid) $ succs}
 
 -- | sets the predecessors of a 'LocalNodeState' to the closest k nodes of the current predecessors and the provided list, combined
 addPredecessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . addRMapEntries (filter ((/=) (getNid ns) . getNid) preds) . rMapFromList  $ predecessors ns}
+addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (kNeighbours ns) . addRMapEntries (keyValuePair <$> filter ((/=) (getNid ns) . getNid) preds) . rMapFromList . fmap keyValuePair  $ predecessors ns}
 
 -- | sets the successors of a 'LocalNodeState' to the closest k nodes of the current successors and the provided list, combined
 addSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
-addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries (filter ((/=) (getNid ns) . getNid) succs) . rMapFromList  $ successors ns}
+addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries (keyValuePair <$> filter ((/=) (getNid ns) . getNid) succs) . rMapFromList . fmap keyValuePair $ successors ns}
 
-instance HasKeyID RemoteNodeState NodeID where
+instance HasKeyID NodeID RemoteNodeState where
     getKeyID = getNid
 
-instance HasKeyID a k => HasKeyID (CacheEntry a) k where
+instance HasKeyID k a => HasKeyID k (CacheEntry a) where
     getKeyID (CacheEntry _ obj _) = getKeyID obj
 
 instance HasKeyID NodeID NodeID where
     getKeyID = id
 
 type NodeCacheEntry = CacheEntry RemoteNodeState
-type NodeCache = RingMap NodeCacheEntry NodeID
+type NodeCache = RingMap NodeID NodeCacheEntry
 
 type LookupCacheEntry = CacheEntry (String, PortNumber)
 type LookupCache = Map.Map NodeID LookupCacheEntry
@@ -319,12 +319,15 @@ cacheLookup = rMapLookup
 cacheLookupSucc :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe NodeCacheEntry
-cacheLookupSucc = rMapLookupSucc
+cacheLookupSucc key cache = snd <$> rMapLookupSucc key cache
 
 cacheLookupPred :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe NodeCacheEntry
-cacheLookupPred = rMapLookupPred
+cacheLookupPred key cache = snd <$> rMapLookupPred key cache
+
+-- 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 -> RemoteNodeState

src/Hash2Pub/PostService.hs

@@ -1,15 +1,16 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE InstanceSigs          #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE InstanceSigs          #-}
 
 module Hash2Pub.PostService where
 
 import           Control.Concurrent
 import qualified Data.ByteString.Lazy.UTF8 as BSU
+import qualified Data.HashMap.Strict       as HMap
 import           Data.Maybe                (fromMaybe)
 import           Data.String               (fromString)
 import qualified Data.Text                 as Txt
@@ -18,6 +19,7 @@ import qualified Network.Wai.Handler.Warp  as Warp
 import           Servant
 
 import           Hash2Pub.FediChord
+import           Hash2Pub.RingMap
 import           Hash2Pub.ServiceTypes
 
 

src/Hash2Pub/RingMap.hs

@@ -5,13 +5,15 @@ module Hash2Pub.RingMap where
 
 import           Data.Foldable   (foldr')
 import qualified Data.Map.Strict as Map
-import           Data.Maybe      (fromJust, isJust, isNothing, mapMaybe)
+import           Data.Maybe      (isJust, isNothing, mapMaybe)
 
 
 -- | Class for all types that can be identified via a EpiChord key.
 -- Used for restricting the types a 'RingMap' can store
 class (Eq a, Show a, Bounded k, Ord k) => HasKeyID k a where
     getKeyID :: a -> k
+    keyValuePair :: a -> (k, a)
+    keyValuePair val = (getKeyID val, val)
 
 
 -- | generic data structure for holding elements with a key and modular lookup