From 3113e7d6a8f62b3c7aa4f6b9ee5b931b2bf9887b Mon Sep 17 00:00:00 2001 From: Stephen Paul Weber Date: Mon, 9 Nov 2020 19:55:39 -0500 Subject: [PATCH] Start sending some statsd stats --- Main.hs | 18 ++++++++++++++---- cheogram.cabal | 1 + 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/Main.hs b/Main.hs index 2949a52..b85f15e 100644 --- a/Main.hs +++ b/Main.hs @@ -19,6 +19,8 @@ import System.Random (Random(randomR), getStdRandom) import System.Random.Shuffle (shuffleM) import Data.Digest.Pure.SHA (sha1, bytestringDigest) import System.IO.Unsafe (unsafePerformIO) +import Network.StatsD (openStatsD, StatsD) +import qualified Network.StatsD as StatsD import "monads-tf" Control.Monad.Error (catchError) -- ick import Data.XML.Types as XML (Element(..), Node(NodeContent, NodeElement), Name(Name), Content(ContentText), isNamed, hasAttributeText, elementText, elementChildren, attributeText, attributeContent, hasAttribute, nameNamespace) @@ -1059,10 +1061,13 @@ participantJid payloads = elementChildren =<< isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< payloads -component db redis backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toComponent processDirectMessageRouteConfig jingleHandler componentJid registrationJids conferenceServers = do +component db redis statsd backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toComponent processDirectMessageRouteConfig jingleHandler componentJid registrationJids conferenceServers = do thread <- forkXMPP $ forever $ flip catchError (log "component EXCEPTION") $ do stanza <- liftIO $ atomically $ readTChan toComponent + let tags = maybe "" (";domain=" ++) (textToString . strDomain . jidDomain <$> stanzaTo stanza) + liftIO $ StatsD.push statsd [StatsD.stat ["stanzas", "out" ++ tags] 1 "c" Nothing] + case (stanzaFrom stanza, stanzaTo stanza) of (Just from, Just to) | strDomain (jidDomain to) == backendHost, @@ -1078,6 +1083,8 @@ component db redis backendHost toRoomPresences toRejoinManager toJoinPartDebounc flip catchError (\e -> liftIO (log "component part 2 EXCEPTION" e >> killThread thread)) $ forever $ do stanza <- getStanza + let tags = maybe "" (";domain=" ++) (textToString . strDomain . jidDomain <$> stanzaFrom (receivedStanza stanza)) + liftIO $ StatsD.push statsd [StatsD.stat ["stanzas", "in" ++ tags] 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") -> @@ -1807,7 +1814,8 @@ data Config = Config { s5bAdvertise :: ServerConfig, jingleStore :: FilePath, jingleStoreURL :: Text, - redis :: Redis.ConnectInfo + redis :: Redis.ConnectInfo, + statsd :: ServerConfig } deriving (Dhall.Generic, Dhall.Interpret, Show) instance Dhall.Interpret JID where @@ -1855,7 +1863,7 @@ main = do mapM_ putStanza =<< registerToGateway componentJid gatewayJid (fromString did) (fromString password) liftIO $ threadDelay 1000000 [config] -> do - (Config componentJid (ServerConfig host port) secret backendHost rawdid registrationJid conferences s5bListenOn (ServerConfig s5bhost s5bport) jingleStore jingleStoreURL redisConnectInfo) <- Dhall.input Dhall.auto (fromString config) + (Config componentJid (ServerConfig host port) secret backendHost rawdid registrationJid conferences s5bListenOn (ServerConfig s5bhost s5bport) jingleStore jingleStoreURL redisConnectInfo (ServerConfig statsdHost statsdPort)) <- Dhall.input Dhall.auto (fromString config) log "" "Starting..." let Just did = normalizeTel rawdid db <- openTokyoCabinet "./db.tcdb" :: IO TC.HDB @@ -1865,6 +1873,8 @@ main = do toRoomPresences <- atomically newTChan toRejoinManager <- atomically newTChan + statsd <- openStatsD statsdHost (show statsdPort) ["cheogram"] + void $ forkIO $ joinPartDebouncer db backendHost (atomically . writeTChan sendToComponent) componentJid toRoomPresences toJoinPartDebouncer void $ forkIO $ roomPresences db toRoomPresences @@ -1934,5 +1944,5 @@ main = do (log "runComponent ENDED" <=< (runExceptT . syncIO)) $ runComponent (Server componentJid host (PortNumber port)) secret - (component db redis backendHost toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent processDirectMessageRouteConfig jingleHandler componentJid [registrationJid] conferences) + (component db redis statsd backendHost toRoomPresences toRejoinManager toJoinPartDebouncer sendToComponent processDirectMessageRouteConfig jingleHandler componentJid [registrationJid] conferences) _ -> log "ERROR" "Bad arguments" diff --git a/cheogram.cabal b/cheogram.cabal index aef6ee5..3e52d6f 100644 --- a/cheogram.cabal +++ b/cheogram.cabal @@ -41,6 +41,7 @@ executable cheogram HostAndPort, HTTP, http-types, + hstatsd, jingle, monad-loops, monads-tf, -- 2.45.2