diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index d69d94c..546c10f 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/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 lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget :: NodeID) predecessorRMap) == pure (getNid ownNs) +isInOwnResponsibilitySlice :: HasKeyID NodeID a => a -> LocalNodeState -> Bool +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 lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget :: NodeID) successorRMap) == pure (getNid ownNs) +isPossibleSuccessor :: HasKeyID NodeID a => a -> LocalNodeState -> Bool +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) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index 7652f4f..6e0bef6 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/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 - , getKeyID + , HasKeyID(..) , 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 diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index e8b325b..21a7238 100644 --- a/src/Hash2Pub/PostService.hs +++ b/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 diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs index 9c7f63b..016f9f1 100644 --- a/src/Hash2Pub/RingMap.hs +++ b/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