module Session where
import Prelude ()
import BasicPrelude
import qualified Database.SQLite.Simple as DB
import qualified Data.XML.Types as XML
import qualified Network.Protocol.XMPP as XMPP
import qualified Config
import Util
mkSession :: (MonadIO m) =>
Config.Config
-> XMPP.PresenceType
-> Maybe XMPP.JID
-> XMPP.JID
-> m ()
mkSession config typ source target
| typ == XMPP.PresenceUnavailable =
liftIO $ DB.execute (Config.db config)
(s"DELETE FROM sessions WHERE source_muc=? AND source_nick=? AND target_muc=? AND target_nick=?")
(sourceMuc, sourceNick, targetMuc, targetNick)
| otherwise =
liftIO $ DB.execute (Config.db config)
(s"INSERT INTO sessions VALUES (?,?,?,?,?)")
(sourceMuc, sourceNick, targetMuc, targetNick, Config.dbVersion config)
where
sourceMuc = bareTxt <$> source
sourceNick = XMPP.strResource <$> (XMPP.jidResource =<< source)
targetMuc = bareTxt target
targetNick = XMPP.strResource <$> XMPP.jidResource target
maybeAddNick :: XMPP.JID -> Text -> XMPP.JID
maybeAddNick jid@XMPP.JID { XMPP.jidResource = Just _ } _ = jid
maybeAddNick muc nick = jid
where
Just jid = XMPP.parseJID $ bareTxt muc ++ s"/" ++ nick
sendPresence :: Config.Config -> XMPP.Presence -> XMPP.JID -> XMPP.XMPP ()
sendPresence config presence@XMPP.Presence {
XMPP.presenceFrom = Just from@XMPP.JID {
XMPP.jidResource = Just fromResource
},
XMPP.presenceType = typ,
XMPP.presencePayloads = payloads
} targetMuc = do
mkSession config typ (Just from) target
XMPP.putStanza $ presence {
XMPP.presenceFrom = Just (proxyJid config from),
XMPP.presenceTo = Just target,
XMPP.presencePayloads = map (\payload ->
case XML.isNamed (s"{http://jabber.org/protocol/muc#user}x") payload of
[_] -> mucJoinX
_ -> payload
) payloads
}
where
target = maybeAddNick targetMuc (fromNick ++ s"[x]")
fromNick = XMPP.strResource fromResource
sendPresence _ _ _ = return ()