~singpolyma/cheogram

44cc6a6e6defd5004cf763807c2990df3860a23d — Stephen Paul Weber 8 years ago c03411b
Dedup invites
1 files changed, 19 insertions(+), 9 deletions(-)

M Main.hs
M Main.hs => Main.hs +19 -9
@@ 39,6 39,12 @@ mkSMS tel txt = (emptyMessage MessageChat) {
	messagePayloads = [Element (fromString "{jabber:client}body") [] [NodeContent $ ContentText txt]]
}

tcKey tel key = T.unpack tel <> "\0" <> key
tcGetJID db tel key = (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ tcKey tel key)
tcPutJID db tel key jid = do
	True <- TC.runTCM (TC.put db (tcKey tel key) (T.unpack $ formatJID jid))
	return ()

getBody ns = listToMaybe . fmap (mconcat . elementText) . (isNamed (Name (fromString "body") (Just $ fromString ns) Nothing) <=< messagePayloads)

data Invite = Invite {


@@ 111,6 117,8 @@ componentMessage _ toVitelity _ _ existingRoom bareFrom resourceFrom tel body =
componentStanza db toVitelity _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| Just tel <- strNode <$> jidNode to,
	  Just invite <- getMediatedInvitation m <|> getDirectInvitation m = do
		existingRoom <- tcGetJID db tel "joined"
		existingInvite <- tcGetJID db tel "invited"
		let txt = mconcat [
				fromString "* ",
				bareTxt (inviteFrom invite), -- TODO: or MUC nick


@@ 119,11 127,13 @@ componentStanza db toVitelity _ (ReceivedMessage (m@Message { messageTo = Just t
				fromString ". You can switch to this chat by sending\n\n/join ",
				formatJID (inviteMUC invite)
			]
		writeStanzaChan toVitelity $ mkSMS tel txt
		when (existingRoom /= Just (inviteMUC invite) && existingInvite /= Just (inviteMUC invite)) $ do
			tcPutJID db tel "invited" (inviteMUC invite)
			writeStanzaChan toVitelity $ mkSMS tel txt
componentStanza db toVitelity _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| Just tel <- strNode <$> jidNode to,
	  Just body <- getBody "jabber:component:accept" m = do
		existingRoom <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ T.unpack tel)
		existingRoom <- tcGetJID db tel "joined"
		componentMessage db toVitelity (messageType m) (fromMaybe mempty $ messageID m) existingRoom (bareTxt from) resourceFrom tel body
	where
	resourceFrom = strResource <$> jidResource from


@@ 132,17 142,16 @@ componentStanza db toVitelity _ (ReceivedPresence p@(Presence { presenceFrom = J
	  [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< presencePayloads p,
	  [status] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x,
	  (_:_) <- code110 status = do
		tcPutJID db tel "joined" from
		writeStanzaChan toVitelity $ mkSMS tel (mconcat [fromString "* You have joined ", bareMUC, fromString " as ", roomNick])
		True <- TC.runTCM (TC.put db (T.unpack tel) (T.unpack $ formatJID from))
		return ()
	where
	bareMUC = bareTxt from
	roomNick = fromMaybe mempty (strResource <$> jidResource from)
componentStanza db toVitelity _ (ReceivedPresence p@(Presence { presenceType = PresenceUnavailable, presenceFrom = Just from, presenceTo = Just to }))
	| Just tel <- strNode <$> jidNode to = do
		existingRoom <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ T.unpack tel)
		existingRoom <- tcGetJID db tel "joined"
		when (existingRoom == Just from) $ do
			True <- TC.runTCM $ TC.out db $ T.unpack tel
			True <- TC.runTCM $ TC.out db $ tcKey tel "joined"
			writeStanzaChan toVitelity $ mkSMS tel (fromString "* You have left " <> bareTxt from)
componentStanza _ _ toComponent (ReceivedIQ (IQ { iqType = typ, iqFrom = Just from, iqTo = to, iqID = id }))
	| typ `elem` [IQGet, IQSet] =


@@ 189,14 198,15 @@ viteltiy db toVitelity toComponent = do
		liftIO $ case (strNode <$> (jidNode =<< messageFrom =<< m), getBody "jabber:client" =<< m) of
			(Just tel, Just txt) -> case parseCommand txt tel of
					Just (Join room) -> do
						existingRoom <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ T.unpack tel)
						existingRoom <- tcGetJID db tel "joined"
						forM_ existingRoom $ \leaveRoom -> do
							writeStanzaChan toComponent $ (emptyPresence PresenceUnavailable) {
								presenceTo = Just leaveRoom,
								presenceFrom = parseJID $ tel <> fromString "@sms.singpolyma.net",
								presencePayloads = [Element (fromString "{jabber:component:accept}status") [] [NodeContent $ ContentText $ fromString "Joined a different room."]]
							}
							TC.runTCM $ TC.out db $ T.unpack tel
							True <- TC.runTCM $ TC.out db $ tcKey tel "joined"
							return ()

						writeStanzaChan toComponent $ (emptyPresence PresenceAvailable) {
							presenceTo = Just room,


@@ 206,7 216,7 @@ viteltiy db toVitelity toComponent = do
							]]
						}
					Just (Send msg) -> do
						existingRoom <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db $ T.unpack tel)
						existingRoom <- tcGetJID db tel "joined"
						case existingRoom of
							Just room -> do
								uuid <- (fmap.fmap) UUID.toString UUID.nextUUID