~singpolyma/cheogram

30976fbf92c4b67f9c2827349cb822fef9f76f09 — Stephen Paul Weber 6 years ago 5a9f319
Replace startup join logic with constant pings

We might restart, the remote might restart, best way is to just
constantly check if we're still in the room.  On startup, re-check each
of our users and rejoin anyone who does not respond to ping.  Then keep
pinging.

Partial for #36
1 files changed, 94 insertions(+), 94 deletions(-)

M Main.hs
M Main.hs => Main.hs +94 -94
@@ 205,7 205,7 @@ componentMessage db toVitelity _ (Message { messageFrom = Just from }) existingR
	writeStanzaChan toVitelity $ mkSMS tel txt
componentMessage _ _ _ m _ _ _ _ _ = log "UNKNOWN MESSAGE" m

handleJoinPartRoom db toVitelity toRoomPresences toJoinPartDebouncer toComponent existingRoom from to tel payloads join
handleJoinPartRoom db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent existingRoom from to tel payloads join
	| 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


@@ 219,25 219,23 @@ handleJoinPartRoom db toVitelity toRoomPresences toJoinPartDebouncer toComponent
		bookmarks <- fmap (fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db (tcKey tel "bookmarks"))
		True <- TC.runTCM (TC.put db (tcKey tel "bookmarks") (show $ sort $ nub $ T.unpack bareMUC : bookmarks))

		startup <- fmap (maybe False (const True :: String -> Bool)) $ TC.runTCM $ TC.get db (T.unpack bareMUC <> "\0startup_tels")
		falsePresence <- fmap (fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db (T.unpack bareMUC <> "\0false_presence"))
		True <- TC.runTCM $ TC.put db (T.unpack (bareTxt from) <> "\0false_presence") (show $ sort $ nubBy (equating fst) $ filter ((/=T.unpack resourceFrom).fst) falsePresence) -- Presence is no longer false

		presences <- syncCall toRoomPresences $ GetRoomPresences tel from
		atomically $ writeTChan toRoomPresences $ RecordJoin tel from (Just to)

		atomically $ writeTChan toRejoinManager $ Joined from

		case presences of
			[] -> do -- No one in the room, so we "created"
				log "JOINED" (tel, from, "CREATED")
				uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
				let fullid = if (T.unpack resourceFrom `elem` map fst falsePresence) then uuid else "CHEOGRAMCREATE%" <> uuid
				let fullid = if (T.unpack resourceFrom `elem` map fst presences) then uuid else "CHEOGRAMCREATE%" <> uuid
				writeStanzaChan toComponent $ (emptyIQ IQGet) {
					iqTo = Just room,
					iqFrom = Just to,
					iqID = Just $ fromString fullid,
					iqPayload = Just $ Element (fromString "{http://jabber.org/protocol/muc#owner}query") [] []
				}
			(_:_) | isNothing (lookup (T.unpack resourceFrom) (presences <> falsePresence)) -> do
			(_:_) | isNothing (lookup (T.unpack resourceFrom) presences) -> do
				log "JOINED" (tel, from, "YOU HAVE JOINED")
				writeStanzaChan toVitelity $ mkSMS tel $ mconcat [
						fromString "* You have joined ", bareMUC,


@@ 460,12 458,12 @@ handleRegister _ _ toComponent _ iq@(IQ { iqType = typ }) _
		}
handleRegister _ _ _ _ _ iq = log "HANDLEREGISTER UNKNOWN" iq

