{-# 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 Data.Time (UTCTime(..), Day(..))
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)
ts :: UTCTime
ts = UTCTime (ModifiedJulianDay 40587) 0
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 "" "" ts 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 = ts
}
test = record "test.logger" Debug "test record please ignore" id
emptyRecord = SentryRecord { srEventId = ""
, srMessage = ""
, srTimestamp = ts
, srLevel = Debug
, srLogger = ""
, srPlatform = Nothing
, srCulprit = Nothing
, srTags = HM.empty
, srServerName = Nothing
, srModules = HM.empty
, srExtra = HM.empty
, srInterfaces = HM.empty
, srRelease = Nothing
, srEnvironment = Nothing
}
testRecord = emptyRecord { srMessage = "test record please ignore"
, srLevel = Debug
, srLogger = "test.logger"
}
testRecordLBS = LBS.pack "{\"logger\":\"test.logger\",\"message\":\"test record please ignore\",\"event_id\":\"\",\"timestamp\":\"1970-01-01T00:00:00Z\",\"level\":\"debug\"}"