~singpolyma/cheogram

52fbf7ddd5c8c9f629bbe16948c44c91a0f8c513 — Stephen Paul Weber 2 months ago 347574e
Nuke many log lines

We were always logging effectively in debug mode, but with the amount of active
use we have this was both a possibly privacy issue and make uselessly big log
files.  I haven't looked at most of this in ages, so take it all out until
something calls for it.  Things mostly work these days.
1 files changed, 0 insertions(+), 71 deletions(-)

M Main.hs
M Main.hs => Main.hs +0 -71
@@ 331,7 331,6 @@ toRouteOrFallback db componentJid bareFrom resourceFrom smsJid m fallback = do
	maybeRoute <- TC.runTCM $ TC.get db (T.unpack bareFrom ++ "\0direct-message-route")
	case (fmap fromString maybeRoute, parseJID $ escapeJid bareFrom ++ s"@" ++ formatJID componentJid ++ resourceSuffix) of
		(Just route, Just routeFrom) -> do
			log "TO DIRECT ROUTE" route
			return [mkStanzaRec $ m {
				messageFrom = Just routeFrom,
				messageTo = parseJID $ (fromMaybe mempty $ strNode <$> jidNode smsJid) ++ s"@" ++ route


@@ 347,7 346,6 @@ componentMessage db componentJid (m@Message { messageType = MessageError }) _ ba
		return [mkStanzaRec $ m { messageTo = Just smsJid, messageFrom = Just componentJid }]
componentMessage db componentJid m@(Message { messageTo = Just to }) existingRoom _ _ smsJid _
	| Just invite <- getMediatedInvitation m <|> getDirectInvitation m = do
		log "GOT INVITE" (invite, m)
		forM_ (invitePassword invite) $ \password ->
			tcPut db to (T.unpack (formatJID $ inviteMUC invite) <> "\0muc_roomsecret") (T.unpack password)
		existingInvite <- tcGetJID db to "invited"


@@ 367,7 365,6 @@ componentMessage db componentJid m@(Message { messageTo = Just to }) existingRoo
		else
			return []
componentMessage _ componentJid (m@Message { messageType = MessageGroupChat }) existingRoom bareFrom resourceFrom smsJid (Just body) = do
	log "MESSAGE FROM GROUP" (existingRoom, body)
	if fmap bareTxt existingRoom == Just bareFrom && (
	   existingRoom /= parseJID (bareFrom <> fromString "/" <> fromMaybe mempty resourceFrom) ||
	   not (fromString "CHEOGRAM%" `T.isPrefixOf` fromMaybe mempty (messageID m))) then


@@ 378,8 375,6 @@ componentMessage _ componentJid (m@Message { messageType = MessageGroupChat }) e
	where
	txt = mconcat [fromString "(", fromMaybe (fromString "nonick") resourceFrom, fromString ") ", body]
componentMessage db componentJid m@(Message { messageFrom = Just from, messageTo = Just to }) existingRoom bareFrom resourceFrom smsJid (Just body) = do
	log "WHISPER" (from, smsJid, strippedBody)

	ack <- case isNamed (fromString "{urn:xmpp:receipts}request") =<< messagePayloads m of
		(_:_) ->
			routeDiscoOrReply db componentJid from smsJid ("CHEOGRAM%query-then-send-ack%" ++ extra) Nothing


@@ 402,12 397,10 @@ handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer compon
	| join,
	  [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< payloads,
	  not $ null $ code "110" =<< isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x = do
		log "JOINED" (to, from)
		existingInvite <- tcGetJID db to "invited"
		when (existingInvite == parseJID bareMUC) $ do
			let Just invitedKey = tcKey to "invited"
			True <- TC.runTCM $ TC.out db invitedKey
			log "JOINED" (to, from, "INVITE CLEARED")
			return ()
		tcPutJID db to "joined" from
		let Just bookmarksKey = tcKey to "bookmarks"


@@ 421,7 414,6 @@ handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer compon

		case presences of
			[] -> do -- No one in the room, so we "created"
				log "JOINED" (to, from, "CREATED")
				uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
				let fullid = if (T.unpack resourceFrom `elem` map fst presences) then uuid else "CHEOGRAMCREATE%" <> uuid
				return [mkStanzaRec $ (emptyIQ IQGet) {


@@ 431,7 423,6 @@ handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer compon
					iqPayload = Just $ Element (fromString "{http://jabber.org/protocol/muc#owner}query") [] []
				}]
			(_:_) | isNothing (lookup (T.unpack resourceFrom) presences) -> do
				log "JOINED" (to, from, resourceFrom, presences, "YOU HAVE JOINED")
				fmap ((mkStanzaRec $ mkSMS componentJid smsJid $ mconcat [
						fromString "* You have joined ", bareMUC,
						fromString " as ", resourceFrom,


@@ 445,7 436,6 @@ handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer compon
	| not join,
	  [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< payloads,
	  (_:_) <- code "303" =<< isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x = do
		log "CHANGED NICK" (to, x)
		let mnick = attributeText (fromString "nick") =<<
			listToMaybe (isNamed (fromString "{http://jabber.org/protocol/muc#user}item") =<< elementChildren x)
		toList <$> forM mnick (\nick -> do


@@ 464,7 454,6 @@ handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer compon
		void $ forkIO $ threadDelay 5000000 >> atomically (writeTChan toRejoinManager $ ForceRejoin from to)
		return []
	| not join && existingRoom == Just from = do
		log "YOU HAVE LEFT" (to, existingRoom)
		let Just joinedKey = tcKey to "joined"
		True <- TC.runTCM $ TC.out db joinedKey
		atomically $ writeTChan toRoomPresences $ RecordPart to from


@@ 520,7 509,6 @@ verificationResponse =
data RegistrationCode = RegistrationCode { regCode :: Int, cheoJid :: Text, expires :: UTCTime } deriving (Show, Read)

registerVerification db componentJid to iq = do
	log "REGISTERVERIFIFCATION" (to, iq)
	code <- getStdRandom (randomR (123457::Int,987653))
	time <- getCurrentTime
	True <- TC.runTCM $ TC.put db ((maybe mempty T.unpack $ bareTxt <$> iqFrom iq) <> "\0registration_code") $ show $ RegistrationCode code (formatJID to) time


@@ 537,7 525,6 @@ registerVerification db componentJid to iq = do
handleVerificationCode db componentJid password iq = do
	time <- getCurrentTime
	codeAndTime <- fmap (readZ =<<) $ TC.runTCM $ TC.get db regKey
	log "HANDLEVERIFICATIONCODE" (password, iq, time, codeAndTime)
	case codeAndTime of
		Just (RegistrationCode { regCode = code, cheoJid = cheoJidT })
			| fmap expires codeAndTime > Just ((-300) `addUTCTime` time) ->


@@ 585,7 572,6 @@ handleVerificationCode db componentJid password iq = do
handleRegister db componentJid iq@(IQ { iqType = IQGet }) _ = do
	time <- getCurrentTime
	codeAndTime <- fmap (readZ =<<) $ TC.runTCM $ TC.get db ((maybe mempty T.unpack $ bareTxt <$> iqFrom iq) <> "\0registration_code")
	log "HANDLEREGISTER IQGet" (time, codeAndTime, iq)
	if fmap expires codeAndTime > Just ((-300) `addUTCTime` time) then
		return [mkStanzaRec $ iq {
			iqTo = iqFrom iq,


@@ 628,25 614,20 @@ handleRegister db componentJid iq@(IQ { iqType = IQGet }) _ = do
handleRegister db componentJid iq@(IQ { iqType = IQSet }) query
	| [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren query,
	  Just to <- ((`telToJid` formatJID componentJid) . T.filter isDigit) =<< getFormField form (fromString "phone") = do
		log "HANDLEREGISTER IQSet jabber:x:data phone" iq
		registerVerification db componentJid to iq
handleRegister db componentJid iq@(IQ { iqType = IQSet }) query
	| [phoneEl] <- isNamed (fromString "{jabber:iq:register}phone") =<< elementChildren query,
	  Just to <- (`telToJid` formatJID componentJid) $ T.filter isDigit $ mconcat (elementText phoneEl) = do
		log "HANDLEREGISTER IQSet jabber:iq:register phone" iq
		registerVerification db componentJid to iq
handleRegister db componentJid iq@(IQ { iqType = IQSet }) query
	| [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren query,
	  Just password <- getFormField form (fromString "password") = do
		log "HANDLEREGISTER IQSet jabber:x:data password" iq
		handleVerificationCode db componentJid password iq
handleRegister db componentJid iq@(IQ { iqType = IQSet, iqPayload = Just payload }) query
	| [passwordEl] <- isNamed (fromString "{jabber:iq:register}password") =<< elementChildren query = do
		log "HANDLEREGISTER IQSet jabber:iq:register password" iq
		handleVerificationCode db componentJid (mconcat $ elementText passwordEl) iq
handleRegister db componentJid iq@(IQ { iqType = IQSet }) query
	| [_] <- isNamed (fromString "{jabber:iq:register}remove") =<< elementChildren query = do
		log "HANDLEREGISTER IQSet jabber:iq:register remove" iq
		tel <- maybe mempty T.pack <$> TC.runTCM (TC.get db $ T.unpack (maybe mempty bareTxt $ iqFrom iq) <> "\0registered")
		forM_ (telToJid tel (formatJID componentJid) >>= \cheoJid -> tcKey cheoJid "registered") $ \regKey ->
			TC.runTCM $ TC.out db regKey


@@ 684,10 665,8 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedMessage (m@Message { messag
componentStanza _ _ _ _ _ _ _ _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< messagePayloads m,
	  not $ null $ code "104" =<< isNamed (fromString "{http://jabber.org/protocol/muc#user}status") =<< elementChildren x = do
		log "CODE104" (to, from)
		queryDisco from to
componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from})) = do
	log "RECEIVEDMESSAGE" m
	existingRoom <- tcGetJID db to "joined"
	componentMessage db componentJid m existingRoom (bareTxt from) resourceFrom smsJid $
		getBody "jabber:component:accept" m


@@ 712,10 691,8 @@ componentStanza db (Just smsJid) _ toRoomPresences toRejoinManager toJoinPartDeb
		presencePayloads = payloads
	})) | typ `elem` [PresenceAvailable, PresenceUnavailable] = do
		existingRoom <- tcGetJID db to "joined"
		log "JOIN PART ROOM" (from, to, typ, existingRoom, payloads)
		handleJoinPartRoom db toRoomPresences toRejoinManager toJoinPartDebouncer componentJid existingRoom from to smsJid payloads (typ == PresenceAvailable)
componentStanza _ _ _ _ _ _ _ _ (ReceivedPresence (Presence { presenceType = PresenceSubscribe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
	log "SUBSCRIBE GATEWAY" (from, to)
	return [
			mkStanzaRec $ (emptyPresence PresenceSubscribed) {
				presenceTo = Just from,


@@ 728,7 705,6 @@ componentStanza _ _ _ _ _ _ _ _ (ReceivedPresence (Presence { presenceType = Pre
			mkStanzaRec $ cheogramAvailable to from
		]
componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedPresence (Presence { presenceType = PresenceSubscribe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Just _ } })) = do
	log "SUBSCRIBE TEL" (from, to)
	stanzas <- routeDiscoOrReply db componentJid from smsJid "CHEOGRAM%query-then-send-presence" Nothing $ telAvailable to from []
	return $ [
			mkStanzaRec $ (emptyPresence PresenceSubscribed) {


@@ 742,7 718,6 @@ componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedPresence (Prese
		] ++ stanzas
componentStanza db Nothing _ _ _ _ _ componentJid (ReceivedPresence (Presence { presenceType = PresenceSubscribe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Just node } }))
	| Just multipleTo <- mapM localpartToURI (T.split (==',') $ strNode node) = do
	log "SUBSCRIBE GROUPTEXT PORCELEIN" (from, multipleTo)
	return $ [
			mkStanzaRec $ (emptyPresence PresenceSubscribed) {
				presenceTo = Just from,


@@ 755,14 730,11 @@ componentStanza db Nothing _ _ _ _ _ componentJid (ReceivedPresence (Presence { 
			mkStanzaRec $ telAvailable to from []
		]
componentStanza _ _ _ _ _ _ _ _ (ReceivedPresence (Presence { presenceType = PresenceProbe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
	log "RESPOND TO PROBES" (from, to)
	return [mkStanzaRec $ cheogramAvailable to from]
componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedPresence (Presence { presenceType = PresenceProbe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Just _ } })) = do
	log "RESPOND TO TEL PROBES" smsJid
	routeDiscoOrReply db componentJid from smsJid "CHEOGRAM%query-then-send-presence" Nothing $ telAvailable to from []
componentStanza db _ _ _ _ _ _ componentJid (ReceivedPresence (Presence { presenceType = PresenceProbe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Just node } }))
	| Just multipleTo <- mapM localpartToURI (T.split (==',') $ strNode node) = do
	log "RESPOND TO GROUPCHAT PORCELEIN PROBES" multipleTo
	return $ [mkStanzaRec $ telAvailable to from []]
componentStanza _ _ registrationJids _ _ _ processDirectMessageRouteConfig componentJid (ReceivedIQ (IQ { iqType = IQSet, iqTo = Just to, iqFrom = Just from, iqID = Just id, iqPayload = Just p }))
	| jidNode to == Nothing,


@@ 770,7 742,6 @@ componentStanza _ _ registrationJids _ _ _ processDirectMessageRouteConfig compo
	  [payload] <- isNamed (s"{http://jabber.org/protocol/commands}command") =<< elementChildren iqEl,
	  Just asFrom <- parseJID =<< attributeText (s"from") iqEl,
	  bareTxt from `elem` map bareTxt registrationJids = do
		log "COMMAND ON BEHALF OF" (from, asFrom, payload)
		replyIQ <- processDirectMessageRouteConfig $ (emptyIQ IQSet) {
				iqID = Just id,
				iqTo = Just to,


@@ 799,7 770,6 @@ componentStanza _ _ registrationJids _ _ _ processDirectMessageRouteConfig compo
componentStanza _ _ _ _ _ _ processDirectMessageRouteConfig componentJid (ReceivedIQ iq@(IQ { iqTo = Just to, iqPayload = payload }))
	| fmap strResource (jidResource to) == Just (s"CHEOGRAM%" ++ ConfigureDirectMessageRoute.nodeName),
	  Just (fwdBy, onBehalf, iqId) <- readZ . T.unpack =<< iqID iq = do
		log "FWD BY" (fwdBy, onBehalf, iqId, iq)
		replyIQ <- processDirectMessageRouteConfig (iq { iqID = iqId })
		let fromLocalpart = maybe mempty (\localpart -> localpart++s"@") (fmap strNode . jidNode =<< iqFrom replyIQ)
		return [mkStanzaRec $ replyIQ {


@@ 809,7 779,6 @@ componentStanza _ _ _ _ _ _ processDirectMessageRouteConfig componentJid (Receiv
componentStanza _ _ _ _ _ _ processDirectMessageRouteConfig componentJid (ReceivedIQ iq@(IQ { iqTo = Just to, iqPayload = payload }))
	| (jidNode to == Nothing && fmap elementName payload == Just (s"{http://jabber.org/protocol/commands}command") && (attributeText (s"node") =<< payload) == Just ConfigureDirectMessageRoute.nodeName) ||
	  fmap strResource (jidResource to) == Just (s"CHEOGRAM%" ++ ConfigureDirectMessageRoute.nodeName) = do
		log "PART OF COMMAND" iq
		replyIQ <- processDirectMessageRouteConfig iq
		let fromLocalpart = maybe mempty (\localpart -> localpart++s"@") (fmap strNode . jidNode =<< iqFrom replyIQ)
		return [mkStanzaRec $ replyIQ {


@@ 818,12 787,10 @@ componentStanza _ _ _ _ _ _ processDirectMessageRouteConfig componentJid (Receiv
componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
	| iqType iq `elem` [IQGet, IQSet],
	  [query] <- isNamed (fromString "{jabber:iq:register}query") p = do
		log "LOOKS LIKE REGISTRATION" iq
		return [mkStanzaRec $ iqNotImplemented iq]
componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
	| Nothing <- jidNode to,
	  [q] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO ON US" (from, to, p)
		return [mkStanzaRec $ (emptyIQ IQResult) {
			iqTo = Just from,
			iqFrom = Just to,


@@ 856,7 823,6 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQGet, iq
	| Nothing <- jidNode to,
	  [s"http://jabber.org/protocol/commands"] ==
	    mapMaybe (attributeText (s"node")) (isNamed (fromString "{http://jabber.org/protocol/disco#items}query") p) = do
		log "componentStanza QUERY FOR COMMAND LIST" to
		routeQueryOrReply db componentJid from componentJid ("CHEOGRAM%query-then-send-command-list%" ++ extra) queryCommandList (commandList componentJid id to from [])
	| Nothing <- jidNode to,
	  [_] <- isNamed (s"{vcard-temp}vCard") p =


@@ 876,7 842,6 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQGet, iq
componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = Just id, iqPayload = Just p }))
	| Just _ <- jidNode to,
	  [q] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO ON USER" (from, to, p)
		routeDiscoOrReply db componentJid from smsJid ("CHEOGRAM%query-then-send-disco-info%" ++ extra) (nodeAttribute q) $
			telDiscoInfo q id to from []
	| Just tel <- strNode <$> jidNode to,


@@ 902,7 867,6 @@ componentStanza db (Just smsJid) _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType
componentStanza _ _ _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQSet, iqFrom = Just from, iqTo = Just (to@JID {jidNode = Nothing}), iqID = id, iqPayload = Just p }))
	| [query] <- isNamed (fromString "{jabber:iq:gateway}query") p,
	  [prompt] <- isNamed (fromString "{jabber:iq:gateway}prompt") =<< elementChildren query = do
		log "jabber:iq:gateway submit" (from, to, p)
		case telToJid (T.filter isDigit $ mconcat $ elementText prompt) (formatJID componentJid) of
			Just jid ->
				return [mkStanzaRec $ (emptyIQ IQResult) {


@@ 928,7 892,6 @@ componentStanza _ _ _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQSet, 
				}]
componentStanza _ _ _ _ _ _ _ _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just (to@JID {jidNode = Nothing}), iqID = id, iqPayload = Just p }))
	| [_] <- isNamed (fromString "{jabber:iq:gateway}query") p = do
		log "jabber:iq:gateway query" (from, to, p)
		return [mkStanzaRec $ (emptyIQ IQResult) {
			iqTo = Just from,
			iqFrom = Just to,


@@ 955,7 918,6 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQErro
componentStanza _ _ _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to }))
	| (strNode <$> jidNode to) == Just (fromString "create"),
	  Just resource <- strResource <$> jidResource to = do
		log "create@ RESULT" (from, to, iq)
		case T.splitOn (fromString "|") resource of
			(cheoJidT:name:[]) | Just cheoJid <- parseJID cheoJidT, Just tel <- strNode <$> jidNode cheoJid ->
				createRoom componentJid [strDomain $ jidDomain from] cheoJid (name <> fromString "_" <> tel)


@@ 964,18 926,15 @@ componentStanza _ _ _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQResul
			_ -> return [] -- Invalid packet, ignore
componentStanza _ _ _ _ toRejoinManager _ _ _ (ReceivedIQ (iq@IQ { iqType = IQResult, iqID = Just id, iqFrom = Just from }))
	| fromString "CHEOGRAMPING%" `T.isPrefixOf` id = do
		log "PING RESULT" from
		atomically $ writeTChan toRejoinManager (PingReply from)
		return []
componentStanza _ _ _ _ toRejoinManager _ _ _ (ReceivedIQ (iq@IQ { iqType = IQError, iqID = Just id, iqFrom = Just from }))
	| fromString "CHEOGRAMPING%" `T.isPrefixOf` id = do
		log "PING ERROR RESULT" from
		atomically $ writeTChan toRejoinManager (PingError from)
		return []
componentStanza _ _ _ _ _ _ _ _ (ReceivedIQ (IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id, iqPayload = Just p }))
	| [query] <- isNamed (fromString "{http://jabber.org/protocol/muc#owner}query") p,
	  [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren query = do
		log "MUC DISCO RESULT" (from, to, p)
		uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
		let fullid = if fromString "CHEOGRAMCREATE%" `T.isPrefixOf` id then "CHEOGRAMCREATE%" <> uuid else uuid
		return [mkStanzaRec $ (emptyIQ IQSet) {


@@ 993,7 952,6 @@ componentStanza _ _ _ _ _ _ _ _ (ReceivedIQ (IQ { iqType = IQResult, iqFrom = Ju
		}]
componentStanza _ (Just smsJid) _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id }))
	| fromString "CHEOGRAMCREATE%" `T.isPrefixOf` id = do
		log "CHEOGRAMCREATE RESULT YOU HAVE CREATED" (from, to, iq)
		fmap (((mkStanzaRec $ mkSMS componentJid smsJid (mconcat [fromString "* You have created ", bareTxt from])):) . concat . toList) $
			forM (parseJID $ bareTxt to <> fromString "/create") $
				queryDisco from


@@ 1003,10 961,8 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ iq@(IQ { iqType = typ, i
	  Just (iqId, resource) <- readZ $ T.unpack $ unescapeJid idAndResource,
	  Just routeTo <- parseJID (unescapeJid (strNode toNode) ++ if T.null resource then mempty else s"/" ++ resource) =
		if typ == IQError then do
			log "ERROR FROM ROUTE, SEND DEFAULT COMMAND LIST" iq
			return [mkStanzaRec $ commandList componentJid iqId componentJid routeTo []]
		else do
			log "COMMANDS FROM ROUTE, MERGE WITH OURS AND SEND" iq
			let items = isNamed (s"{http://jabber.org/protocol/disco#items}item") =<< elementChildren p
			return [mkStanzaRec $ commandList componentJid iqId componentJid routeTo items]
componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQResult, iqTo = Just to@(JID { jidNode = Just toNode }), iqFrom = Just from, iqPayload = Just p }))


@@ 1018,10 974,8 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQResult,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) =
		let features = mapMaybe (attributeText (fromString "var")) $ isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query in
		if (s"urn:xmpp:receipts") `elem` features then do
			log "DISCO RESULT, DO NOT SEND ACK" (from, to, features)
			return []
		else do
			log "DISCO RESULT, NOW SEND ACK" (from, to, routeFrom, routeTo, features)
			return [mkStanzaRec $ deliveryReceipt messageId routeFrom routeTo]
	| Just idAndResource <- T.stripPrefix (s"CHEOGRAM%query-then-send-disco-info%") . strResource =<< jidResource to,
	  Just (iqID, resource) <- readZ $ T.unpack $ unescapeJid idAndResource,


@@ 1029,7 983,6 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQResult,
	  Just routeTo <- parseJID (unescapeJid (strNode toNode) ++ if T.null resource then mempty else s"/" ++ resource),
	  Just fromNode <- jidNode from,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) = do
		log "DISCO RESULT, NOW SEND INFO ONWARD" (from, to, routeFrom, routeTo)
		return [
				mkStanzaRec $ telDiscoInfo query iqID routeFrom routeTo $ mapMaybe (attributeText (fromString "var")) $
				isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query


@@ 1039,13 992,11 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQResult,
	  Just routeTo <- parseJID (unescapeJid (strNode toNode)),
	  Just fromNode <- jidNode from,
	  Just routeFrom <- parseJID (strNode fromNode ++ s"@" ++ formatJID componentJid) = do
		log "DISCO RESULT, NOW SEND PRESENCE" (from, to, routeFrom, routeTo)
		return [
				mkStanzaRec $ telAvailable routeFrom routeTo $ mapMaybe (attributeText (fromString "var")) $
				isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query
			]
	| [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO RESULT" (from, to, p)
		let vars = mapMaybe (attributeText (fromString "var")) $
			isNamed (fromString "{http://jabber.org/protocol/disco#info}feature") =<< elementChildren query
		let muc_membersonly = fromEnum $ fromString "muc_membersonly" `elem` vars


@@ 1058,7 1009,6 @@ componentStanza db _ _ _ _ _ _ componentJid (ReceivedIQ (IQ { iqType = IQResult,
			return []
componentStanza _ _ _ _ _ _ _ _ (ReceivedIQ (iq@IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqPayload = Just p }))
	| not $ null $ isNamed (fromString "{urn:xmpp:ping}ping") p = do
		log "urn:xmpp:ping" (from, to)
		return [mkStanzaRec $ iq {
			iqTo = Just from,
			iqFrom = Just to,


@@ 1070,13 1020,11 @@ componentStanza db maybeSmsJid _ _ _ _ _ componentJid (ReceivedIQ (iq@IQ { iqTyp
	maybeRoute <- TC.runTCM $ TC.get db (T.unpack (bareTxt from) ++ "\0direct-message-route")
	case (fmap fromString maybeRoute, parseJID $ escapeJid (bareTxt from) ++ s"@" ++ formatJID componentJid ++ resourceSuffix) of
		(Just route, Just routeFrom) -> do
			log "IQ ROUTE" route
			return [mkStanzaRec $ iq {
				iqFrom = Just routeFrom,
				iqTo = parseJID $ (maybe mempty (++s"@") $ strNode <$> (jidNode =<< maybeSmsJid)) ++ route
			}]
		_ | typ `elem` [IQGet, IQSet] -> do
			log "REPLY WITH IQ ERROR (no route)" iq
			return [mkStanzaRec $ iqNotImplemented iq]
		_ | typ == IQError, Just smsJid <- maybeSmsJid -> do
			log "IQ ERROR" iq


@@ 1095,7 1043,6 @@ participantJid payloads =
component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toComponent processDirectMessageRouteConfig componentJid registrationJids conferenceServers = do
	thread <- forkXMPP $ forever $ flip catchError (log "component EXCEPTION") $ do
		stanza <- liftIO $ atomically $ readTChan toComponent
		log "COMPONENT OUT" stanza

		case (stanzaFrom stanza, stanzaTo stanza) of
			(Just from, Just to)


@@ 1112,7 1059,6 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC

	flip catchError (\e -> liftIO (log "component part 2 EXCEPTION" e >> killThread thread)) $ forever $ do
		stanza <- getStanza
		log "COMPONENT  IN" stanza
		liftIO $ case (stanzaFrom $ receivedStanza stanza, stanzaTo $ receivedStanza stanza, mapToBackend backendHost =<< stanzaTo (receivedStanza stanza), fmap strNode . jidNode =<< stanzaTo (receivedStanza stanza), stanza) of
			(Just from, Just to, _, _, _)
				| strDomain (jidDomain from) == backendHost,


@@ 1147,7 1093,6 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
				Just multipleTo <- mapM localpartToURI (T.split (==',') $ fromMaybe mempty $ fmap strNode $ jidNode to),
				ReceivedMessage m <- stanza,
				Just backendJid <- parseJID backendHost ->
					log "TO MULTICAST PORCELEIN" to >>
					let m' = m { messagePayloads = messagePayloads m ++ [
						Element (s"{http://jabber.org/protocol/address}addresses") [] $ map (\oneto ->
							NodeElement $ Element (s"{http://jabber.org/protocol/address}address") [


@@ 1166,10 1111,8 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
					maybeRoute <- TC.runTCM $ TC.get db (T.unpack (unescapeJid localpart) ++ "\0direct-message-route")
					case (fmap fromString maybeRoute, parseJID (unescapeJid localpart ++ toResourceSuffix), mapToComponent from) of
						(Just route, Just routeTo, Just componentFrom) | route == strDomain (jidDomain from) -> do
							log "FROM DIRECT ROUTE" stanza
							sendToComponent $ mkStanzaRec $ receivedStanza $ receivedStanzaFromTo componentFrom routeTo stanza
						_ | Just jid <- (`telToJid` formatJID componentJid) =<< strNode <$> jidNode to -> do
							log "MESSAGE INVALID JID" stanza
							sendToComponent $ stanzaError stanza $
								Element (fromString "{jabber:component:accept}error")
								[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]


@@ 1181,7 1124,6 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
										[NodeContent $ ContentText $ fromString "JID must include country code: " <> formatJID jid]
								]
						  | otherwise -> do
							log "MESSAGE UNKNOWN JID" stanza
							sendToComponent $ stanzaError stanza $
								Element (fromString "{jabber:component:accept}error")
								[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]


@@ 1341,7 1283,6 @@ getMessage (ReceivedMessage m) = Just m
getMessage _ = Nothing

sendToRoom cheoJid room msg = do
	log "SEND TO ROOM" (cheoJid, room, msg)
	uuid <- (fmap.fmap) UUID.toString UUID.nextUUID
	return [mkStanzaRec $ (emptyMessage MessageGroupChat) {
		messageTo = parseJID $ bareTxt room,


@@ 1353,7 1294,6 @@ sendToRoom cheoJid room msg = do
leaveRoom :: TC.HDB -> JID -> String -> IO [StanzaRec]
leaveRoom db cheoJid reason = do
	existingRoom <- tcGetJID db cheoJid "joined"
	log "LEAVE ROOM" (existingRoom, cheoJid, reason)
	return $ (flip map) (toList existingRoom) $ \leaveRoom ->
		mkStanzaRec $ (emptyPresence PresenceUnavailable) {
			presenceTo = Just leaveRoom,


@@ 1365,7 1305,6 @@ joinRoom db cheoJid room =
	rejoinRoom db cheoJid room False

rejoinRoom db cheoJid room rejoin = do
	log "JOIN ROOM" (room, cheoJid)
	password <- maybe (return Nothing) (TC.runTCM . TC.get db) (tcKey cheoJid (T.unpack (bareTxt room) <> "\0muc_roomsecret"))
	let pwEl = maybe [] (\pw -> [
			NodeElement $ Element (fromString "{http://jabber.org/protocol/muc}password") [] [NodeContent $ ContentText $ fromString pw]


@@ 1382,7 1321,6 @@ rejoinRoom db cheoJid room rejoin = do
	}]

addMUCOwner room from jid = do
	log "ADD MUC OWNER" (room, from, jid)
	uuid <- (fmap.fmap) UUID.toString UUID.nextUUID
	return [mkStanzaRec $ (emptyIQ IQSet) {
		iqTo = Just room,


@@ 1413,7 1351,6 @@ mucShortMatch tel short muc =
	node = maybe mempty strNode (jidNode =<< parseJID muc)

sendInvite db to (Invite { inviteMUC = room, inviteFrom = from }) = do
	log "SEND INVITE" (room, to, from)
	membersonly <- maybe False toEnum <$> TC.runTCM (TC.get db (T.unpack (bareTxt room) <> "\0muc_membersonly"))
	-- Try to add everyone we invite as an owner also
	(++) <$> (if membersonly then addMUCOwner room from to else return []) <*>


@@ 1621,7 1558,6 @@ rejoinManager db sendToComponent componentJid toRoomPresences toRejoinManager =
			(\x -> foldM x state presences) $ \state (mucJid, cheoJid) ->
				case Map.lookup mucJid state of
					Nothing -> do
						log "PINGING" (mucJid, cheoJid)
						uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
						sendToComponent $ mkStanzaRec $ (emptyIQ IQGet) {
							iqTo = Just mucJid,


@@ 1631,7 1567,6 @@ rejoinManager db sendToComponent componentJid toRoomPresences toRejoinManager =
						}
						return $! Map.insert mucJid (PingSent cheoJid) state
					Just (PingSent _) -> do -- Timeout, rejoin
						log "PING TIMEOUT" (mucJid, cheoJid)
						atomically $ writeTChan toRejoinManager (ForceRejoin mucJid cheoJid)
						return state
					Just Rejoining -> -- Don't ping, we're working on it


@@ 1669,7 1604,6 @@ roomPresences db toRoomPresences =
			maybe (return Nothing) (TC.runTCM . TC.get db) (tcKey cheoJid (muc from <> "\0presence"))
		old_presences <- (fromMaybe [] . (readZ =<<)) <$>
			maybe (return Nothing) (TC.runTCM . TC.get db) (tcKey cheoJid (muc from <> "\0old_presence"))
		log "STARTREJOIN" (cheoJid, muc from, presences, old_presences)
		tcPut db cheoJid (muc from <> "\0old_presence")
			(show (presences <> old_presences :: [(String, Maybe String)]))
		forM_ (tcKey cheoJid (muc from <> "\0presence")) (TC.runTCM . TC.out db)


@@ 1678,7 1612,6 @@ roomPresences db toRoomPresences =
			maybe (return Nothing) (TC.runTCM . TC.get db) (tcKey cheoJid (muc from <> "\0presence"))
		old_presences <- (fromMaybe [] . (readZ =<<)) <$>
			maybe (return Nothing) (TC.runTCM . TC.get db) (tcKey cheoJid (muc from <> "\0old_presence"))
		log "GETROOMPRESENCES" (cheoJid, from, presences, old_presences)
		atomically $ putTMVar rtrn $ sort $ nubBy (equating fst) $ presences <> old_presences

	globalAndLocal cheoJid from f = do


@@ 1698,7 1631,6 @@ joinPartDebouncer db backendHost sendToComponent componentJid toRoomPresences to
	where
	next state = do
		msg <- atomically (readTChan toJoinPartDebouncer)
		log "DEBOUNCE JOIN/PART" (msg, state)
		go state msg >>= next

	recordJoinPart cheoJid from mjid join


@@ 1706,7 1638,6 @@ joinPartDebouncer db backendHost sendToComponent componentJid toRoomPresences to
		| otherwise = atomically $ writeTChan toRoomPresences $ RecordPart cheoJid from

	sendPart cheoJid from time = forM_ (mapToBackend backendHost cheoJid) $ \smsJid -> do
		log "DEBOUNCE PART, GONNA SEND" (smsJid, from, time)
		atomically $ writeTChan toRoomPresences $ RecordPart cheoJid from
		now <- getCurrentTime
		sendToComponent $ mkStanzaRec $ mkSMS componentJid smsJid $ mconcat [


@@ 1721,7 1652,6 @@ joinPartDebouncer db backendHost sendToComponent componentJid toRoomPresences to
		let nick = fromMaybe mempty (strResource <$> jidResource from)
		presences <- syncCall toRoomPresences $ GetRoomPresences cheoJid from
		now <- getCurrentTime
		log "DEBOUNCE JOIN, MAYBE GONNA SEND" (cheoJid, from, presences)
		when (isNothing $ lookup (T.unpack nick) presences) $ do
			atomically $ writeTChan toRoomPresences $ RecordJoin cheoJid from mjid
			sendToComponent $ mkStanzaRec $ mkSMS componentJid smsJid $ mconcat [


@@ 1796,7 1726,6 @@ main = do
					(parseJID . fromString =<<) <$> TC.runTCM (TC.get db (T.unpack (bareTxt userJid) ++ "\0direct-message-route"))
				)
				(\userJid mgatewayJid -> do
					log "SETTING DIRECT MESSAGE ROUTE" (userJid, mgatewayJid)
					case mgatewayJid of
						Just gatewayJid -> do
							maybeExistingRoute <- (parseJID . fromString =<<) <$> TC.runTCM (TC.get db (T.unpack (bareTxt userJid) ++ "\0direct-message-route"))