module Main (main) where

import Prelude ()
import BasicPrelude
import Data.Functor                    ((<&>))
import Control.Concurrent.STM          (atomically)
import Control.Error                   (hush)
import Network                         (PortID (PortNumber))
import System.Exit                     (exitFailure)
import qualified Data.ByteString.Lazy  as LByteString
import qualified Data.MIME             as MIME
import qualified Network.Protocol.XMPP as XMPP
import qualified Network.Protocol.XMPP.Internal as XMPP

import Email
import IQManager
import Router
import Util

runClient :: XMPP.JID -> Text -> XMPP.XMPP a -> IO (Either XMPP.Error a)
runClient jid =
	XMPP.runClient server jid jidStrNode
	where
	-- This is right unless there is an SRV record, which we don't check for
	Just jidStrNode = XMPP.strNode <$> XMPP.jidNode jid
	jidStrDomain = XMPP.strDomain $ XMPP.jidDomain jid
	Just domainJid = XMPP.parseJID jidStrDomain
	domainStr = textToString jidStrDomain
	server = XMPP.Server domainJid domainStr (PortNumber 5222)

main :: IO ()
main = do
	(rpcJidStr:rpcPassword:domain:envelopeTos) <- getArgs
	let Just rpcJid = XMPP.parseJID rpcJidStr

	let Just recipientJids = forM envelopeTos $ \envelopeTo ->
		(XMPP.parseJID =<<) $ fmap mailboxNode $ hush $ MIME.parse
			(MIME.mailbox MIME.defaultCharsets)
			(encodeUtf8 envelopeTo)

	input <- LByteString.getContents
	let Right email = MIME.parse messageOptionalMboxFrom input
	let messages = recipientJids <&> \recipientJid ->
		(emailToStanza domain email) {
			XMPP.messageTo = Just recipientJid
		}

	let messageIQs = messages <&> \message -> (XMPP.emptyIQ XMPP.IQSet) {
			XMPP.iqTo = XMPP.parseJID domain,
			XMPP.iqPayload = Just $ XMPP.stanzaToElement message
		}

	result <- runClient rpcJid rpcPassword $ do
		void $ XMPP.bindJID rpcJid
		(sendIQ, iqReceived) <- iqManager
		void $ forkXMPP $ runRouted $ defaultRoutes {
				iqResultRoute = iqReceived,
				iqErrorRoute = iqReceived
			}

		resultsSTM <- mapM sendIQ messageIQs
		result <- liftIO $ atomically (sequence resultsSTM)
		liftIO $ case sequence result of
			Nothing -> do
				putStrLn $ s"4.5.0 Delivery timed out"
				exitFailure
			Just iqs | all ((==XMPP.IQResult) . XMPP.iqType) iqs ->
				return ()
			Just iqs -> do
				putStrLn $ s"5.5.0 Delivery error"
				print $ map XMPP.iqPayload iqs
				exitFailure

	case result of
		Left e -> print e >> exitFailure
		_ -> return ()