extract internal node parameters to own arithmetic type

This commit is contained in:
Trolli Schmittlauch 2020-04-29 00:45:31 +02:00
parent 24936d48c1
commit db229975b0
4 changed files with 102 additions and 33 deletions

View file

@ -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

View file

@ -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

View file

@ -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 _ = []

View file

@ -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"