properly initialise RealNode with service and vserver data, set up reference
This commit is contained in:
parent
5ffe1b074e
commit
e3c7faa80b
|
@ -105,20 +105,23 @@ fediChordInit initConf serviceRunner = do
|
||||||
, nodeConfig = initConf
|
, nodeConfig = initConf
|
||||||
, bootstrapNodes = confBootstrapNodes initConf
|
, bootstrapNodes = confBootstrapNodes initConf
|
||||||
, lookupCacheSTM = emptyLookupCache
|
, lookupCacheSTM = emptyLookupCache
|
||||||
--, service = undefined
|
, nodeService = undefined
|
||||||
}
|
}
|
||||||
realNodeSTM <- newTVarIO realNode
|
realNodeSTM <- newTVarIO realNode
|
||||||
-- launch service and set the reference in the RealNode
|
-- launch service and set the reference in the RealNode
|
||||||
serv <- serviceRunner realNodeSTM
|
serv <- serviceRunner realNodeSTM
|
||||||
--atomically . writeTVar $ realNode { service = serv }
|
atomically . modifyTVar' realNodeSTM $ \rn -> rn { nodeService = serv }
|
||||||
|
-- initialise a single vserver
|
||||||
initialState <- nodeStateInit realNodeSTM
|
initialState <- nodeStateInit realNodeSTM
|
||||||
initialStateSTM <- newTVarIO initialState
|
initialStateSTM <- newTVarIO initialState
|
||||||
|
-- add vserver to list at RealNode
|
||||||
|
atomically . modifyTVar' realNodeSTM $ \rn -> rn { vservers = initialStateSTM:vservers rn }
|
||||||
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 s -> IO (LocalNodeState s)
|
nodeStateInit :: Service s (RealNodeSTM s) => RealNodeSTM s -> IO (LocalNodeState s)
|
||||||
nodeStateInit realNodeSTM = do
|
nodeStateInit realNodeSTM = do
|
||||||
realNode <- readTVarIO realNodeSTM
|
realNode <- readTVarIO realNodeSTM
|
||||||
cacheSTM <- newTVarIO initCache
|
cacheSTM <- newTVarIO initCache
|
||||||
|
@ -131,7 +134,7 @@ nodeStateInit realNodeSTM = do
|
||||||
, ipAddr = confIP conf
|
, ipAddr = confIP conf
|
||||||
, nid = genNodeID (confIP conf) (confDomain conf) $ fromInteger vsID
|
, nid = genNodeID (confIP conf) (confDomain conf) $ fromInteger vsID
|
||||||
, dhtPort = toEnum $ confDhtPort conf
|
, dhtPort = toEnum $ confDhtPort conf
|
||||||
, servicePort = 0
|
, servicePort = getListeningPortFromService $ nodeService realNode
|
||||||
, vServerID = vsID
|
, vServerID = vsID
|
||||||
}
|
}
|
||||||
initialState = LocalNodeState {
|
initialState = LocalNodeState {
|
||||||
|
@ -543,7 +546,7 @@ sendThread sock sendQ = forever $ do
|
||||||
fediMainThreads :: Socket -> LocalNodeStateSTM s -> IO ()
|
fediMainThreads :: Socket -> LocalNodeStateSTM s -> IO ()
|
||||||
fediMainThreads sock nsSTM = do
|
fediMainThreads sock nsSTM = do
|
||||||
ns <- readTVarIO nsSTM
|
ns <- readTVarIO nsSTM
|
||||||
putStrLn $ "launching threads"
|
putStrLn "launching threads"
|
||||||
sendQ <- newTQueueIO
|
sendQ <- newTQueueIO
|
||||||
recvQ <- newTQueueIO
|
recvQ <- newTQueueIO
|
||||||
-- concurrently launch all handler threads, if one of them throws an exception
|
-- concurrently launch all handler threads, if one of them throws an exception
|
||||||
|
|
|
@ -423,7 +423,7 @@ data FediChordConf = FediChordConf
|
||||||
class Service s d where
|
class Service s d where
|
||||||
-- | run the service
|
-- | run the service
|
||||||
runService :: ServiceConf -> d -> IO (s d)
|
runService :: ServiceConf -> d -> IO (s d)
|
||||||
getServicePort' :: (Integral i) => s d -> i
|
getListeningPortFromService :: (Integral i) => s d -> i
|
||||||
|
|
||||||
instance Hashable.Hashable NodeID where
|
instance Hashable.Hashable NodeID where
|
||||||
hashWithSalt salt = Hashable.hashWithSalt salt . getNodeID
|
hashWithSalt salt = Hashable.hashWithSalt salt . getNodeID
|
||||||
|
|
|
@ -97,7 +97,7 @@ instance DHT d => Service PostService d where
|
||||||
atomically $ writeTVar threadVar servThreadID
|
atomically $ writeTVar threadVar servThreadID
|
||||||
pure thisService
|
pure thisService
|
||||||
|
|
||||||
getServicePort' = fromIntegral . confServicePort . serviceConf
|
getListeningPortFromService = fromIntegral . confServicePort . serviceConf
|
||||||
|
|
||||||
|
|
||||||
-- | return a WAI application
|
-- | return a WAI application
|
||||||
|
|
Loading…
Reference in a new issue