componentStanza _ _ _ _ toComponent _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
componentStanza _ _ _ _ _ toComponent _ (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 toComponent from to
componentStanza db toVitelity _ _ toComponent componentHost (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
componentStanza db toVitelity _ _ _ toComponent componentHost (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
	| Just tel <- strNode <$> jidNode to,
	  T.length tel == 11 && fromString "1" `T.isPrefixOf` tel = do
		log "RECEIVEDMESSAGE" m


@@ 504,14 502,14 @@ componentStanza db toVitelity _ _ toComponent componentHost (ReceivedMessage (m@
		}
	where
	resourceFrom = strResource <$> jidResource from
componentStanza _ toVitelity _ _ _ _ (ReceivedPresence p@(Presence { presenceType = PresenceError, presenceFrom = Just from, presenceTo = Just to }))
componentStanza _ toVitelity _ _ _ _ _ (ReceivedPresence p@(Presence { presenceType = PresenceError, presenceFrom = Just from, presenceTo = Just to }))
	| Just tel <- strNode <$> jidNode to = do
		log "FAILED TO JOIN" p
		let errorText = maybe mempty (mconcat . (fromString "\n":) . elementText) $ listToMaybe $
			isNamed (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}text") =<<
			elementChildren =<< isNamed (fromString "{jabber:component:accept}error") =<< presencePayloads p
		writeStanzaChan toVitelity $ mkSMS tel (fromString "* Failed to join " <> bareTxt from <> errorText)
componentStanza db toVitelity toRoomPresences toJoinPartDebouncer toComponent _ (ReceivedPresence (Presence {
componentStanza db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent _ (ReceivedPresence (Presence {
		presenceType = typ,
		presenceFrom = Just from,
		presenceTo = Just to@(JID { jidNode = Just toNode }),


@@ 519,8 517,8 @@ componentStanza db toVitelity toRoomPresences toJoinPartDebouncer toComponent _ 
	})) | typ `elem` [PresenceAvailable, PresenceUnavailable] = do
		existingRoom <- tcGetJID db (strNode toNode) "joined"
		log "JOIN PART ROOM" (from, to, typ, existingRoom, payloads)
		handleJoinPartRoom db toVitelity toRoomPresences toJoinPartDebouncer toComponent existingRoom from to (strNode toNode) payloads (typ == PresenceAvailable)
componentStanza _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType = PresenceSubscribe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
		handleJoinPartRoom db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent existingRoom from to (strNode toNode) payloads (typ == PresenceAvailable)
componentStanza _ _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType = PresenceSubscribe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
	log "APPROVE SUBSCRIPTION" (from, to)
	writeStanzaChan toComponent $ (emptyPresence PresenceSubscribed) {
		presenceTo = Just from,


@@ 531,7 529,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType
		presenceTo = Just from,
		presenceFrom = Just to
	}
componentStanza _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType = PresenceProbe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
componentStanza _ _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType = PresenceProbe, presenceFrom = Just from, presenceTo = Just to@JID { jidNode = Nothing } })) = do
	log "RESPOND TO PROBES" (from, to)
	writeStanzaChan toComponent $ (emptyPresence PresenceAvailable) {
		presenceTo = Just from,


@@ 545,12 543,12 @@ componentStanza _ _ _ _ toComponent _ (ReceivedPresence (Presence { presenceType
			] []
		]
	}
componentStanza db toVitelity _ _ toComponent componentHost (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
componentStanza db toVitelity _ _ _ toComponent componentHost (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
		handleRegister db toVitelity toComponent componentHost iq query
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
	| Nothing <- jidNode to,
	  [_] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO ON US" (from, to, p)


@@ 573,7 571,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom =
					] []
				]
		}
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
	| Just _ <- jidNode to,
	  [_] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO ON USER" (from, to, p)


@@ 594,7 592,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom =
					] []
				]
		}
componentStanza _ _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQSet, iqFrom = Just from, iqTo = Just (to@JID {jidNode = Nothing}), iqID = id, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent componentHost (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)


@@ 621,7 619,7 @@ componentStanza _ _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = 
								[NodeContent $ ContentText $ fromString "Only US/Canada telephone numbers accepted"]
						]
				}
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just (to@JID {jidNode = Nothing}), iqID = id, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent _ (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)
		writeStanzaChan toComponent $ (emptyIQ IQResult) {


@@ 634,45 632,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom =
					NodeElement $ Element (fromString "{jabber:iq:gateway}prompt") [ ] [NodeContent $ ContentText $ fromString "Phone Number"]
				]
		}
componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id }))
	| fromString "CHEOGRAMSTARTUP%" `T.isPrefixOf` id = do
		log "CHEOGRAMSTARTUP RESULT" (from, to, items, iq)
		-- Room exists and has people in it
		presence <- fmap (fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db ("presence\0" <> T.unpack (bareTxt from)))
		-- Keep any JID associations we already know about, items is only nicks
		let presence' = map (\nick -> (nick, join $ lookup nick presence)) items
		True <- TC.runTCM $ TC.put db ("presence\0" <> T.unpack (bareTxt from)) (show $ sort $ nubBy (equating fst) presence')

		-- Extract tels from who we thought was in the room
		let tels = mapMaybe (\(nick,jid) -> ((,)nick) <$> (T.stripSuffix jidSuffix =<< jid)) presence
		let rejoinNicks = map fst tels \\ items
		let falsePresence = filter (\(nick, _) -> nick `elem` rejoinNicks) tels
		True <- TC.runTCM $ TC.put db (T.unpack (bareTxt from) <> "\0false_presence") (show $ sort falsePresence)
		mapM_ (\(nick,tel) -> forM_ (room nick) (joinRoom db toComponent componentHost tel)) falsePresence
	where
	jidSuffix = fromString $ "@" <> componentHost
	room nick = parseJID $ bareTxt from <> fromString "/" <> nick
	items = map (fromMaybe mempty . attributeText (fromString "name")) $
		isNamed (fromString "{http://jabber.org/protocol/disco#items}item") =<<
		elementChildren =<<
		isNamed (fromString "{http://jabber.org/protocol/disco#items}query") =<<
		toList (iqPayload iq)
componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQError, iqFrom = Just from, iqTo = Just to, iqID = Just id }))
	| fromString "CHEOGRAMSTARTUP%" `T.isPrefixOf` id = do
		log "CHEOGRAMSTARTUP ERROR" (from, to, iq)
		-- We must assume the room has been destroyed, though maybe it's just blocking our queries
		presence <- fmap (fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db ("presence\0" <> T.unpack (bareTxt from)))
		TC.runTCM $ TC.out db ("presence\0" <> T.unpack (bareTxt from))
		let tels = mapMaybe (\(nick,jid) -> ((,)nick) <$> (T.stripSuffix (fromString $ "@" <> componentHost) =<< jid)) presence
		case tels of
			[] -> return () -- wut?
			((nick,tel):xs) -> do
				-- startup_tels is who to make join once room is created.  false_presence is who thinks they're in the room already
				True <- TC.runTCM $ TC.put db (T.unpack (bareTxt from) <> "\0startup_tels") (show xs)
				True <- TC.runTCM $ TC.put db (T.unpack (bareTxt from) <> "\0false_presence") (show $ sort $ (nick,tel):xs)
				leaveRoom db toComponent componentHost tel "Service reset" -- in case we are in and can't tell?
				forM_ (parseJID $ bareTxt from <> fromString "/" <> nick) $ joinRoom db toComponent componentHost tel
componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQError, iqFrom = Just from, iqTo = Just to }))
componentStanza db _ _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQError, iqFrom = Just from, iqTo = Just to }))
	| (strNode <$> jidNode to) == Just (fromString "create"),
	  Just resource <- strResource <$> jidResource to = do
		log "create@ ERROR" (from, to, iq)


@@ 683,7 643,7 @@ componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType =
				leaveRoom db toComponent componentHost tel "Joined a different room."
				joinRoom db toComponent componentHost tel room
			_ -> return () -- Invalid packet, ignore
componentStanza _ _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to }))
componentStanza _ _ _ _ _ toComponent componentHost (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)


@@ 691,11 651,19 @@ componentStanza _ _ _ _ toComponent componentHost (ReceivedIQ (iq@IQ { iqType = 
			(tel:name:[]) -> void $ createRoom toComponent componentHost [T.unpack $ strDomain $ jidDomain from] tel (name <> "_" <> tel)
			(tel:name:servers) -> void $ createRoom toComponent componentHost servers tel name
			_ -> return () -- Invalid packet, ignore
componentStanza _ toVitelity _ _ _ _ (ReceivedIQ (iq@IQ { iqType = IQError, iqFrom = Just from, iqTo = Just to }))
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)
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)
componentStanza _ toVitelity _ _ _ _ _ (ReceivedIQ (iq@IQ { iqType = IQError, iqFrom = Just from, iqTo = Just to }))
	| Just tel <- strNode <$> jidNode to = do
		log "IQ ERROR" iq
		writeStanzaChan toVitelity $ mkSMS tel (fromString "Error while querying or configuring " <> formatJID from)
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent _ (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 "DISCO RESULT" (from, to, p)


@@ 714,14 682,14 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQResult, iqFro
				form { elementAttributes = [(fromString "{jabber:x:data}type", [ContentText $ fromString "submit"])] }
			]
		}
componentStanza _ toVitelity _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id }))
componentStanza _ toVitelity _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = IQResult, iqFrom = Just from, iqTo = Just to, iqID = Just id }))
	| Just tel <- strNode <$> jidNode to,
	  fromString "CHEOGRAMCREATE%" `T.isPrefixOf` id = do
		log "CHEOGRAMCREATE RESULT YOU HAVE CREATED" (from, to, iq)
		writeStanzaChan toVitelity $ mkSMS tel (mconcat [fromString "* You have created ", bareTxt from])
		forM_ (parseJID $ bareTxt to <> fromString "/create") $
			queryDisco toComponent from
componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (IQ { iqType = IQResult, iqTo = Just to, iqFrom = Just from, iqPayload = Just p }))
componentStanza db _ _ _ _ toComponent componentHost (ReceivedIQ (IQ { iqType = IQResult, iqTo = Just to, iqFrom = Just from, iqPayload = Just p }))
	| Just tel <- strNode <$> jidNode to,
	  [query] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p = do
		log "DISCO RESULT" (from, to, p)


