github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-29 11:02:26 +03:00
Code Issues Projects Releases Wiki Activity

Attempt to send stack traces to haystack

Browse Source
This commit is contained in:
Timothy Clem 2018-11-13 10:09:58 -08:00
parent 890f6d2068
commit 4fbeaef355
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Semantic/Telemetry/Haystack.hs
View File

@ -10,8 +10,10 @@ import Control.Exception
import Crypto.Hash import Crypto.Hash
import Data.Aeson hiding (Error) import Data.Aeson hiding (Error)
import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Char8 as BC
import Data.List (intercalate)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding as Text
import GHC.Exts (currentCallStack)
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Types.Status (statusCode) import Network.HTTP.Types.Status (statusCode)
import Prologue hiding (hash) import Prologue hiding (hash)
@ -51,14 +53,15 @@ haystackClient maybeURL managerSettings appName
reportError :: ErrorLogger -> HaystackClient -> ErrorReport -> IO () reportError :: ErrorLogger -> HaystackClient -> ErrorReport -> IO ()
reportError logger NullHaystackClient ErrorReport{..} = let msg = takeWhile (/= '\n') (displayException errorReportException) in logger msg errorReportContext reportError logger NullHaystackClient ErrorReport{..} = let msg = takeWhile (/= '\n') (displayException errorReportException) in logger msg errorReportContext
reportError logger HaystackClient{..} ErrorReport{..} = do reportError logger HaystackClient{..} ErrorReport{..} = do
bt <- fmap (intercalate "\n") currentCallStack
let fullMsg = displayException errorReportException let fullMsg = displayException errorReportException
let summary = takeWhile (/= '\n') fullMsg let summary = takeWhile (/= '\n') fullMsg
logger summary errorReportContext logger summary errorReportContext
let payload = object $ let payload = object $
[ "app" .= haystackClientAppName [ "app" .= haystackClientAppName
, "message" .= summary , "message" .= fullMsg
, "class" .= summary , "class" .= summary
, "backtrace" .= fullMsg , "backtrace" .= bt
, "rollup" .= rollup fullMsg , "rollup" .= rollup fullMsg
] <> foldr (\(k, v) acc -> Text.pack k .= v : acc) [] errorReportContext ] <> foldr (\(k, v) acc -> Text.pack k .= v : acc) [] errorReportContext
let request = haystackClientRequest { requestBody = RequestBodyLBS (encode payload) } let request = haystackClientRequest { requestBody = RequestBodyLBS (encode payload) }