extract internal node parameters to own arithmetic type
This commit is contained in:
parent
24936d48c1
commit
db229975b0
|
@ -56,6 +56,7 @@ library
|
||||||
|
|
||||||
-- Modules exported by the library.
|
-- Modules exported by the library.
|
||||||
exposed-modules: Hash2Pub.FediChord, Hash2Pub.DHTProtocol
|
exposed-modules: Hash2Pub.FediChord, Hash2Pub.DHTProtocol
|
||||||
|
--, Hash2Pub.ASN1Coding
|
||||||
|
|
||||||
-- Modules included in this library but not exported.
|
-- Modules included in this library but not exported.
|
||||||
other-modules: Hash2Pub.Utils
|
other-modules: Hash2Pub.Utils
|
||||||
|
|
|
@ -6,12 +6,18 @@ module Hash2Pub.DHTProtocol
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Maybe (maybe)
|
import Data.Maybe (maybe, fromMaybe)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
import Hash2Pub.FediChord
|
import Hash2Pub.FediChord
|
||||||
( NodeID
|
( NodeID
|
||||||
, NodeState (..)
|
, NodeState (..)
|
||||||
|
, getNodeCache
|
||||||
|
, putNodeCache
|
||||||
|
, getSuccessors
|
||||||
|
, putSuccessors
|
||||||
|
, getPredecessors
|
||||||
|
, putPredecessors
|
||||||
, cacheGetNodeStateUnvalidated
|
, cacheGetNodeStateUnvalidated
|
||||||
, NodeCache
|
, NodeCache
|
||||||
, CacheEntry
|
, CacheEntry
|
||||||
|
@ -37,12 +43,12 @@ data QueryResponse = FORWARD (Set.Set CacheEntry) -- ^return closest nodes from
|
||||||
incomingQuery :: NodeState -> NodeCache -> Int -> NodeID -> QueryResponse
|
incomingQuery :: NodeState -> NodeCache -> Int -> NodeID -> QueryResponse
|
||||||
incomingQuery ownState nCache lBestNodes targetID
|
incomingQuery ownState nCache lBestNodes targetID
|
||||||
-- as target ID falls between own ID and first predecessor, it is handled by this node
|
-- 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
|
-- 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
|
-- the closest succeeding node (like with the p initiated parallel queries
|
||||||
| otherwise = trace ("--- Query for " ++ show targetID ++ " wanting " ++ show lBestNodes ++ " results---") $
|
| otherwise = FORWARD $ closestSuccessor `Set.union` closestPredecessors
|
||||||
FORWARD $ closestSuccessor `Set.union` closestPredecessors
|
|
||||||
where
|
where
|
||||||
|
preds = fromMaybe [] $ getPredecessors ownState
|
||||||
ownID = nid ownState
|
ownID = nid ownState
|
||||||
|
|
||||||
closestSuccessor :: Set.Set CacheEntry
|
closestSuccessor :: Set.Set CacheEntry
|
||||||
|
|
|
@ -14,6 +14,13 @@ module Hash2Pub.FediChord (
|
||||||
, getNodeID
|
, getNodeID
|
||||||
, toNodeID
|
, toNodeID
|
||||||
, NodeState (..)
|
, NodeState (..)
|
||||||
|
, InternalNodeState (..)
|
||||||
|
, getNodeCache
|
||||||
|
, putNodeCache
|
||||||
|
, getSuccessors
|
||||||
|
, putSuccessors
|
||||||
|
, getPredecessors
|
||||||
|
, putPredecessors
|
||||||
, NodeCache
|
, NodeCache
|
||||||
, CacheEntry(..)
|
, CacheEntry(..)
|
||||||
, cacheGetNodeStateUnvalidated
|
, cacheGetNodeStateUnvalidated
|
||||||
|
@ -35,7 +42,7 @@ import qualified Data.Map.Strict as Map
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust, fromMaybe)
|
||||||
|
|
||||||
-- for hashing and ID conversion
|
-- for hashing and ID conversion
|
||||||
import Crypto.Hash
|
import Crypto.Hash
|
||||||
|
@ -111,9 +118,19 @@ data NodeState = NodeState {
|
||||||
, apPort :: Maybe PortNumber
|
, apPort :: Maybe PortNumber
|
||||||
-- ^ port of the ActivityPub relay and storage service
|
-- ^ port of the ActivityPub relay and storage service
|
||||||
-- might have to be queried first
|
-- might have to be queried first
|
||||||
|
, vServerID :: Integer
|
||||||
|
-- ^ ID of this vserver
|
||||||
|
|
||||||
-- ==== internal state ====
|
-- ==== 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
|
-- ^ EpiChord node cache with expiry times for nodes
|
||||||
-- as the map is ordered, lookups for the closes preceding node can be done using @lookupLT@
|
-- 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
|
, successors :: [NodeID] -- could be a set instead as these are ordered as well
|
||||||
|
@ -134,7 +151,45 @@ data NodeState = NodeState {
|
||||||
, jEntriesPerSlice :: Int
|
, jEntriesPerSlice :: Int
|
||||||
-- ^ number of desired entries per cache slice
|
-- ^ number of desired entries per cache slice
|
||||||
-- needs to be parameterisable for simulation purposes
|
-- 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
|
type NodeCache = Map.Map NodeID CacheEntry
|
||||||
|
|
||||||
|
@ -150,6 +205,7 @@ data CacheEntry =
|
||||||
-- | as a compromise, only NodeEntry components are ordered by their NodeID
|
-- | as a compromise, only NodeEntry components are ordered by their NodeID
|
||||||
-- while ProxyEntry components should never be tried to be ordered.
|
-- while ProxyEntry components should never be tried to be ordered.
|
||||||
instance Ord CacheEntry where
|
instance Ord CacheEntry where
|
||||||
|
|
||||||
a `compare` b = compare (extractID a) (extractID b)
|
a `compare` b = compare (extractID a) (extractID b)
|
||||||
where
|
where
|
||||||
extractID (NodeEntry _ eState _) = nid eState
|
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.
|
-- of having j entries per slice, and creates a list of necessary lookup actions.
|
||||||
-- Should be invoked periodically.
|
-- Should be invoked periodically.
|
||||||
checkCacheSlices :: NodeState -> [IO ()]
|
checkCacheSlices :: NodeState -> [IO ()]
|
||||||
checkCacheSlices state =
|
checkCacheSlices state = case getNodeCache state of
|
||||||
checkSlice jEntries (nid state) startBound lastSucc cache'
|
-- 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
|
-- TODO: do the same for predecessors
|
||||||
where
|
where
|
||||||
jEntries = jEntriesPerSlice state
|
jEntries = fromMaybe 0 $ getInternals_ jEntriesPerSlice state
|
||||||
cache' = nodeCache state
|
lastSucc = last <$> maybeEmpty (fromMaybe [] $ getSuccessors state)
|
||||||
lastSucc = last <$> maybeEmpty (successors state)
|
|
||||||
startBound = NodeID 2^(255::Integer) + nid state
|
startBound = NodeID 2^(255::Integer) + nid state
|
||||||
checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()]
|
checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()]
|
||||||
checkSlice _ _ _ Nothing _ = []
|
checkSlice _ _ _ Nothing _ = []
|
||||||
|
|
|
@ -4,6 +4,7 @@ module FediChordSpec where
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
@ -56,26 +57,22 @@ spec = do
|
||||||
, ipAddr = exampleIp
|
, ipAddr = exampleIp
|
||||||
, dhtPort = 2342
|
, dhtPort = 2342
|
||||||
, apPort = Nothing
|
, apPort = Nothing
|
||||||
, nodeCache = initCache
|
, vServerID = undefined
|
||||||
, successors = []
|
, internals = Nothing
|
||||||
, predecessors = []
|
|
||||||
, kNeighbours = 3
|
|
||||||
, lNumBestNodes = 3
|
|
||||||
, pNumParallelQueries = 2
|
|
||||||
, jEntriesPerSlice = 2
|
|
||||||
}
|
}
|
||||||
nsReady = ns {
|
nsReady = ns {
|
||||||
nid = genNodeID (ipAddr ns) (domain ns) 3
|
nid = genNodeID (ipAddr ns) (domain ns) 3
|
||||||
|
, vServerID = 1
|
||||||
}
|
}
|
||||||
print nsReady
|
print nsReady
|
||||||
describe "NodeCache" $ do
|
describe "NodeCache" $ do
|
||||||
let
|
let
|
||||||
emptyCache = nodeCache exampleNodeState
|
emptyCache = fromJust $ getNodeCache exampleLocalNode
|
||||||
exampleID = nid exampleNodeState
|
exampleID = nid exampleLocalNode
|
||||||
anotherID = toNodeID 2^(230::Integer)+1
|
anotherID = toNodeID 2^(230::Integer)+1
|
||||||
anotherNode = exampleNodeState { nid = anotherID}
|
anotherNode = exampleNodeState { nid = anotherID}
|
||||||
maxNode = exampleNodeState { nid = maxBound}
|
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
|
it "entries can be added to a node cache and looked up again" $ do
|
||||||
nC <- newCache
|
nC <- newCache
|
||||||
-- the cache includes 2 additional proxy elements right from the start
|
-- the cache includes 2 additional proxy elements right from the start
|
||||||
|
@ -95,7 +92,7 @@ spec = do
|
||||||
nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID emptyCache `shouldBe` Nothing
|
nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID emptyCache `shouldBe` Nothing
|
||||||
|
|
||||||
nC <- newCache
|
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
|
-- first try non-modular queries between the 2 stored nodes
|
||||||
nid. cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) nC `shouldBe` Just exampleID
|
nid. cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) nC `shouldBe` Just exampleID
|
||||||
nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID nC `shouldBe` Just exampleID
|
nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID nC `shouldBe` Just exampleID
|
||||||
|
@ -116,9 +113,9 @@ spec = do
|
||||||
|
|
||||||
describe "NodeCache query lookup" $ do
|
describe "NodeCache query lookup" $ do
|
||||||
let
|
let
|
||||||
emptyCache = nodeCache exampleNodeState
|
emptyCache = fromJust $ getNodeCache exampleLocalNode
|
||||||
nid1 = toNodeID 2^(23::Integer)+1
|
nid1 = toNodeID 2^(23::Integer)+1
|
||||||
node1 = exampleNodeState { nid = nid1, predecessors = [nid4]}
|
node1 = putPredecessors [nid4] $ exampleLocalNode { nid = nid1}
|
||||||
nid2 = toNodeID 2^(230::Integer)+12
|
nid2 = toNodeID 2^(230::Integer)+12
|
||||||
node2 = exampleNodeState { nid = nid2}
|
node2 = exampleNodeState { nid = nid2}
|
||||||
nid3 = toNodeID 2^(25::Integer)+10
|
nid3 = toNodeID 2^(25::Integer)+10
|
||||||
|
@ -128,17 +125,17 @@ spec = do
|
||||||
cacheWith2Entries = addCacheEntry node1 120 =<< addCacheEntry node2 0 emptyCache
|
cacheWith2Entries = addCacheEntry node1 120 =<< addCacheEntry node2 0 emptyCache
|
||||||
cacheWith4Entries = addCacheEntry node3 110 =<< addCacheEntry node4 0 =<< cacheWith2Entries
|
cacheWith4Entries = addCacheEntry node3 110 =<< addCacheEntry node4 0 =<< cacheWith2Entries
|
||||||
it "works on an empty cache" $ do
|
it "works on an empty cache" $ do
|
||||||
incomingQuery exampleNodeState emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty
|
incomingQuery exampleLocalNode emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty
|
||||||
incomingQuery exampleNodeState emptyCache 1 (toNodeID 2342) `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
|
it "works on a cache with less entries than needed" $ do
|
||||||
c2 <- cacheWith2Entries
|
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 ]
|
Set.map (nid . cacheGetNodeStateUnvalidated) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
|
||||||
it "works on a cache with sufficient entries" $ do
|
it "works on a cache with sufficient entries" $ do
|
||||||
c4 <- cacheWith4Entries
|
c4 <- cacheWith4Entries
|
||||||
let
|
let
|
||||||
(FORWARD nodeset1) = incomingQuery exampleNodeState c4 3 (toNodeID 2^(9::Integer)+5)
|
(FORWARD nodeset1) = incomingQuery exampleLocalNode c4 3 (toNodeID 2^(9::Integer)+5)
|
||||||
(FORWARD nodeset2) = incomingQuery exampleNodeState c4 1 (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) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3]
|
||||||
Set.map (nid . cacheGetNodeStateUnvalidated) nodeset2 `shouldBe` Set.fromList [nid4]
|
Set.map (nid . cacheGetNodeStateUnvalidated) nodeset2 `shouldBe` Set.fromList [nid4]
|
||||||
it "recognises the node's own responsibility" $ do
|
it "recognises the node's own responsibility" $ do
|
||||||
|
@ -147,7 +144,7 @@ spec = do
|
||||||
incomingQuery node1 nC 3 nid1 `shouldBe` FOUND node1
|
incomingQuery node1 nC 3 nid1 `shouldBe` FOUND node1
|
||||||
it "does not fail on nodes without neighbours (initial state)" $ do
|
it "does not fail on nodes without neighbours (initial state)" $ do
|
||||||
nC <- cacheWith4Entries
|
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]
|
Set.map (nid . cacheGetNodeStateUnvalidated ) nodeset `shouldBe` Set.fromList [nid4, nid2, nid3]
|
||||||
|
|
||||||
|
|
||||||
|
@ -160,14 +157,22 @@ exampleNodeState = NodeState {
|
||||||
, ipAddr = exampleIp
|
, ipAddr = exampleIp
|
||||||
, dhtPort = 2342
|
, dhtPort = 2342
|
||||||
, apPort = Nothing
|
, apPort = Nothing
|
||||||
, nodeCache = initCache
|
, vServerID = 0
|
||||||
|
, internals = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
exampleInternals :: InternalNodeState
|
||||||
|
exampleInternals = InternalNodeState {
|
||||||
|
nodeCache = initCache
|
||||||
, successors = []
|
, successors = []
|
||||||
, predecessors = []
|
, predecessors = []
|
||||||
, kNeighbours = 3
|
, kNeighbours = 3
|
||||||
, lNumBestNodes = 3
|
, lNumBestNodes = 3
|
||||||
, pNumParallelQueries = 2
|
, pNumParallelQueries = 2
|
||||||
, jEntriesPerSlice = 2
|
, jEntriesPerSlice = 2
|
||||||
}
|
}
|
||||||
|
|
||||||
|
exampleLocalNode = exampleNodeState {internals = Just exampleInternals}
|
||||||
|
|
||||||
exampleNodeDomain :: String
|
exampleNodeDomain :: String
|
||||||
exampleNodeDomain = "example.social"
|
exampleNodeDomain = "example.social"
|
||||||
|
|
Loading…
Reference in a new issue