Compare commits
No commits in common. "d293cc05d148ebe7b9019afffcfdab5ff44719d5" and "e91f317a8e3346b381f85ad8380e14b4b374ddce" have entirely different histories.
d293cc05d1
...
e91f317a8e
4 changed files with 16 additions and 57 deletions
|
@ -16,13 +16,10 @@ main = do
|
||||||
-- ToDo: parse and pass config
|
-- ToDo: parse and pass config
|
||||||
-- probably use `tomland` for that
|
-- probably use `tomland` for that
|
||||||
conf <- readConfig
|
conf <- readConfig
|
||||||
-- TODO: first initialise 'RealNode', then the vservers
|
|
||||||
-- ToDo: load persisted caches, bootstrapping nodes …
|
-- ToDo: load persisted caches, bootstrapping nodes …
|
||||||
(serverSock, thisNode) <- fediChordInit conf
|
(serverSock, thisNode) <- fediChordInit conf
|
||||||
-- currently no masking is necessary, as there is nothing to clean up
|
-- currently no masking is necessary, as there is nothing to clean up
|
||||||
cacheWriterThread <- forkIO $ cacheWriter thisNode
|
cacheWriterThread <- forkIO $ cacheWriter thisNode
|
||||||
thisNodeSnap <- readTVarIO thisNode
|
|
||||||
realNode <- readTVarIO $ parentRealNode thisNodeSnap
|
|
||||||
-- try joining the DHT using one of the provided bootstrapping nodes
|
-- try joining the DHT using one of the provided bootstrapping nodes
|
||||||
let
|
let
|
||||||
tryJoining (bn:bns) = do
|
tryJoining (bn:bns) = do
|
||||||
|
@ -31,7 +28,7 @@ main = do
|
||||||
Left err -> putStrLn ("join error: " <> err) >> tryJoining bns
|
Left err -> putStrLn ("join error: " <> err) >> tryJoining bns
|
||||||
Right joined -> pure $ Right joined
|
Right joined -> pure $ Right joined
|
||||||
tryJoining [] = pure $ Left "Exhausted all bootstrap points for joining."
|
tryJoining [] = pure $ Left "Exhausted all bootstrap points for joining."
|
||||||
joinedState <- tryJoining $ bootstrapNodes realNode
|
joinedState <- tryJoining $ confBootstrapNodes conf
|
||||||
either (\err -> do
|
either (\err -> do
|
||||||
-- handle unsuccessful join
|
-- handle unsuccessful join
|
||||||
|
|
||||||
|
|
|
@ -41,7 +41,6 @@ module Hash2Pub.FediChord (
|
||||||
, fediChordJoin
|
, fediChordJoin
|
||||||
, fediChordBootstrapJoin
|
, fediChordBootstrapJoin
|
||||||
, fediMainThreads
|
, fediMainThreads
|
||||||
, RealNode (..)
|
|
||||||
, nodeStateInit
|
, nodeStateInit
|
||||||
, mkServerSocket
|
, mkServerSocket
|
||||||
, mkSendSocket
|
, mkSendSocket
|
||||||
|
@ -91,36 +90,27 @@ import Debug.Trace (trace)
|
||||||
-- | initialise data structures, compute own IDs and bind to listening socket
|
-- | initialise data structures, compute own IDs and bind to listening socket
|
||||||
-- ToDo: load persisted state, thus this function already operates in IO
|
-- ToDo: load persisted state, thus this function already operates in IO
|
||||||
fediChordInit :: FediChordConf -> IO (Socket, LocalNodeStateSTM)
|
fediChordInit :: FediChordConf -> IO (Socket, LocalNodeStateSTM)
|
||||||
fediChordInit initConf = do
|
fediChordInit conf = do
|
||||||
let realNode = RealNode {
|
initialState <- nodeStateInit conf
|
||||||
vservers = []
|
|
||||||
, nodeConfig = initConf
|
|
||||||
, bootstrapNodes = confBootstrapNodes initConf
|
|
||||||
}
|
|
||||||
realNodeSTM <- newTVarIO realNode
|
|
||||||
initialState <- nodeStateInit realNodeSTM
|
|
||||||
initialStateSTM <- newTVarIO initialState
|
initialStateSTM <- newTVarIO initialState
|
||||||
serverSock <- mkServerSocket (getIpAddr initialState) (getDhtPort initialState)
|
serverSock <- mkServerSocket (getIpAddr initialState) (getDhtPort initialState)
|
||||||
pure (serverSock, initialStateSTM)
|
pure (serverSock, initialStateSTM)
|
||||||
|
|
||||||
-- | initialises the 'NodeState' for this local node.
|
-- | initialises the 'NodeState' for this local node.
|
||||||
-- Separated from 'fediChordInit' to be usable in tests.
|
-- Separated from 'fediChordInit' to be usable in tests.
|
||||||
nodeStateInit :: RealNodeSTM -> IO LocalNodeState
|
nodeStateInit :: FediChordConf -> IO LocalNodeState
|
||||||
nodeStateInit realNodeSTM = do
|
nodeStateInit conf = do
|
||||||
realNode <- readTVarIO realNodeSTM
|
|
||||||
cacheSTM <- newTVarIO initCache
|
cacheSTM <- newTVarIO initCache
|
||||||
q <- atomically newTQueue
|
q <- atomically newTQueue
|
||||||
let
|
let
|
||||||
conf = nodeConfig realNode
|
|
||||||
vsID = 0
|
|
||||||
containedState = RemoteNodeState {
|
containedState = RemoteNodeState {
|
||||||
domain = confDomain conf
|
domain = confDomain conf
|
||||||
, ipAddr = confIP conf
|
, ipAddr = confIP conf
|
||||||
, nid = genNodeID (confIP conf) (confDomain conf) $ fromInteger vsID
|
, nid = genNodeID (confIP conf) (confDomain conf) 0
|
||||||
, dhtPort = toEnum $ confDhtPort conf
|
, dhtPort = toEnum $ confDhtPort conf
|
||||||
, servicePort = 0
|
, servicePort = 0
|
||||||
, vServerID = vsID
|
, vServerID = 0
|
||||||
}
|
}
|
||||||
initialState = LocalNodeState {
|
initialState = LocalNodeState {
|
||||||
nodeState = containedState
|
nodeState = containedState
|
||||||
, nodeCacheSTM = cacheSTM
|
, nodeCacheSTM = cacheSTM
|
||||||
|
@ -131,7 +121,6 @@ nodeStateInit realNodeSTM = do
|
||||||
, lNumBestNodes = 3
|
, lNumBestNodes = 3
|
||||||
, pNumParallelQueries = 2
|
, pNumParallelQueries = 2
|
||||||
, jEntriesPerSlice = 2
|
, jEntriesPerSlice = 2
|
||||||
, parentRealNode = realNodeSTM
|
|
||||||
}
|
}
|
||||||
pure initialState
|
pure initialState
|
||||||
|
|
||||||
|
@ -198,7 +187,7 @@ joinOnNewEntriesThread nsSTM = loop
|
||||||
case queryLocalCache nsSnap cache 1 (getNid nsSnap) of
|
case queryLocalCache nsSnap cache 1 (getNid nsSnap) of
|
||||||
-- empty cache, block until cache changes and then retry
|
-- empty cache, block until cache changes and then retry
|
||||||
(FORWARD s) | Set.null s -> retry
|
(FORWARD s) | Set.null s -> retry
|
||||||
result -> pure (result, cache)
|
result -> pure (result, cache)
|
||||||
case lookupResult of
|
case lookupResult of
|
||||||
-- already joined
|
-- already joined
|
||||||
FOUND _ -> do
|
FOUND _ -> do
|
||||||
|
|
|
@ -13,8 +13,6 @@ module Hash2Pub.FediChordTypes (
|
||||||
, LocalNodeState (..)
|
, LocalNodeState (..)
|
||||||
, LocalNodeStateSTM
|
, LocalNodeStateSTM
|
||||||
, RemoteNodeState (..)
|
, RemoteNodeState (..)
|
||||||
, RealNode (..)
|
|
||||||
, RealNodeSTM
|
|
||||||
, setSuccessors
|
, setSuccessors
|
||||||
, setPredecessors
|
, setPredecessors
|
||||||
, NodeCache
|
, NodeCache
|
||||||
|
@ -134,19 +132,6 @@ a `localCompare` b
|
||||||
wayForwards = getNodeID (b - a)
|
wayForwards = getNodeID (b - a)
|
||||||
wayBackwards = getNodeID (a - b)
|
wayBackwards = getNodeID (a - b)
|
||||||
|
|
||||||
-- | Data for managing the virtual server nodes of this real node.
|
|
||||||
-- Also contains shared data and config values.
|
|
||||||
-- TODO: more data structures for k-choices bookkeeping
|
|
||||||
data RealNode = RealNode
|
|
||||||
{ vservers :: [LocalNodeStateSTM]
|
|
||||||
-- ^ references to all active versers
|
|
||||||
, nodeConfig :: FediChordConf
|
|
||||||
-- ^ holds the initial configuration read at program start
|
|
||||||
, bootstrapNodes :: [(String, PortNumber)]
|
|
||||||
-- ^ nodes to be used as bootstrapping points, new ones learned during operation
|
|
||||||
}
|
|
||||||
|
|
||||||
type RealNodeSTM = TVar RealNode
|
|
||||||
|
|
||||||
-- | represents a node and all its important state
|
-- | represents a node and all its important state
|
||||||
data RemoteNodeState = RemoteNodeState
|
data RemoteNodeState = RemoteNodeState
|
||||||
|
@ -187,8 +172,6 @@ data LocalNodeState = LocalNodeState
|
||||||
-- ^ number of parallel sent queries
|
-- ^ number of parallel sent queries
|
||||||
, jEntriesPerSlice :: Int
|
, jEntriesPerSlice :: Int
|
||||||
-- ^ number of desired entries per cache slice
|
-- ^ number of desired entries per cache slice
|
||||||
, parentRealNode :: RealNodeSTM
|
|
||||||
-- ^ the parent node managing this vserver instance
|
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,12 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module FediChordSpec where
|
module FediChordSpec where
|
||||||
|
|
||||||
import Control.Concurrent.STM.TVar
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.ASN1.Parse (runParseASN1)
|
import Data.ASN1.Parse (runParseASN1)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.Maybe (fromJust, isJust)
|
import Data.Maybe (fromJust, isJust)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
@ -293,20 +292,11 @@ exampleNodeState = RemoteNodeState {
|
||||||
}
|
}
|
||||||
|
|
||||||
exampleLocalNode :: IO LocalNodeState
|
exampleLocalNode :: IO LocalNodeState
|
||||||
exampleLocalNode = nodeStateInit =<< (newTVarIO $ RealNode {
|
exampleLocalNode = nodeStateInit $ FediChordConf {
|
||||||
vservers = []
|
|
||||||
, nodeConfig = exampleFediConf
|
|
||||||
, bootstrapNodes = confBootstrapNodes exampleFediConf
|
|
||||||
})
|
|
||||||
|
|
||||||
|
|
||||||
exampleFediConf :: FediChordConf
|
|
||||||
exampleFediConf = FediChordConf {
|
|
||||||
confDomain = "example.social"
|
confDomain = "example.social"
|
||||||
, confIP = exampleIp
|
, confIP = exampleIp
|
||||||
, confDhtPort = 2342
|
, confDhtPort = 2342
|
||||||
}
|
}
|
||||||
|
|
||||||
exampleNodeDomain :: String
|
exampleNodeDomain :: String
|
||||||
exampleNodeDomain = "example.social"
|
exampleNodeDomain = "example.social"
|
||||||
exampleVs :: (Integral i) => i
|
exampleVs :: (Integral i) => i
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue