5 files changed, 96 insertions(+), 48 deletions(-)

M Config.hs
A ConfigFile.hs
M Util.hs
M cheogram-muc-bridge.cabal
M gateway.hs

@@ 1,51 1,44 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-
-module Config where
+module Config (setup, Config(..), ConfigFile.ServerConfig(..), ConfigFile.Bridge(..)) where
 
 import Prelude ()
 import BasicPrelude
 
-import qualified Network
+import Data.Time.Clock.POSIX (getPOSIXTime)
 import qualified Dhall
-import qualified Dhall.Core as Dhall
 import qualified Network.Protocol.XMPP as XMPP
+import qualified Database.SQLite.Simple as DB
 
-import Util
-
-data ServerConfig = ServerConfig {
-	host :: Network.HostName,
-	port :: Network.PortID
-} deriving (Dhall.Generic, Dhall.FromDhall, Show)
-
-data Bridge = Bridge {
-	muc1 :: XMPP.JID,
-	muc2 :: XMPP.JID
-} deriving (Dhall.Generic, Dhall.FromDhall, Show)
+import qualified ConfigFile
 
 data Config = Config {
 	componentJid :: XMPP.JID,
-	server :: ServerConfig,
+	server :: ConfigFile.ServerConfig,
 	secret :: Text,
 	nick :: Text,
-	mucs :: [Bridge]
-} deriving (Dhall.Generic, Dhall.FromDhall, Show)
-
-instance Dhall.FromDhall XMPP.JID where
-	autoWith _ = Dhall.Decoder {
-			Dhall.extract = \(Dhall.TextLit (Dhall.Chunks _ txt)) ->
-				maybe (Dhall.extractError $ s"Invalid JID") pure $ XMPP.parseJID txt,
-			Dhall.expected = pure Dhall.Text
-		}
-
-instance Dhall.FromDhall Network.PortID where
-	autoWith _ = Dhall.Decoder {
-			Dhall.extract = \(Dhall.NaturalLit nat) -> pure $ Network.PortNumber (fromIntegral nat),
-			Dhall.expected = pure Dhall.Natural
-		}
-
-instance Dhall.FromDhall Network.PortNumber where
-	autoWith _ = Dhall.Decoder {
-			Dhall.extract = \(Dhall.NaturalLit nat) -> pure $ fromIntegral nat,
-			Dhall.expected = pure Dhall.Natural
+	bridgeJid :: XMPP.JID,
+	db :: DB.Connection,
+	dbVersion :: Integer,
+	mucs :: [ConfigFile.Bridge]
+}
+
+-- Not importing Util because Util imports us
+s :: (IsString s) => String -> s
+s = fromString
+
+setup :: Text -> IO Config
+setup expr = do
+	configFile <- Dhall.input Dhall.auto expr
+	Just bridgeJid <- return $ XMPP.parseJID $ s"bridge@" ++
+		XMPP.formatJID (ConfigFile.componentJid configFile) ++ s"/bridge"
+	db <- DB.open (textToString $ ConfigFile.db configFile)
+	now <- getPOSIXTime
+	return $ Config {
+			componentJid = ConfigFile.componentJid configFile,
+			server = ConfigFile.server configFile,
+			secret = ConfigFile.secret configFile,
+			nick = ConfigFile.nick configFile,
+			bridgeJid = bridgeJid,
+			db = db,
+			dbVersion = ceiling now,
+			mucs = ConfigFile.mucs configFile
 		}

@@ 0,0 1,50 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+
+module ConfigFile where
+
+import Prelude ()
+import BasicPrelude
+
+import qualified Network
+import qualified Dhall
+import qualified Dhall.Core as Dhall
+import qualified Network.Protocol.XMPP as XMPP
+
+data ServerConfig = ServerConfig {
+	host :: Network.HostName,
+	port :: Network.PortID
+} deriving (Dhall.Generic, Dhall.FromDhall, Show)
+
+data Bridge = Bridge {
+	muc1 :: XMPP.JID,
+	muc2 :: XMPP.JID
+} deriving (Dhall.Generic, Dhall.FromDhall, Show)
+
+data Config = Config {
+	componentJid :: XMPP.JID,
+	server :: ServerConfig,
+	secret :: Text,
+	nick :: Text,
+	db :: Text,
+	mucs :: [Bridge]
+} deriving (Dhall.Generic, Dhall.FromDhall, Show)
+
+instance Dhall.FromDhall XMPP.JID where
+	autoWith _ = Dhall.Decoder {
+			Dhall.extract = \(Dhall.TextLit (Dhall.Chunks _ txt)) ->
+				maybe (Dhall.extractError $ fromString "Invalid JID") pure $ XMPP.parseJID txt,
+			Dhall.expected = pure Dhall.Text
+		}
+
+instance Dhall.FromDhall Network.PortID where
+	autoWith _ = Dhall.Decoder {
+			Dhall.extract = \(Dhall.NaturalLit nat) -> pure $ Network.PortNumber (fromIntegral nat),
+			Dhall.expected = pure Dhall.Natural
+		}
+
+instance Dhall.FromDhall Network.PortNumber where
+	autoWith _ = Dhall.Decoder {
+			Dhall.extract = \(Dhall.NaturalLit nat) -> pure $ fromIntegral nat,
+			Dhall.expected = pure Dhall.Natural
+		}

