~singpolyma/cheogram

5c7417175286da8f0aff4c7244f8ea65ef40165b — Osakpolor Obaseki 12 days ago 1bbe843
Add stats counter for cmd list fetch
1 files changed, 29 insertions(+), 4 deletions(-)

M Main.hs
M Main.hs => Main.hs +29 -4
@@ 735,6 735,7 @@ handleRegister _ _ iq _ = do

data ComponentContext = ComponentContext {
	db :: DB.DB,
	pushStatsd :: [StatsD.Stat] -> IO (),
	smsJid :: Maybe JID,
	registrationJids :: [JID],
	adhocBotMessage :: Message -> STM (),


@@ 1016,7 1017,7 @@ componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ iq@(IQ { iqF
	| iqType iq `elem` [IQGet, IQSet],
	  [query] <- isNamed (fromString "{jabber:iq:register}query") p = do
		handleRegister db componentJid iq query
componentStanza (ComponentContext { db, componentJid, maybeAvatar, sendIQ }) (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
componentStanza (ComponentContext { db, pushStatsd, componentJid, maybeAvatar, sendIQ }) (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
		payload <- cheogramDiscoInfo db componentJid sendIQ from (Just q)


@@ 1029,6 1030,9 @@ componentStanza (ComponentContext { db, componentJid, maybeAvatar, sendIQ }) (Re
	| Nothing <- jidNode to,
	  [s"http://jabber.org/protocol/commands"] ==
	    mapMaybe (attributeText (s"node")) (isNamed (fromString "{http://jabber.org/protocol/disco#items}query") p) = do

		pushStatsd [StatsD.stat ["cmd-list", "fetch"] 1 "c" Nothing]

		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 =


@@ 1307,11 1311,32 @@ cacheOOB magic pushStatsd jingleStore jingleStoreURL m@(XMPP.Message { XMPP.mess
	(body, noOobsNoBody) = partition (\el -> XML.elementName el == bodyName) noOobs
	(oobs, noOobs) = partition (\el -> XML.elementName el == oobName) payloads

component :: DB.DB
                     -> Redis.Connection
                     -> ([StatsD.Stat] -> UIO ())
                     -> Text
                     -> Text
                     -> Maybe Avatar
                     -> (Message -> UIO Message)
                     -> (IQ -> UIO (STM (Maybe IQ)))
                     -> (IQ -> XMPP ())
                     -> (Message -> STM ())
                     -> TChan RoomPresences
                     -> TChan RejoinManagerCommand
                     -> TChan JoinPartDebounce
                     -> TChan StanzaRec
                     -> TChan ReceivedStanza
                     -> (IQ -> IO (Maybe IQ))
                     -> (IQ -> XMPP ())
                     -> JID
                     -> [JID]
                     -> [Text]
                     -> XMPP ()
component db redis pushStatsd backendHost did maybeAvatar cacheOOB sendIQ iqReceiver adhocBotMessage toRoomPresences toRejoinManager toJoinPartDebouncer toComponent toStanzaProcessor processDirectMessageRouteConfig jingleHandler componentJid registrationJids conferenceServers = do
	sendThread <- forkXMPP $ forever $ flip catchError (log "component EXCEPTION") $ do
		stanza <- liftIO $ hasLocked "read toComponent" $ atomically $ readTChan toComponent

		pushStatsd [StatsD.stat ["stanzas", "out"] 1 "c" Nothing]
		UIO.lift $ pushStatsd [StatsD.stat ["stanzas", "out"] 1 "c" Nothing]
		putStanza =<< (liftIO . ensureId) stanza

	recvThread <- forkXMPP $ forever $ flip catchError (\e -> do


@@ 1325,7 1350,7 @@ component db redis pushStatsd backendHost did maybeAvatar cacheOOB sendIQ iqRece

	flip catchError (\e -> liftIO (log "component part 2 EXCEPTION" e >> killThread sendThread >> killThread recvThread)) $ forever $ do
		stanza <- liftIO $ hasLocked "read toStanzaProcessor" $ atomicUIO $ readTChan toStanzaProcessor
		pushStatsd [StatsD.stat ["stanzas", "in"] 1 "c" Nothing]
		UIO.lift $ pushStatsd [StatsD.stat ["stanzas", "in"] 1 "c" Nothing]
		liftIO $ forkIO $ case stanza of
			(ReceivedPresence p@(Presence { presenceType = PresenceAvailable, presenceFrom = Just from, presenceTo = Just to }))
				| Just returnFrom <- parseJID (bareTxt to ++ s"/capsQuery") ->


@@ 1500,7 1525,7 @@ component db redis pushStatsd backendHost did maybeAvatar cacheOOB sendIQ iqRece
				  (nameNamespace $ elementName p) `elem` [Just (s"urn:xmpp:jingle:1"), Just (s"http://jabber.org/protocol/ibb")] -> do
					jingleHandler iq
				| otherwise -> liftIO $
					mapM_ sendToComponent =<< componentStanza (ComponentContext db backendTo registrationJids adhocBotMessage cacheOOB toRoomPresences toRejoinManager toJoinPartDebouncer processDirectMessageRouteConfig componentJid sendIQ maybeAvatar) stanza
					mapM_ sendToComponent =<< componentStanza (ComponentContext db (UIO.lift . pushStatsd) backendTo registrationJids adhocBotMessage cacheOOB toRoomPresences toRejoinManager toJoinPartDebouncer processDirectMessageRouteConfig componentJid sendIQ maybeAvatar) stanza
	where
	mapToComponent = mapToBackend (formatJID componentJid)
	sendToComponent = hasLocked "sendToComponent" . atomically . writeTChan toComponent