schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

extract internal node parameters to own arithmetic type

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Hash2Pub/Hash2Pub.cabal
View file

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

14
Hash2Pub/src/Hash2Pub/DHTProtocol.hs
View file

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

71
Hash2Pub/src/Hash2Pub/FediChord.hs
View file

@ -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
@ -135,6 +152,44 @@ data NodeState = NodeState {
-- ^ number of desired entries per cache slice
-- needs to be parameterisable for simulation purposes
} 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 _ = []

45
Hash2Pub/test/FediChordSpec.hs
View file

@ -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,7 +157,13 @@ exampleNodeState = NodeState {
, ipAddr = exampleIp
, dhtPort = 2342
, apPort = Nothing
, nodeCache = initCache
, vServerID = 0
, internals = Nothing
}
exampleInternals :: InternalNodeState
exampleInternals = InternalNodeState {
nodeCache = initCache
, successors = []
, predecessors = []
, kNeighbours = 3
@ -169,6 +172,8 @@ exampleNodeState = NodeState {
, jEntriesPerSlice = 2
}
exampleLocalNode = exampleNodeState {internals = Just exampleInternals}
exampleNodeDomain :: String
exampleNodeDomain = "example.social"
exampleVs :: (Integral i) => i