@@ 732,8 700,7 @@ componentStanza db _ _ _ toComponent componentHost (ReceivedIQ (IQ { iqType = IQ
		when (fmap strResource (jidResource to) == Just (fromString "create")) $ do
			regJid <- tcGetJID db tel "registered"
			forM_ regJid $ \jid -> forM_ (parseJID $ bareTxt to) $ \to -> sendInvite db toComponent jid (Invite from to Nothing Nothing)
		joinStartupTels db toComponent componentHost from to
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqPayload = Just p }))
componentStanza _ _ _ _ _ toComponent _ (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)
		writeStanzaChan toComponent $ iq {


@@ 742,7 709,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = IQGet, iqFro
			iqType = IQResult,
			iqPayload = Nothing
		}
componentStanza _ _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = typ }))
componentStanza _ _ _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = typ }))
	| typ `elem` [IQGet, IQSet] = do
		log "REPLY WITH IQ ERROR" iq
		writeStanzaChan toComponent $ iq {


@@ 753,16 720,7 @@ componentStanza _ _ _ _ toComponent _ (ReceivedIQ (iq@IQ { iqType = typ }))
				[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]
				[NodeElement $ Element (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}feature-not-implemented") [] []]
		}
componentStanza _ _ _ _ _ _ s = log "UNKNOWN STANZA" s

joinStartupTels db toComponent componentHost muc hopefulOwner = do
	muc_membersonly <- maybe False toEnum <$> TC.runTCM (TC.get db (T.unpack (bareTxt muc) <> "\0muc_membersonly"))
	startup <- fmap (fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db (T.unpack (bareTxt muc) <> "\0startup_tels"))
	_ <- TC.runTCM $ TC.out db $ (T.unpack (bareTxt muc) <> "\0startup_tels")
	forM_ startup $ \(nick, tel) -> do
		when muc_membersonly $ forM_ (telToJid tel (fromString componentHost)) $
			addMUCOwner toComponent muc hopefulOwner
		forM_ (parseJID $ bareTxt muc <> fromString "/" <> nick) $ joinRoom db toComponent componentHost tel
componentStanza _ _ _ _ _ _ _ s = log "UNKNOWN STANZA" s

participantJid payloads =
	listToMaybe $ mapMaybe (parseJID <=< attributeText (fromString "jid")) $


@@ 770,7 728,7 @@ participantJid payloads =
	elementChildren =<<
	isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< payloads

component db toVitelity toRoomPresences toJoinPartDebouncer toComponent componentHost = do
component db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent componentHost = do
	thread <- forkXMPP $ forever $ flip catchError (log "component EXCEPTION") $ do
		stanza <- liftIO $ atomically $ readTChan toComponent
		log "COMPONENT OUT" stanza


@@ 779,7 737,7 @@ component db toVitelity toRoomPresences toJoinPartDebouncer toComponent componen
	flip catchError (\e -> liftIO (log "component part 2 EXCEPTION" e >> killThread thread)) $ forever $ do
		s <- getStanza
		log "COMPONENT  IN" s
		liftIO $ componentStanza db toVitelity toRoomPresences toJoinPartDebouncer toComponent componentHost s
		liftIO $ componentStanza db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent componentHost s

telToVitelity tel
	| not $ all isDigit $ T.unpack tel = Nothing


@@ 1103,6 1061,60 @@ syncCall chan req = do
	atomically $ writeTChan chan (req var)
	atomically $ takeTMVar var

data RejoinManagerCommand =
	CheckPings      |
	PingReply   JID |
	PingError   JID |
	Joined      JID |
	ForceRejoin JID Text

data RejoinManagerState = PingSent Text | Rejoining

rejoinManager db toComponent componentHost toRejoinManager =
	next mempty
	where
	mkMucJid muc nick = parseJID $ bareTxt muc <> fromString "/" <> nick
	ourJids muc (x,y) = (,) <$> mkMucJid muc x <*> (T.stripSuffix (fromString $ "@" <> componentHost) =<< y)

	next state = atomically (readTChan toRejoinManager) >>= go state

	go state (PingReply mucJid) =
		next $! Map.delete mucJid state
	go state (PingError mucJid) = do
		forM_ (Map.lookup mucJid state) $ \x -> case x of
			PingSent tel -> atomically $ writeTChan toRejoinManager (ForceRejoin mucJid tel)
			_ -> return ()
		next state
	go state (Joined mucJid) =
		next $! Map.delete mucJid state
	go state (ForceRejoin mucJid tel) = do
		joinRoom db toComponent componentHost tel mucJid
		next $! Map.insert mucJid Rejoining state
	go state CheckPings = do
		presenceKeys <- TC.runTCM $ TC.fwmkeys db "presence\0" maxBound
		(next =<<) $! (\x -> foldM x state (presenceKeys :: [String])) $ \state pkey -> do
			let Just muc = parseJID =<< T.stripPrefix (fromString "presence\0") (T.pack pkey)
			putStrLn $ fromString "Checking (ping?) participants in " <> formatJID muc <> fromString "..."
			presences <- fmap (mapMaybe (ourJids muc) . fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db pkey)
			(\x -> foldM x state presences) $ \state (mucJid, tel) ->
				case Map.lookup mucJid state of
					Nothing -> do
						log "PINGING" (mucJid, tel)
						uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
						writeStanzaChan toComponent $ (emptyIQ IQGet) {
							iqTo = Just mucJid,
							iqFrom = parseJID $ tel <> T.pack ("@" <> componentHost),
							iqID = Just $ fromString $ "CHEOGRAMPING%" <> uuid,
							iqPayload = Just $ Element (fromString "{urn:xmpp:ping}ping") [] []
						}
						return $! Map.insert mucJid (PingSent tel) state
					Just (PingSent _) -> do -- Timeout, rejoin
						log "PING TIMEOUT" (mucJid, tel)
						joinRoom db toComponent componentHost tel mucJid
						return $! Map.insert mucJid Rejoining state
					Just Rejoining -> -- Don't ping, we're working on it
						return state

-- tel, from (bare is MUC, resource is nick), Maybe participantJID
data RoomPresences =
	RecordJoin Text JID (Maybe JID) |


@@ 1199,29 1211,17 @@ main = do
	toVitelity <- atomically newTChan
	toComponent <- atomically newTChan
	toRoomPresences <- atomically newTChan
	toRejoinManager <- atomically newTChan

	void $ forkIO $ forever $ threadDelay 1500000 >> atomically (writeTChan chunks TimerExpire)
	void $ forkIO $ multipartStitcher db chunks toVitelity toComponent name conferences
	void $ forkIO $ joinPartDebouncer toVitelity toRoomPresences toJoinPartDebouncer
	void $ forkIO $ roomPresences db toRoomPresences

	void $ forkIO $ forever $ log "runComponent ENDED" =<< (runEitherT . syncIO) (runComponent (Server (fromString name) host (PortNumber $ fromIntegral (read port :: Int))) (fromString secret) (component db toVitelity toRoomPresences toJoinPartDebouncer toComponent name))
	void $ forkIO $ forever $ atomically (writeTChan toRejoinManager CheckPings) >> threadDelay 120000000
	void $ forkIO $ rejoinManager db toComponent name toRejoinManager

	oldPresence <- TC.runTCM $ TC.fwmkeys db "presence\0" maxBound
	forM_ (oldPresence :: [String]) $ \pkey -> do
		let Just muc = parseJID =<< T.stripPrefix (fromString "presence\0") (T.pack pkey)
		putStrLn $ fromString "Checking participants in " <> formatJID muc <> fromString "..."
		presence <- fmap (mapMaybe (snd :: (Text, Maybe Text) -> Maybe Text) . fromMaybe [] . (readZ =<<)) (TC.runTCM $ TC.get db pkey)
		case filter ((fromString $ "@" <> name) `T.isSuffixOf`) presence of
			[] -> return () -- wut?
			(x:_) -> do
				uuid <- fromMaybe "UUIDFAIL" <$> (fmap.fmap) (fromString . UUID.toString) UUID.nextUUID
				writeStanzaChan toComponent $ (emptyIQ IQGet) {
					iqTo = Just muc,
					iqFrom = parseJID x,
					iqID = Just $ fromString $ "CHEOGRAMSTARTUP%" <> uuid,
					iqPayload = Just $ Element (fromString "{http://jabber.org/protocol/disco#items}query") [] []
				}
	void $ forkIO $ forever $ log "runComponent ENDED" =<< (runEitherT . syncIO) (runComponent (Server (fromString name) host (PortNumber $ fromIntegral (read port :: Int))) (fromString secret) (component db toVitelity toRoomPresences toRejoinManager toJoinPartDebouncer toComponent name))

	let Just vitelityParsedJid = parseJID $ fromString vitelityJid
	forever $ runClient (Server (fromString "s.ms") "s.ms" (PortNumber 5222)) vitelityParsedJid (fromMaybe mempty $ strNode <$> jidNode vitelityParsedJid) (fromString vitelityPassword) $ do