Hash2Pub/app/Main.hs

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)