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 : servicePortString : speedupString : remainingArgs <- getArgs -- allow starting the initial node without bootstrapping info to avoid -- waiting for timeout let speedup = read speedupString confBootstrapNodes' = case remainingArgs of bootstrapHost : bootstrapPortString : _ -> [(bootstrapHost, read bootstrapPortString)] _ -> [] fConf = FediChordConf { confDomain = confDomainString , confIP = toHostAddress6 . read $ ipString , confDhtPort = read portString , confBootstrapNodes = confBootstrapNodes' , confStabiliseInterval = 60 * 10^6 , confBootstrapSamplingInterval = 180 * 10^6 `div` speedup , confMaxLookupCacheAge = 300 / fromIntegral speedup , confJoinAttemptsInterval = 60 * 10^6 `div` speedup , confMaxNodeCacheAge = 600 / fromIntegral speedup , confResponsePurgeAge = 60 / fromIntegral speedup } sConf = ServiceConf { confSubscriptionExpiryTime = fromIntegral $ 2*3600 `div` speedup , confServicePort = read servicePortString , confServiceHost = confDomainString } pure (fConf, sConf)