module Main where import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM import Control.Concurrent.STM.TVar import Control.Exception import Data.Either import Data.IP (IPv6, toHostAddress6) import System.Environment import Hash2Pub.FediChord import Hash2Pub.FediChordTypes import Hash2Pub.PostService (PostService (..)) 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 either (\err -> do -- handle unsuccessful join putStrLn $ err <> " Error joining, start listening for incoming requests anyways" print =<< readTVarIO thisNode -- launch thread attempting to join on new cache entries _ <- forkIO $ joinOnNewEntriesThread thisNode wait =<< async (fediMainThreads serverSock thisNode) ) (\joinedNS -> do -- launch main eventloop with successfully joined state putStrLn "successful join" wait =<< async (fediMainThreads serverSock thisNode) ) 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 { confSubscriptionExpiryTime = 2*3600 `div` read speedup , confServicePort = read servicePortString , confServiceHost = confDomainString } pure (fConf, sConf)