packages feed

raven-haskell (empty) → 0.1.0.0

raw patch · 9 files changed

+797/−0 lines, 9 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, hspec, http-conduit, network, old-locale, random, raven-haskell, text, time, unordered-containers, uuid

Files

+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2013 Alexander Bondarenko++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ raven-haskell.cabal view
@@ -0,0 +1,40 @@+name:                raven-haskell+version:             0.1.0.0+synopsis:            Haskell client for Sentry logging service.+-- description:         +homepage:            https://bitbucket.org/dpwiz/raven-haskell+license:             MIT+license-file:        LICENSE+author:              Alexander Bondarenko+maintainer:          aenor.realm@gmail.com+-- copyright:           +category:            Logging+build-type:          Simple+cabal-version:       >=1.8++library+  hs-source-dirs: src+  ghc-options: -O2 -Wall+  exposed-modules:+    System.Log.Raven+    System.Log.Raven.Interfaces+    System.Log.Raven.Types+    System.Log.Raven.Transport.Debug+    System.Log.Raven.Transport.HttpConduit+  -- other-modules:+  build-depends:+    base ==4.*,+    random, uuid,+    time, old-locale,+    aeson, bytestring, text, unordered-containers,+    http-conduit, network++test-suite test+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs: test+  build-depends:+    base,+    hspec,+    raven-haskell,+    bytestring, unordered-containers, aeson
+ src/System/Log/Raven.hs view
@@ -0,0 +1,148 @@+-- | Raven is a client for Sentry event server (<https://www.getsentry.com/>).+--+--   Start by initializing the raven 'Service':+--+-- > l <- initRaven+-- >          "https://pub:priv@sentry.hostname.tld:8443/sentry/example_project"+-- >          id+-- >          sendRecord+-- >          stderrFallback+--+--   Send events using 'register' function:+--+-- > register l "my.logger.name" Debug "Hi there!" id+--+--   Tags and stuff can be added using register update functions.+--+-- > import Data.HashMap.Strict as HM+-- > let tags r = r { srTags = HM.insert "spam" "sausage"+-- >                         . HM.insert "eggs" "bacon"+-- >                         . srTags r }+-- > lt <- initRaven dsn tags sendRecord stderrFallback+-- >+-- > let culprit r = r { srCulprit = "my.module.function.name" }+-- > register lt "test.culprit" Error "It's a trap!" culprit+-- > let extra r = r { srExtra = HM.insert "fnord" "42" $ srExtra r }+-- > register lt "test.extra" Info "Test with tags and extra, please ignore."+--+--   The core package provides only general interface for sending events which+--   could be wrapped to adapt it to your needs.+--+-- > let debug msg = forkIO $ register l "my.logger.name" Debug msg (culprit . extra)+-- > debug "Async stuff too."+--+--   There are some little helpers to compose your own updaters.+--   You can use them both in 'initRaven' and 'register'.+--+-- > l <- initRaven dsn ( tags [ ("spam", "sausage"+-- >                           , ("eggs", "bacon") ]+-- >                    . extra [ ("more", "stuff") ]+-- >                    )+-- >                    sendRecord stderrFallback+-- >+-- > register l "test.helpers" Info "yup, i'm here." $ culprit "java.lang.NotReally"++module System.Log.Raven+    ( -- * Event service+      initRaven, disabledRaven+    , register+      -- * Fallback handlers+    , stderrFallback, errorFallback, silentFallback+      -- * Record updaters+    , culprit, tags, extra+      -- * Lower level helpers+    , record, recordLBS+    ) where++import Data.Aeson (encode)+import Data.ByteString.Lazy (ByteString)++import Data.UUID (UUID)+import System.Random (randomIO)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import System.Locale (defaultTimeLocale)+import System.IO (stderr, hPutStrLn)+import qualified Control.Exception as E+import qualified Data.HashMap.Strict as HM++import System.Log.Raven.Types++-- | Initialize event service.+initRaven :: String                                    -- ^ Sentry DSN+          -> (SentryRecord -> SentryRecord)            -- ^ Default fields updater. Use 'id' if not needed.+          -> (SentrySettings -> SentryRecord -> IO ()) -- ^ Event transport from Raven.Transport.*+          -> (SentryRecord -> IO ())                   -- ^ Fallback handler.+          -> IO SentryService                          -- ^ Event service to use in 'register'.+initRaven dsn d t fb = return+    SentryService { serviceSettings = fromDSN dsn+                  , serviceDefaults = d+                  , serviceTransport = t+                  , serviceFallback = fb+                  }++-- | Disabled service that ignores incoming events.+disabledRaven :: IO SentryService+disabledRaven = initRaven "" id undefined undefined++-- | Ask service to store an event.+register :: SentryService                  -- ^ Configured raven service.+         -> String                         -- ^ Logger name.+         -> SentryLevel                    -- ^ Sentry event level.+         -> String                         -- ^ Message.+         -> (SentryRecord -> SentryRecord) -- ^ Record updates.+         -> IO ()+register s loggerName level message upd = do+    rec <- record loggerName level message (upd . serviceDefaults s)++    let transport = serviceTransport s++    case serviceSettings s of+        SentryDisabled -> return ()+        settings -> E.catch (transport settings rec)+                            (\(E.SomeException _) -> serviceFallback s $ rec)++-- | Show basic message on stderr.+stderrFallback :: SentryRecord -> IO ()+stderrFallback rec =+    hPutStrLn stderr $ concat+        [ srTimestamp rec, " "+        , show $ srLevel rec, " "+        , srLogger rec, ": "+        , srMessage rec+        ]++-- | Crash and burn with record data.+errorFallback :: SentryRecord -> IO ()+errorFallback rec = error $ "Error sending record: " ++ show rec++-- | Ignore recording errors.+silentFallback :: SentryRecord -> IO ()+silentFallback _ = return ()++-- | Record an event using logging service.+record :: String                         -- ^ Logger name.+       -> SentryLevel                    -- ^ Level+       -> String                         -- ^ Message+       -> (SentryRecord -> SentryRecord) -- ^ Additional options+       -> IO SentryRecord+record logger lvl msg upd = do+    eid <- (filter (/= '-') . show) `fmap` (randomIO :: IO UUID)+    ts <- formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" `fmap` getCurrentTime+    return $! upd (newRecord eid msg ts lvl logger)++-- | JSON-encode record data.+recordLBS :: SentryRecord -> ByteString+recordLBS = encode++-- | Set culprit field.+culprit :: String -> SentryRecord -> SentryRecord+culprit c r = r { srCulprit = Just c }++-- | Add record tags.+tags :: [(String, String)] -> SentryRecord -> SentryRecord+tags ts r = r { srTags = HM.fromList ts `HM.union` srTags r }++-- | Add record extra information.+extra :: [(String, String)] -> SentryRecord -> SentryRecord+extra ts r =  r { srExtra = HM.fromList ts `HM.union` srExtra r }
+ src/System/Log/Raven/Interfaces.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Structured data interfaces from Sentry core:+--   <http://sentry.readthedocs.org/en/latest/developer/interfaces/index.html#provided-interfaces>++module System.Log.Raven.Interfaces+    ( -- * Core sentry interfaces+      -- ** Message+      message+      -- ** Exception+    , exception+      -- ** Http+    , http, HttpArgs(..)+      -- ** User+    , user+      -- ** Query+    , query+      -- * Generic interface helpers+    , interface+    , fields, (.=:), fromMaybe, fromAssoc+    ) where++import Data.Aeson (ToJSON(toJSON), Value, object, (.=))+import qualified Data.HashMap.Strict as HM++import System.Log.Raven.Types++-- | 'sentry.interfaces.Message':+--   A standard message consisting of a message arg, and an optional params+--   arg for formatting.+message :: String       -- ^ Message text (no more than 1000 characters in length).+        -> [Value]      -- ^ Formatting arguments+        -> SentryRecord -- ^ Record to update+        -> SentryRecord+message msg args = interface "sentry.interfaces.Message" info+    where+        info = object [ "message" .= take 1000 msg+                      , "params" .= args+                      ]++-- | 'sentry.interfaces.Exception':+--   A standard exception with a mandatory value argument,+--   and optional type and``module`` argument describing+--   the exception class type and module namespace.+exception :: String       -- ^ Value+          -> Maybe String -- ^ Type+          -> Maybe String -- ^ Module+          -> SentryRecord -- ^ Record to update+          -> SentryRecord+exception v t m = interface "sentry.interfaces.Exception" info+    where+        info = fields [ "value" .=: v+                      , fromMaybe "type" t+                      , fromMaybe "module" m+                      ]++-- | Optional and optionally parsed HTTP query+data HttpArgs = EmptyArgs+              | RawArgs String+              | QueryArgs [(String, String)]+              deriving (Eq, Show)++-- | 'sentry.interfaces.Http':+--   The Request information is stored in the Http interface.+--+--   Sentry will explicitly look for REMOTE_ADDR in env for things+--   which require an IP address.+--+--   The data variable should only contain the request body+--   (not the query string). It can either be a dictionary+--   (for standard HTTP requests) or a raw request body.+--+-- > import System.Log.RavenInterfaces as SI+-- > let upd = 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")]+http :: String             -- ^ URL+     -> String             -- ^ Method+     -> HttpArgs           -- ^ Arguments+     -> Maybe String       -- ^ Query string+     -> Maybe String       -- ^ Cookies+     -> [(String, String)] -- ^ Headers+     -> [(String, String)] -- ^ Environment+     -> SentryRecord       -- ^ Record to update+     -> SentryRecord+http url m args q c hs env = interface "sentry.interfaces.Http" info+    where+        info = fields [ "url" .=: url+                      , "method" .=: m+                      , fromHttpArgs args+                      , fromMaybe "query_string" q+                      , fromMaybe "cookies" c+                      , fromAssoc "headers" hs+                      , fromAssoc "env" env+                      ]++        fromHttpArgs EmptyArgs = []+        fromHttpArgs (RawArgs s) = "data" .=: s+        fromHttpArgs (QueryArgs kvs) = "data" .=: HM.fromList kvs++-- | 'sentry.interfaces.User':+--   An interface which describes the authenticated User for a request.+--+-- > let upd = SI.user "unique_id" [ ("username", "my_user")+-- >                               , ("email", "foo@example.com") ]+user :: String             -- ^ User's unique identifier+     -> [(String, String)] -- ^ Optional user data+     -> SentryRecord       -- ^ Record to update+     -> SentryRecord+user uid kwargs = interface "sentry.interfaces.User" info+    where+        info = HM.fromList $ ("id", uid) : kwargs++-- | 'sentry.interfaces.Query':+--   A SQL query with an optional string describing the SQL driver, engine.+query :: Maybe String -- ^ SQL Driver+      -> String       -- ^ Query+      -> SentryRecord -- ^ Record to update+      -> SentryRecord+query d q = interface "sentry.interfaces.Query" info+    where+        info = fields [ "query" .=: q+                      , fromMaybe "engine" d+                      ]++-- | Generic interface helper.+interface :: (ToJSON v) => String -> v -> SentryRecord -> SentryRecord+interface k v rec =+    rec { srInterfaces = HM.insert k (toJSON v) $ srInterfaces rec }++-- | JSON object with optional fields removed.+fields :: [[(String, Value)]] -> HM.HashMap String Value+fields = HM.fromList . concat++-- | A mandatory field.+(.=:) :: (ToJSON v) => String -> v -> [(String, Value)]+k .=: v = [(k, toJSON v)]++-- | Optional simple field.+fromMaybe :: (ToJSON v) => String -> Maybe v -> [(String, Value)]+fromMaybe k = maybe [] (\v -> [ (k, toJSON v) ])++-- | Optional dict-like field.+fromAssoc :: String -> [(String, String)] -> [(String, Value)]+fromAssoc _ [] = []+fromAssoc k vs = [(k, toJSON . HM.fromList $ vs)]
+ src/System/Log/Raven/Transport/Debug.hs view
@@ -0,0 +1,26 @@+-- | Dummy «transports» for debugging purposes.++module System.Log.Raven.Transport.Debug+    ( dumpRecord, briefRecord, catchRecord+    ) where++import Control.Concurrent.MVar (MVar, putMVar)++import System.Log.Raven.Types++-- | Dump all glory details.+dumpRecord :: SentrySettings -> SentryRecord -> IO ()+dumpRecord _ rec = print rec++-- | Log-like output with very few data shown.+briefRecord :: SentrySettings -> SentryRecord -> IO ()+briefRecord _ rec = putStrLn $ concat [ srTimestamp rec, " "+                                      , show $ srLevel rec, " "+                                      , srLogger rec, ": "+                                      , srMessage rec+                                      ]++-- | Catch event record into an *empty* 'MVar'.+--   Make sure you take it's contents before next message!+catchRecord :: MVar SentryRecord -> SentrySettings -> SentryRecord -> IO ()+catchRecord var _ rec = putMVar var rec
+ src/System/Log/Raven/Transport/HttpConduit.hs view
@@ -0,0 +1,32 @@+-- | HTTPS-capable transport using http-conduit.++{-# LANGUAGE OverloadedStrings #-}+module System.Log.Raven.Transport.HttpConduit+    ( sendRecord+    ) where++import Network (withSocketsDo)+import Network.HTTP.Conduit+import qualified Data.ByteString.Char8 as BS++import System.Log.Raven+import System.Log.Raven.Types++sendRecord :: SentrySettings -> SentryRecord -> IO ()+sendRecord conf rec = withSocketsDo $ do+    let ep = endpointURL conf+    let auth = concat [ "Sentry sentry_version=2.0"+                      , ", sentry_client=raven-haskell-0.1.0.0"+                      , ", sentry_key=" ++ sentryPublicKey conf+                      , ", sentry_secret=" ++ sentryPrivateKey conf+                      ]+    case ep of+        Nothing -> return ()+        Just url -> do+            req' <- parseUrl url+            let req = req' { method = "POST"+                           , requestHeaders = [("X-Sentry-Auth", BS.pack auth)]+                           , requestBody = RequestBodyLBS (recordLBS rec)+                           }+            res <- withManager $ httpLbs req+            return ()
+ src/System/Log/Raven/Types.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}++-- | Internal representation of event record and related facilities.+--   Keep this under a pillow when writing custom wrappers.++module System.Log.Raven.Types+    ( SentrySettings(..), fromDSN, endpointURL+    , SentryService(..)+    , SentryLevel(..), SentryRecord(..), newRecord+    ) where++import Data.Aeson (ToJSON(toJSON), Value, object, (.=))+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T++-- * Service settings++-- | Sentry client settings parsed from a DSN.+data SentrySettings = SentryDisabled+                    | SentrySettings { sentryURI        :: !String+                                     , sentryPublicKey  :: !String+                                     , sentryPrivateKey :: !String+                                     , sentryProjectId  :: !String+                                     } deriving (Show, Read, Eq)++-- | Transforms a service DSN into a settings. Format is:+--+-- > {PROTOCOL}://{PUBLIC_KEY}:{SECRET_KEY}@{HOST}{PATH}/{PROJECT_ID}+fromDSN :: String -> SentrySettings+fromDSN "" = SentryDisabled+fromDSN dsn@(fst . break (== ':') -> proto)+    | proto == "http"  = makeSettings "http"  . splitAt 7 $ dsn+    | proto == "https" = makeSettings "https" . splitAt 8 $ dsn+    | otherwise = error $ "fromDSN: unknown protocol (" ++ proto ++ ")"+    where+        body = break (== '@')++        keys = break (== ':') . fst . body+        pub  = fst . keys+        priv = drop 1 . snd . keys++        stuff = stuff' . break (=='/') . reverse . drop 1 . snd . body+        stuff' (a, b) = (reverse b, reverse a)+        uri = fst . stuff+        pid = snd . stuff++        assemble pref s = concat [pref, "://", uri s]++        makeSettings pref (_, s) = verify $! SentrySettings (assemble pref s) (pub s) (priv s) (pid s)++        verify (sentryURI -> "") = error "Empty URI"+        verify (sentryPublicKey -> "") = error "Empty public key"+        verify (sentryPrivateKey -> "") = error "Empty private key"+        verify (sentryProjectId -> "") = error "Empty project id"+        verify s = s++-- | Assemble http endpoint URL from settings.+endpointURL :: SentrySettings -> Maybe String+endpointURL SentryDisabled = Nothing+endpointURL (SentrySettings uri _ _ pid) = Just $! concat [uri, "api/", pid, "/store/"]++-- * Logging service++-- | Misc settings packaged for easier operations.+data SentryService = SentryService { serviceSettings :: SentrySettings+                                   , serviceDefaults :: (SentryRecord -> SentryRecord)+                                   , serviceTransport :: (SentrySettings -> SentryRecord -> IO ())+                                   , serviceFallback :: (SentryRecord -> IO ())+                                   }++-- * Log entry++-- | Sentry log levels. Custom levels should be configured in Sentry or sending messages will fail.+data SentryLevel = Fatal+                 | Error+                 | Warning+                 | Info+                 | Debug+                 | Custom String+                 deriving (Show, Read, Eq)++instance ToJSON SentryLevel where+    toJSON Fatal = "fatal"+    toJSON Error = "error"+    toJSON Warning = "warning"+    toJSON Info = "info"+    toJSON Debug = "debug"+    toJSON (Custom s) = toJSON s++type Assoc = HM.HashMap String String++-- | Event packet to be sent. See detailed field descriptions in+--   <http://sentry.readthedocs.org/en/latest/developer/client/index.html#building-the-json-packet>.+data SentryRecord = SentryRecord { srEventId    :: !String+                                 , srMessage    :: !String+                                 , srTimestamp  :: !String+                                 , srLevel      :: !SentryLevel+                                 , srLogger     :: !String+                                 , srPlatform   :: Maybe String+                                 , srCulprit    :: Maybe String+                                 , srTags       :: !Assoc+                                 , srServerName :: Maybe String+                                 , srModules    :: !Assoc+                                 , srExtra      :: !Assoc+                                 , srInterfaces :: HM.HashMap String Value+                                 } deriving (Show, Eq)++-- | Initialize a record with all required fields filled in.+newRecord :: String -> String -> String -> SentryLevel -> String -> SentryRecord+newRecord eid m t lev logger =+    SentryRecord+        eid m t lev logger+        Nothing Nothing HM.empty Nothing HM.empty HM.empty HM.empty++instance ToJSON SentryRecord where+    toJSON r = object . concat $+        [ [ "event_id" .= srEventId r+          , "message" .= srMessage r+          , "timestamp" .= srTimestamp r+          , "level" .= srLevel r+          , "logger" .= srLogger r+          ]+        , maybe [] (\v -> ["platform" .= v]) $ srPlatform r+        , maybe [] (\v -> ["culprit" .= v]) $ srCulprit r+        , if HM.null (srTags r) then [] else ["tags" .= srTags r]+        , maybe [] (\v -> ["server_name" .= v]) $ srServerName r+        , if HM.null (srModules r) then [] else ["modules" .= srModules r]+        , if HM.null (srExtra r) then [] else ["extra" .= srExtra r]+        , if HM.null (srInterfaces r) then [] else [ T.pack iface .= stuff+                                                   | (iface, stuff) <- HM.toList $ srInterfaces r]+        ]
+ test/Test.hs view
@@ -0,0 +1,246 @@+{-# 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\"}"