{-# LANGUAGE OverloadedStrings #-}
import Test.Hspec
import Control.Exception (evaluate)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Strict as HM
import Data.Aeson (object, (.=))
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Data.List (sort)
import System.Log.Raven
import qualified System.Log.Raven.Interfaces as SI
import System.Log.Raven.Types as LT
import System.Log.Raven.Transport.Debug (dumpRecord, briefRecord, catchRecord)
import System.Log.Raven.Transport.HttpConduit (sendRecord)
main :: IO ()
main = hspec $ do
describe "Types" $ do
it "parses empty DSN into SentryDisabled" $ do
fromDSN "" `shouldBe` SentryDisabled
it "carps on invalid DSN" $ do
evaluate (fromDSN "lol://haha") `shouldThrow` anyException
evaluate (fromDSN "http://haha") `shouldThrow` anyException
it "parses example DSN" $ do
fromDSN dsn `shouldBe` ss
it "generates correct endpoint" $ do
endpointURL SentryDisabled `shouldBe` Nothing
endpointURL ss `shouldBe` Just "http://example.com/sentry/api/project-id/store/"
it "generates empty record" $ do
newRecord "" "" "" Debug "" `shouldBe` emptyRecord
it "generates record template" $ do
r <- strip `fmap` test
r `shouldBe` testRecord
it "serializes as JSON" $ do
r <- strip `fmap` test
recordLBS r `shouldBe` testRecordLBS
describe "Service" $ do
it "ignores record when service is disabled" $ do
l <- disabledRaven
ok <- register l "test.logger" Debug "Fly me to /dev/null" id
ok `shouldBe` ()
it "uses a fallback" $ do
v <- newEmptyMVar
l <- initRaven "http://bad:boo@localhost:1/raven" id undefined (\_ -> putMVar v True)
sent <- register l "test.logger" Debug "Ready or not, here i come!" id
sent `shouldBe` ()
fbUsed <- takeMVar v
fbUsed `shouldBe` True
describe "Transport: HttpConduit" $ do
it "sends a record" $ do
l <- initRaven "http://test:test@localhost:19876/raven" id sendRecord errorFallback
ok <- register l "test.logger" Debug "Like a record, baby, right round." id
ok `shouldBe` ()
describe "Transport: Debug" $ do
it "shows brief message" $ do
l <- initRaven "http://not:really@whatever.fake/project" id briefRecord errorFallback
ok <- register l "test.logger" Debug "Hi there!" id
ok `shouldBe` ()
it "dumps event record" $ do
l <- initRaven "http://not:really@whatever.fake/project" id dumpRecord errorFallback
ok <- register l "test.logger" Debug "Hi there!" id
ok `shouldBe` ()
it "catches record into MVar" $ do
v <- newEmptyMVar
l <- initRaven "http://not:really@whatever.fake/project" id (catchRecord v) errorFallback
ok <- register l "test.logger" Debug "Hi there!" id
ok `shouldBe` ()
rec <- takeMVar v
srMessage rec `shouldBe` "Hi there!"
describe "Updaters" $ do
let make = record "test.logger" Debug "test record please ignore"
it "updates culprit" $ do
r <- make $ culprit "Test.main"
srCulprit r `shouldBe` Just "Test.main"
it "updates tags" $ do
r <- make $ tags []
srTags r `shouldBe` HM.empty
r <- make $ tags [("test", "shmest")]
srTags r `shouldBe` HM.fromList [("test", "shmest")]
it "updates extra" $ do
r <- make $ extra []
srExtra r `shouldBe` HM.empty
r <- make $ extra [("bru", "haha")]
srExtra r `shouldBe` HM.fromList [("bru", "haha")]
it "fills in service defaults" $ do
v <- newEmptyMVar
l <- initRaven
"http://not:really@whatever.fake/project"
( tags [("spam", "eggs"), ("test", "")]
. extra [("sausage", "salad")] )
(catchRecord v)
errorFallback
r <- register l "test.logger" Debug "test record please ignore" $ tags [("test", "shmest")]
rec <- takeMVar v
srTags rec `shouldBe` HM.fromList [("spam", "eggs"), ("test", "shmest")]
srExtra rec `shouldBe` HM.fromList [("sausage", "salad")]
describe "Interfaces" $ do
let make = record "test.logger" Debug "test record please ignore"
let send r = do
ok <- sendRecord (fromDSN "http://test:test@localhost:19876/raven") r
ok `shouldBe` ()
it "registers messages" $ do
r <- make $ SI.message "My raw message with interpreted strings like %s" ["this"]
let ex = object [ "message" .= ("My raw message with interpreted strings like %s" :: String)
, "params" .= ["this" :: String]
]
HM.lookup "sentry.interfaces.Message" (srInterfaces r) `shouldBe` Just ex
send r
it "registers exceptions" $ do
r <- make $ SI.exception "Wattttt!" (Just "SyntaxError") (Just "__buitins__")
let ex = object [ "type" .= ("SyntaxError" :: String)
, "value" .= ("Wattttt!" :: String)
, "module" .= ("__buitins__" :: String)
]
HM.lookup "sentry.interfaces.Exception" (srInterfaces r) `shouldBe` Just ex
send r
it "registers HTTP queries" $ do
r <- make $ SI.http
"http://absolute.uri/foo"
"POST"
(SI.QueryArgs [("foo", "bar")])
(Just "hello=world")
(Just "foo=bar")
[("Content-Type", "text/html")]
[("REMOTE_ADDR", "127.1.0.1")]
let ex = object [ "url" .= ("http://absolute.uri/foo" :: String)
, "method" .= ("POST" :: String)
, "data" .= object [ "foo" .= ("bar" :: String) ]
, "query_string" .= ("hello=world" :: String)
, "cookies" .= ("foo=bar" :: String)
, "headers" .= object [ "Content-Type" .= ("text/html" :: String) ]
, "env" .= object [ "REMOTE_ADDR" .= ("127.1.0.1" :: String)]
]
HM.lookup "sentry.interfaces.Http" (srInterfaces r) `shouldBe` Just ex
send r
it "registers User data" $ do
r <- make $ SI.user "0" [ ("username", "root")
, ("email", "root@localhost")
, ("is_superuser", "True") -- wart
]
let ex = object [ "id" .= ("0" :: String)
, "username" .= ("root" :: String)
, "email" .= ("root@localhost" :: String)
, "is_superuser" .= ("True" :: String)
]
HM.lookup "sentry.interfaces.User" (srInterfaces r) `shouldBe` Just ex
send r
it "registers SQL queries" $ do
r <- make $ SI.query (Just "postgresql-simple") "SELECT 1"
let ex = object [ "query" .= ("SELECT 1" :: String)
, "engine" .= ("postgresql-simple" :: String)
]
HM.lookup "sentry.interfaces.Query" (srInterfaces r) `shouldBe` Just ex
send r
it "combines interface parts" $ do
r <- make $ SI.exception "Please ignore" (Just "TestException") (Just "Test")
. SI.http
"http://localhost:8000/im/trapped/at/request/factory"
"GET"
SI.EmptyArgs
(Just "help")
Nothing
[]
[]
. SI.user "1001" [ ("username", "test"), ("email", "test@localhost")]
. SI.query Nothing "SELECT title, body FROM pages WHERE url=?"
sort (HM.keys $ srInterfaces r) `shouldBe` [ "sentry.interfaces.Exception"
, "sentry.interfaces.Http"
, "sentry.interfaces.Query"
, "sentry.interfaces.User"
]
send r
dsn = "http://public_key:secret_key@example.com/sentry/project-id"
ss = SentrySettings {
sentryURI = "http://example.com/sentry/",
sentryPublicKey = "public_key",
sentryPrivateKey = "secret_key",
sentryProjectId = "project-id"
}
strip rec = rec { srEventId = ""
, srTimestamp = ""
}
test = record "test.logger" Debug "test record please ignore" id
emptyRecord = SentryRecord { srEventId = ""
, srMessage = ""
, srTimestamp = ""
, srLevel = Debug
, srLogger = ""
, srPlatform = Nothing
, srCulprit = Nothing
, srTags = HM.empty
, srServerName = Nothing
, srModules = HM.empty
, srExtra = HM.empty
, srInterfaces = HM.empty
}
testRecord = emptyRecord { srMessage = "test record please ignore"
, srLevel = Debug
, srLogger = "test.logger"
}
testRecordLBS = LBS.pack "{\"timestamp\":\"\",\"message\":\"test record please ignore\",\"event_id\":\"\",\"level\":\"debug\",\"logger\":\"test.logger\"}"