1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
semantic/src/GitmonClient.hs

74 lines
2.2 KiB
Haskell
Raw Normal View History

2017-02-22 22:10:48 +03:00
{-# LANGUAGE RecordWildCards #-}
2017-02-15 04:42:35 +03:00
module GitmonClient where
2017-02-22 22:15:58 +03:00
import Prologue hiding (toStrict)
2017-02-15 04:42:35 +03:00
import Prelude
import Data.Aeson
import Data.Aeson.Types
2017-02-22 22:15:58 +03:00
import Git.Libgit2
2017-02-15 04:42:35 +03:00
import Network.Socket
import Network.Socket.ByteString (sendAll)
2017-02-15 04:42:35 +03:00
import Data.ByteString.Lazy (toStrict)
data Stats =
StartStats { repoName :: String
, via :: String
, gitDir :: String
, program :: String
, realIP :: Maybe String
, repoID :: Maybe String
, userID :: Maybe String }
| FinishStats { cpu :: Integer
, diskReadBytes :: Integer
, diskWriteBytes :: Integer
, resultCode :: Integer } deriving (Generic, Show)
instance ToJSON Stats where
toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelTo2 '_' }
data GitmonCommand = Update
| Finish
| Schedule deriving (Show)
instance ToJSON GitmonCommand where
toJSON command = String $ case command of
Update -> "update"
Finish -> "finish"
Schedule -> "schedule"
data GitmonMsg = GitmonMsg { command :: GitmonCommand, stats :: Stats } deriving (Show)
instance ToJSON GitmonMsg where
toJSON GitmonMsg{..} = object [
"command" .= command,
"data" .= stats
]
reportGitmon :: ReaderT LgRepo IO a -> ReaderT LgRepo IO a
reportGitmon command = do
2017-02-22 22:15:58 +03:00
soc <- liftIO $ socket AF_UNIX Stream defaultProtocol
2017-02-22 23:54:43 +03:00
safeIO $ connect soc (SockAddrUnix "/tmp/gitstats.sock")
2017-02-15 04:42:35 +03:00
2017-02-22 22:15:58 +03:00
let startStats = StartStats { repoName = "test-js", via = "gitrpc", gitDir = "/Users/vera/github/test-js", program = "semantic-diff", realIP = Nothing, repoID = Nothing, userID = Nothing }
2017-02-15 04:42:35 +03:00
let startStatsJSON = toStrict . encode $ GitmonMsg Update startStats
2017-02-22 23:54:43 +03:00
safeIO $ sendAll soc startStatsJSON
2017-02-15 04:42:35 +03:00
2017-02-22 23:54:43 +03:00
result <- command
2017-02-15 04:42:35 +03:00
let finishStats = FinishStats { cpu = 100, diskReadBytes = 1000, diskWriteBytes = 1000, resultCode = 0 }
let finishStatsJSON = toStrict . encode $ GitmonMsg Finish finishStats
2017-02-22 23:54:43 +03:00
safeIO $ sendAll soc finishStatsJSON `catch` noop
2017-02-15 04:42:35 +03:00
2017-02-22 23:54:43 +03:00
safeIO $ close soc `catch` noop
2017-02-15 04:42:35 +03:00
2017-02-22 23:54:43 +03:00
return result
where safeIO :: MonadIO m => IO () -> m ()
safeIO command = liftIO $ command `catch` noop
noop :: IOException -> IO ()
noop _ = return ()