@@ 13,6 13,8 @@ import qualified Data.Text             as Text
 import qualified Data.XML.Types        as XML
 import qualified Network.Protocol.XMPP as XMPP
 
+import qualified Config
+
 s :: (IsString s) => String -> s
 s = fromString
 

@@ 21,6 21,7 @@ common defs
                        errors                >=2.3 && <2.4,
                        network               >= 2.6.3 && < 2.7,
                        network-protocol-xmpp >=0.4 && <0.5,
+                       sqlite-simple         >= 0.4 && <0.5,
                        text                  >=1.2 && <1.3,
                        time                  >=1.5 && <2.0,
                        xml-types             >=0.3 && <0.4


@@ 28,4 29,4 @@ common defs
 executable gateway
   import:              defs
   main-is:             gateway.hs
-  other-modules:       Router, Util, Config>
\ No newline at end of file
+  other-modules:       Router, Util, Config, ConfigFile<
\ No newline at end of file

@@ 5,7 5,6 @@ import BasicPrelude
 import System.IO
 	(stdout, stderr, hSetBuffering, BufferMode(LineBuffering))
 import Control.Error                   (exceptT, justZ)
-import qualified Dhall
 import qualified Data.Text             as T
 import qualified Data.XML.Types        as XML
 import qualified Network.Protocol.XMPP as XMPP


@@ 56,7 55,7 @@ handlePresence config presence@XMPP.Presence {
 	XMPP.presenceTo = Just to,
 	XMPP.presencePayloads = p
 }
-	| bareTxt to /= s"bridge@" ++ XMPP.formatJID (Config.componentJid config) =
+	| bareTxt to /= bareTxt (Config.bridgeJid config) =
 		-- This is to one of our ghosts, so just ignore it
 		return ()
 	| hasMucCode 110 presence = return () -- ignore self presence


@@ 98,7 97,7 @@ handleGroupChat config message@XMPP.Message {
 	XMPP.messageFrom = Just from,
 	XMPP.messageTo = Just to
 }
-	| bareTxt to /= s"bridge@" ++ XMPP.formatJID (Config.componentJid config) =
+	| bareTxt to /= bareTxt (Config.bridgeJid config) =
 		-- This is to one of our ghosts, so just ignore it
 		return ()
 	| otherwise = forM_ (targets config from) $ \target ->


@@ 150,26 149,29 @@ handleIq config iq@XMPP.IQ {
 	target = XMPP.parseJID $ unescapeJid $ XMPP.strNode node
 handleIq _ _ = return ()
 
+joinFromBridge :: Config.Config -> XMPP.JID -> XMPP.XMPP ()
+joinFromBridge config muc = do
+	XMPP.putStanza $ (mucJoin muc (Config.nick config)) {
+			XMPP.presenceFrom = Just $ Config.bridgeJid config
+		}
+
 main :: IO ()
 main = do
 	hSetBuffering stdout LineBuffering
 	hSetBuffering stderr LineBuffering
 
-	config <- Dhall.input Dhall.auto =<< fmap head getArgs
+	config <- Config.setup =<< fmap head getArgs
 
 	let server = XMPP.Server
 		(Config.componentJid config)
 		(Config.host $ Config.server config)
 		(Config.port $ Config.server config)
 
-	let Just bridgeJid = XMPP.parseJID $ s"bridge@" ++
-		XMPP.formatJID (Config.componentJid config) ++ s"/bridge"
-
 	exceptT print return $
 		runRoutedComponent server (Config.secret config) $ do
 			forM_ (Config.mucs config) $ \bridge -> do
-				XMPP.putStanza $ (mucJoin (Config.muc1 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
-				XMPP.putStanza $ (mucJoin (Config.muc2 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
+				joinFromBridge config (Config.muc1 bridge)
+				joinFromBridge config (Config.muc2 bridge)
 			return $ defaultRoutes {
 				presenceRoute = handlePresence config,
 				presenceErrorRoute = handlePresenceError,