~singpolyma/cheogram

425162365e7942a3edc8d8ee236a35d998f13c6b — Stephen Paul Weber 3 years ago 2466a72
Switch from many cli args to a dhall config file

Before we add even more config in a sec here
2 files changed, 30 insertions(+), 8 deletions(-)

M Main.hs
M cheogram.cabal
M Main.hs => Main.hs +29 -8
@@ 1,4 1,6 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
import Prelude (show, read)
import BasicPrelude hiding (show, read, forM, mapM, forM_, mapM_, getArgs, log)
import System.IO (stdout, stderr, hSetBuffering, BufferMode(LineBuffering))


@@ 18,6 20,8 @@ import Data.Digest.Pure.SHA (sha1, bytestringDigest)

import "monads-tf" Control.Monad.Error (catchError) -- ick
import Data.XML.Types (Element(..), Node(NodeContent, NodeElement), Name(Name), Content(ContentText), isNamed, hasAttributeText, elementText, elementChildren, attributeText, hasAttribute)
import qualified Dhall
import qualified Dhall.Core as Dhall hiding (Type)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Text.Encoding as T


@@ 1690,6 1694,24 @@ openTokyoCabinet pth = TC.runTCM $ do
	True <- TC.open db pth [TC.OREADER, TC.OWRITER, TC.OCREAT]
	return db

data ServerConfig = ServerConfig { host :: String, port :: Dhall.Natural } deriving (Dhall.Generic, Dhall.Interpret, Show)

data Config = Config {
	componentJid :: JID,
	server :: ServerConfig,
	secret :: Text,
	backend :: Text,
	did :: Text,
	registrationJid :: JID,
	conferenceServers :: [Text]
} deriving (Dhall.Generic, Dhall.Interpret, Show)

instance Dhall.Interpret JID where
	autoWith _ = Dhall.Type {
			Dhall.extract = \(Dhall.TextLit (Dhall.Chunks _ txt)) -> parseJID txt,
			Dhall.expected = Dhall.Text
		}

main :: IO ()
main = do
	hSetBuffering stdout LineBuffering


@@ 1704,22 1726,21 @@ main = do
			void $ runComponent (Server componentJid host (PortNumber $ fromIntegral (read port :: Int))) (fromString secret) $ do
				mapM_ putStanza =<< registerToGateway componentJid gatewayJid (fromString did) (fromString password)
				liftIO $ threadDelay 1000000
		(name:host:port:secret:backendHost:rawdid:registration:conferences) -> do
		[config] -> do
			(Config componentJid (ServerConfig host port) secret backendHost rawdid registrationJid conferences) <- Dhall.input Dhall.auto (fromString config)
			log "" "Starting..."
			let Just componentJid = parseJID (fromString name)
			let Just registrationJid = parseJID (fromString registration)
			let Just did = normalizeTel (fromString rawdid)
			let Just did = normalizeTel rawdid
			db <- openTokyoCabinet "./db.tcdb" :: IO TC.HDB
			toJoinPartDebouncer <- atomically newTChan
			sendToComponent <- atomically newTChan
			toRoomPresences <- atomically newTChan
			toRejoinManager <- atomically newTChan

			void $ forkIO $ joinPartDebouncer db (fromString backendHost) (atomically . writeTChan sendToComponent) componentJid toRoomPresences toJoinPartDebouncer
			void $ forkIO $ joinPartDebouncer db backendHost (atomically . writeTChan sendToComponent) componentJid toRoomPresences toJoinPartDebouncer
			void $ forkIO $ roomPresences db toRoomPresences

			void $ forkIO $ forever $ atomically (writeTChan toRejoinManager CheckPings) >> threadDelay 120000000
			void $ forkIO $ rejoinManager db (atomically . writeTChan sendToComponent) name toRoomPresences toRejoinManager
			void $ forkIO $ rejoinManager db (atomically . writeTChan sendToComponent) (textToString $ formatJID componentJid) toRoomPresences toRejoinManager

			processDirectMessageRouteConfig <- ConfigureDirectMessageRoute.main
				(\userJid ->


@@ 1752,6 1773,6 @@ main = do
				log "" "runComponent STARTING"

				(log "runComponent ENDED" <=< (runExceptT . syncIO)) $
					runComponent (Server componentJid host (PortNumber $ fromIntegral (read port :: Int))) (fromString secret)
						(component db (fromString backendHost) toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent processDirectMessageRouteConfig componentJid [registrationJid] (map fromString conferences))
					runComponent (Server componentJid host (PortNumber $ fromIntegral port)) secret
						(component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent processDirectMessageRouteConfig componentJid [registrationJid] conferences)
		_ -> log "ERROR" "Bad arguments"

M cheogram.cabal => cheogram.cabal +1 -0
@@ 35,6 35,7 @@ executable cheogram
                case-insensitive,
                containers,
                cryptonite,
                dhall,
                errors,
                monad-loops,
                monads-tf,