diff --git a/Hash2Pub/Hash2Pub.cabal b/Hash2Pub/Hash2Pub.cabal index ad4f60d..8eb7dd8 100644 --- a/Hash2Pub/Hash2Pub.cabal +++ b/Hash2Pub/Hash2Pub.cabal @@ -56,6 +56,7 @@ library -- Modules exported by the library. exposed-modules: Hash2Pub.FediChord, Hash2Pub.DHTProtocol + --, Hash2Pub.ASN1Coding -- Modules included in this library but not exported. other-modules: Hash2Pub.Utils diff --git a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs index d2cb74f..3d226f1 100644 --- a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs +++ b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs @@ -6,12 +6,18 @@ module Hash2Pub.DHTProtocol ) where -import Data.Maybe (maybe) +import Data.Maybe (maybe, fromMaybe) import qualified Data.Set as Set import Hash2Pub.FediChord ( NodeID , NodeState (..) + , getNodeCache + , putNodeCache + , getSuccessors + , putSuccessors + , getPredecessors + , putPredecessors , cacheGetNodeStateUnvalidated , NodeCache , CacheEntry @@ -37,12 +43,12 @@ data QueryResponse = FORWARD (Set.Set CacheEntry) -- ^return closest nodes from incomingQuery :: NodeState -> NodeCache -> Int -> NodeID -> QueryResponse incomingQuery ownState nCache lBestNodes targetID -- as target ID falls between own ID and first predecessor, it is handled by this node - | (targetID `localCompare` ownID) `elem` [LT, EQ] && not (null . predecessors $ ownState) && (targetID `localCompare` (head . predecessors) ownState) == GT = FOUND ownState + | (targetID `localCompare` ownID) `elem` [LT, EQ] && not (null preds) && (targetID `localCompare` head preds == GT) = FOUND ownState -- my interpretation: the "l best next hops" are the l-1 closest preceding nodes and -- the closest succeeding node (like with the p initiated parallel queries - | otherwise = trace ("--- Query for " ++ show targetID ++ " wanting " ++ show lBestNodes ++ " results---") $ - FORWARD $ closestSuccessor `Set.union` closestPredecessors + | otherwise = FORWARD $ closestSuccessor `Set.union` closestPredecessors where + preds = fromMaybe [] $ getPredecessors ownState ownID = nid ownState closestSuccessor :: Set.Set CacheEntry diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index f449816..b04b5bb 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/Hash2Pub/src/Hash2Pub/FediChord.hs @@ -14,6 +14,13 @@ module Hash2Pub.FediChord ( , getNodeID , toNodeID , NodeState (..) + , InternalNodeState (..) + , getNodeCache + , putNodeCache + , getSuccessors + , putSuccessors + , getPredecessors + , putPredecessors , NodeCache , CacheEntry(..) , cacheGetNodeStateUnvalidated @@ -35,7 +42,7 @@ import qualified Data.Map.Strict as Map import Network.Socket import Data.Time.Clock import Control.Exception -import Data.Maybe (isJust) +import Data.Maybe (isJust, fromMaybe) -- for hashing and ID conversion import Crypto.Hash @@ -111,9 +118,19 @@ data NodeState = NodeState { , apPort :: Maybe PortNumber -- ^ port of the ActivityPub relay and storage service -- might have to be queried first + , vServerID :: Integer + -- ^ ID of this vserver -- ==== internal state ==== - , nodeCache :: NodeCache + , internals :: Maybe InternalNodeState + -- ^ data not present in the representation of remote nodes + -- is put into its own type. + -- This is usually @Nothing@ for all remote nodes. + } deriving (Show, Eq) + +-- | encapsulates all data and parameters that are not present for remote nodes +data InternalNodeState = InternalNodeState { + nodeCache :: NodeCache -- ^ EpiChord node cache with expiry times for nodes -- as the map is ordered, lookups for the closes preceding node can be done using @lookupLT@ , successors :: [NodeID] -- could be a set instead as these are ordered as well @@ -134,7 +151,45 @@ data NodeState = NodeState { , jEntriesPerSlice :: Int -- ^ number of desired entries per cache slice -- needs to be parameterisable for simulation purposes - } deriving (Show, Eq) + } deriving (Show, Eq) +-- +-- | extract a value from the internals of a 'NodeState' +getInternals_ :: (InternalNodeState -> a) -> NodeState -> Maybe a +getInternals_ func ns = func <$> internals ns + +-- could be done better with lenses +-- | convenience function that updates an internal value of a NodeState +putInternals_ :: (InternalNodeState -> InternalNodeState) -> NodeState -> NodeState +putInternals_ func ns = let + newInternals = func <$> internals ns + in + ns {internals = newInternals } + +-- | convenience function for extracting the 'NodeCache' from a 'NodeState' +getNodeCache :: NodeState -> Maybe NodeCache +getNodeCache = getInternals_ nodeCache + +-- | convenience function for updating the 'NodeCache' on 'NodeState' s that have +-- internals. +-- NodeStates without a cache (without internals) are returned unchanged +putNodeCache :: NodeCache -> NodeState -> NodeState +putNodeCache nc = putInternals_ (\i -> i {nodeCache = nc}) + +-- | convenience function for extracting the @successors@ from a 'NodeState' +getSuccessors :: NodeState -> Maybe [NodeID] +getSuccessors = getInternals_ successors + +-- | convenience function that updates the successors of a NodeState +putSuccessors :: [NodeID] -> NodeState -> NodeState +putSuccessors succ = putInternals_ (\i -> i {successors = succ}) + +-- | convenience function for extracting the @predecessors@ from a 'NodeState' +getPredecessors :: NodeState -> Maybe [NodeID] +getPredecessors = getInternals_ predecessors + +-- | convenience function that updates the predecessors of a NodeState +putPredecessors :: [NodeID] -> NodeState -> NodeState +putPredecessors pred = putInternals_ (\i -> i {predecessors = pred}) type NodeCache = Map.Map NodeID CacheEntry @@ -150,6 +205,7 @@ data CacheEntry = -- | as a compromise, only NodeEntry components are ordered by their NodeID -- while ProxyEntry components should never be tried to be ordered. instance Ord CacheEntry where + a `compare` b = compare (extractID a) (extractID b) where extractID (NodeEntry _ eState _) = nid eState @@ -310,13 +366,14 @@ byteStringToUInteger bs = sum $ parsedBytes 0 bs -- of having j entries per slice, and creates a list of necessary lookup actions. -- Should be invoked periodically. checkCacheSlices :: NodeState -> [IO ()] -checkCacheSlices state = - checkSlice jEntries (nid state) startBound lastSucc cache' +checkCacheSlices state = case getNodeCache state of + -- don't do anything on nodes without a cache + Nothing -> [return ()] + Just cache' -> checkSlice jEntries (nid state) startBound lastSucc cache' -- TODO: do the same for predecessors where - jEntries = jEntriesPerSlice state - cache' = nodeCache state - lastSucc = last <$> maybeEmpty (successors state) + jEntries = fromMaybe 0 $ getInternals_ jEntriesPerSlice state + lastSucc = last <$> maybeEmpty (fromMaybe [] $ getSuccessors state) startBound = NodeID 2^(255::Integer) + nid state checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()] checkSlice _ _ _ Nothing _ = [] diff --git a/Hash2Pub/test/FediChordSpec.hs b/Hash2Pub/test/FediChordSpec.hs index 49ac188..2907285 100644 --- a/Hash2Pub/test/FediChordSpec.hs +++ b/Hash2Pub/test/FediChordSpec.hs @@ -4,6 +4,7 @@ module FediChordSpec where import Test.Hspec import Control.Exception import Network.Socket +import Data.Maybe (fromJust) import qualified Data.Map.Strict as Map import qualified Data.ByteString as BS import qualified Data.Set as Set @@ -56,26 +57,22 @@ spec = do , ipAddr = exampleIp , dhtPort = 2342 , apPort = Nothing - , nodeCache = initCache - , successors = [] - , predecessors = [] - , kNeighbours = 3 - , lNumBestNodes = 3 - , pNumParallelQueries = 2 - , jEntriesPerSlice = 2 + , vServerID = undefined + , internals = Nothing } nsReady = ns { nid = genNodeID (ipAddr ns) (domain ns) 3 + , vServerID = 1 } print nsReady describe "NodeCache" $ do let - emptyCache = nodeCache exampleNodeState - exampleID = nid exampleNodeState + emptyCache = fromJust $ getNodeCache exampleLocalNode + exampleID = nid exampleLocalNode anotherID = toNodeID 2^(230::Integer)+1 anotherNode = exampleNodeState { nid = anotherID} maxNode = exampleNodeState { nid = maxBound} - newCache = addCacheEntry exampleNodeState 0 =<< addCacheEntry anotherNode 10 emptyCache + newCache = addCacheEntry exampleLocalNode 0 =<< addCacheEntry anotherNode 10 emptyCache it "entries can be added to a node cache and looked up again" $ do nC <- newCache -- the cache includes 2 additional proxy elements right from the start @@ -95,7 +92,7 @@ spec = do nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID emptyCache `shouldBe` Nothing nC <- newCache - -- given situation: 0 < nid exampleNodeState < anotherNode < maxBound + -- given situation: 0 < nid exampleLocalNode < anotherNode < maxBound -- first try non-modular queries between the 2 stored nodes nid. cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) nC `shouldBe` Just exampleID nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID nC `shouldBe` Just exampleID @@ -116,9 +113,9 @@ spec = do describe "NodeCache query lookup" $ do let - emptyCache = nodeCache exampleNodeState + emptyCache = fromJust $ getNodeCache exampleLocalNode nid1 = toNodeID 2^(23::Integer)+1 - node1 = exampleNodeState { nid = nid1, predecessors = [nid4]} + node1 = putPredecessors [nid4] $ exampleLocalNode { nid = nid1} nid2 = toNodeID 2^(230::Integer)+12 node2 = exampleNodeState { nid = nid2} nid3 = toNodeID 2^(25::Integer)+10 @@ -128,17 +125,17 @@ spec = do cacheWith2Entries = addCacheEntry node1 120 =<< addCacheEntry node2 0 emptyCache cacheWith4Entries = addCacheEntry node3 110 =<< addCacheEntry node4 0 =<< cacheWith2Entries it "works on an empty cache" $ do - incomingQuery exampleNodeState emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty - incomingQuery exampleNodeState emptyCache 1 (toNodeID 2342) `shouldBe` FORWARD Set.empty + incomingQuery exampleLocalNode emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty + incomingQuery exampleLocalNode emptyCache 1 (toNodeID 2342) `shouldBe` FORWARD Set.empty it "works on a cache with less entries than needed" $ do c2 <- cacheWith2Entries - let (FORWARD nodeset) = incomingQuery exampleNodeState c2 4 (toNodeID 2^(9::Integer)+5) + let (FORWARD nodeset) = incomingQuery exampleLocalNode c2 4 (toNodeID 2^(9::Integer)+5) Set.map (nid . cacheGetNodeStateUnvalidated) nodeset `shouldBe` Set.fromList [ nid1, nid2 ] it "works on a cache with sufficient entries" $ do c4 <- cacheWith4Entries let - (FORWARD nodeset1) = incomingQuery exampleNodeState c4 3 (toNodeID 2^(9::Integer)+5) - (FORWARD nodeset2) = incomingQuery exampleNodeState c4 1 (toNodeID 2^(9::Integer)+5) + (FORWARD nodeset1) = incomingQuery exampleLocalNode c4 3 (toNodeID 2^(9::Integer)+5) + (FORWARD nodeset2) = incomingQuery exampleLocalNode c4 1 (toNodeID 2^(9::Integer)+5) Set.map (nid . cacheGetNodeStateUnvalidated) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3] Set.map (nid . cacheGetNodeStateUnvalidated) nodeset2 `shouldBe` Set.fromList [nid4] it "recognises the node's own responsibility" $ do @@ -147,7 +144,7 @@ spec = do incomingQuery node1 nC 3 nid1 `shouldBe` FOUND node1 it "does not fail on nodes without neighbours (initial state)" $ do nC <- cacheWith4Entries - let (FORWARD nodeset) = incomingQuery exampleNodeState nC 3 (toNodeID 11) + let (FORWARD nodeset) = incomingQuery exampleLocalNode nC 3 (toNodeID 11) Set.map (nid . cacheGetNodeStateUnvalidated ) nodeset `shouldBe` Set.fromList [nid4, nid2, nid3] @@ -160,14 +157,22 @@ exampleNodeState = NodeState { , ipAddr = exampleIp , dhtPort = 2342 , apPort = Nothing - , nodeCache = initCache + , vServerID = 0 + , internals = Nothing + } + +exampleInternals :: InternalNodeState +exampleInternals = InternalNodeState { + nodeCache = initCache , successors = [] , predecessors = [] , kNeighbours = 3 , lNumBestNodes = 3 , pNumParallelQueries = 2 , jEntriesPerSlice = 2 - } + } + +exampleLocalNode = exampleNodeState {internals = Just exampleInternals} exampleNodeDomain :: String exampleNodeDomain = "example.social"