Hash2Pub/app/Main.hs

66 lines
2.5 KiB
Haskell
Raw Normal View History

2020-03-20 19:01:25 +01:00
module Main where
import Control.Concurrent
2020-05-29 17:39:35 +02:00
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Exception
2020-05-27 19:10:45 +02:00
import Data.Either
import Data.IP (IPv6, toHostAddress6)
import System.Environment
import Hash2Pub.FediChord
import Hash2Pub.FediChordTypes
import Hash2Pub.PostService (PostService (..))
2020-03-20 19:01:25 +01:00
main :: IO ()
main = do
-- ToDo: parse and pass config
-- probably use `tomland` for that
(fConf, sConf) <- readConfig
-- TODO: first initialise 'RealNode', then the vservers
-- ToDo: load persisted caches, bootstrapping nodes …
(serverSock, thisNode) <- fediChordInit fConf (runService sConf :: DHT d => d -> IO (PostService d))
-- currently no masking is necessary, as there is nothing to clean up
nodeCacheWriterThread <- forkIO $ nodeCacheWriter thisNode
-- try joining the DHT using one of the provided bootstrapping nodes
joinedState <- tryBootstrapJoining thisNode
2020-05-29 17:39:35 +02:00
either (\err -> do
2020-05-27 18:59:38 +02:00
-- handle unsuccessful join
putStrLn $ err <> " Error joining, start listening for incoming requests anyways"
2020-07-02 01:36:31 +02:00
print =<< readTVarIO thisNode
-- launch thread attempting to join on new cache entries
_ <- forkIO $ joinOnNewEntriesThread thisNode
2020-05-29 17:39:35 +02:00
wait =<< async (fediMainThreads serverSock thisNode)
2020-05-27 18:59:38 +02:00
)
2020-05-29 17:39:35 +02:00
(\joinedNS -> do
2020-05-27 18:59:38 +02:00
-- launch main eventloop with successfully joined state
putStrLn "successful join"
2020-05-29 17:39:35 +02:00
wait =<< async (fediMainThreads serverSock thisNode)
2020-05-27 18:59:38 +02:00
)
joinedState
pure ()
readConfig :: IO (FediChordConf, ServiceConf)
readConfig = do
confDomainString : ipString : portString : bootstrapHost : bootstrapPortString : servicePortString : speedup : _ <- getArgs
let
fConf = FediChordConf {
confDomain = confDomainString
, confIP = toHostAddress6 . read $ ipString
, confDhtPort = read portString
, confBootstrapNodes = [(bootstrapHost, read bootstrapPortString)]
--, confStabiliseInterval = 60
, confBootstrapSamplingInterval = 180
, confMaxLookupCacheAge = 300
}
sConf = ServiceConf {
2020-08-01 11:00:29 +02:00
confSubscriptionExpiryTime = fromIntegral $ 2*3600 `div` (read speedup :: Integer)
, confServicePort = read servicePortString
, confServiceHost = confDomainString
}
pure (fConf, sConf)