packages feed

airbrake (empty) → 0.1.0.0

raw patch · 5 files changed

+313/−0 lines, 5 filesdep +basedep +blaze-markupdep +bytestringsetup-changed

Dependencies added: base, blaze-markup, bytestring, exceptions, http-conduit, monad-control, network, semigroups, template-haskell, text, transformers, utf8-string, wai

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2014, Joel Taylor+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ airbrake.cabal view
@@ -0,0 +1,32 @@+name:                airbrake+version:             0.1.0.0+synopsis:            An Airbrake notifier for Haskell+description:         Airbrake notifier.+homepage:            https://github.com/joelteon/airbrake+license:             BSD3+license-file:        LICENSE+author:              Joel Taylor+maintainer:          me@joelt.io+category:            Network+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Airbrake, Airbrake.WebRequest+  other-modules:       Paths_airbrake+  build-depends:       base == 4.*+                     , blaze-markup+                     , bytestring+                     , exceptions+                     , http-conduit+                     , monad-control+                     , network+                     , semigroups+                     , template-haskell+                     , text+                     , transformers+                     , utf8-string+                     , wai+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010
+ src/Airbrake.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++-- | Utilities for notifying Airbrake of errors. An 'Error' type is+-- provided; you can convert any instance of 'Exception' to an 'Error'+-- using 'toError', which uses the exception's 'Typeable' instance.+--+-- Airbrake requires a stack trace for any reported exception, but stack+-- trace information isn't readily available for Haskell exceptions.+-- 'notifyQ' and 'notifyReqQ' are provided for the purpose of providing the+-- current file position as the stack trace.+module Airbrake (+    -- * Notifying+    notify, notifyReq,+    notifyQ, notifyReqQ,++    -- * Notification metadata+    -- *** Location lists+    NonEmpty (..), Location, Locations,++    -- *** Wrapping errors+    toError, Error (..),++    -- * Configuration building+    APIKey, Environment,+    airbrakeConf, defaultApiEndpoint,+    AirbrakeConf (..),+    Server (..)+) where++import qualified Airbrake.WebRequest as W+import Control.Exception+import Control.Monad.Catch+import Control.Monad.IO.Class+import Control.Monad.Trans.Control+import Data.ByteString.Lazy (ByteString)+import Data.Foldable+import Data.List.NonEmpty+import Data.String+import qualified Data.Text as T (Text)+import Data.Text (pack)+import Data.Typeable (typeOf)+import Data.Version+import Language.Haskell.TH.Syntax hiding (report)+import qualified Paths_airbrake as P+import Prelude hiding (error)+import Network.HTTP.Conduit+import qualified Network.Wai as Wai+import Text.Blaze+import Text.Blaze.Internal+import Text.Blaze.Renderer.Utf8++type APIKey = String+type Environment = String++data Error = Error+           { errorType :: T.Text+           , errorDescription :: T.Text+           }++-- | Information to use when communicating with Airbrake.+data AirbrakeConf = AirbrakeConf+                  { acApiEndpoint :: String+                  , acApiKey :: APIKey+                  , acServer :: Server+                  }++-- | Metadata about the server.+data Server = Server+            { serverEnvironment :: Environment+            , serverAppVersion :: Maybe Version+            , serverRoot :: Maybe FilePath+            }++-- | A @(filename, line)@ pair.+type Location = (FilePath, Int)++type Locations = NonEmpty Location++-- | @"http:\/\/api.airbrake.io\/notifier_api\/v2\/notices"@+defaultApiEndpoint :: String+defaultApiEndpoint = "http://api.airbrake.io/notifier_api/v2/notices"++airbrakeConf :: APIKey -> Environment -> AirbrakeConf+airbrakeConf k env =+    AirbrakeConf defaultApiEndpoint k (Server env Nothing Nothing)++performNotify :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, W.WebRequest req)+              => Locations -> AirbrakeConf -> Maybe req -> Error -> m ()+performNotify loc conf req e = do+    let report = buildReport loc conf req e+    req' <- parseUrl (acApiEndpoint conf)+    let rq = req' { requestBody = RequestBodyLBS report, method = "POST" }+    _ <- withManager (httpLbs rq)+    return ()++-- | Notify Airbrake of an exception.+notify :: (MonadBaseControl IO m, MonadIO m, MonadThrow m)+       => AirbrakeConf -> Error -> Locations -> m ()+notify conf e l = performNotify l conf (Nothing :: Maybe Wai.Request) e++-- | Notify Airbrake of an exception, providing request metadata along with+-- it.+notifyReq :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, W.WebRequest req)+          => AirbrakeConf -> req -> Error -> Locations -> m ()+notifyReq conf req e l = performNotify l conf (Just req) e++-- | 'notify', fetching the current file location using Template Haskell.+--+-- @+-- $notifyQ :: ('MonadBaseControl' 'IO' m, 'MonadThrow' m, 'MonadIO' m)+--          => 'AirbrakeConf' -> 'Error' -> m ()+-- @+notifyQ :: Q Exp+notifyQ = do+    Loc fn _ _ (st, _) _ <- qLocation+    [| \ cc ee -> notify cc ee ((fn, st) :| []) |]++-- | 'notifyReq', fetching the current file location using Template+-- Haskell.+--+-- @+-- $notifyReqQ :: ('MonadBaseControl' 'IO' m, 'MonadThrow' m, 'MonadIO' m, 'W.WebRequest' req)+--             => 'AirbrakeConf' -> req -> 'Error' -> m ()+-- @+notifyReqQ :: Q Exp+notifyReqQ = do+    Loc fn _ _ (st, _) _ <- qLocation+    [| \ cc r ee -> notifyReq cc r ee ((fn, st) :| []) |]++-- | Convert any 'Exception' to an 'Error'.+toError :: Exception e => e -> Error+toError (toException -> SomeException e) =+    Error (pack (show (typeOf e))) (pack (show e))++buildReport :: W.WebRequest a+            => Locations -> AirbrakeConf -> Maybe a -> Error -> ByteString+buildReport locs conf req err = renderMarkup $ do+    preEscapedText "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+    notice ! nversion "2.3" $ do+        api_key . toMarkup $ acApiKey conf++        notifier $ do+            name "airbrake"+            version . toMarkup $ showVersion P.version+            url "http://hackage.haskell.org/package/airbrake"++        error $ do+            class_ (toMarkup (errorType err))+            message (toMarkup (errorDescription err))+            backtrace $ forM_ locs $ \ (filename, line') ->+                line ! file (toValue filename)+                     ! number (toValue line')++        forM_ req $ \ r -> request $ do+            url (toMarkup . show $ W.url r)+            forM_ (W.route r) $ \ rt -> component (toMarkup rt)+            forM_ (W.action r) $ \ act -> action (toMarkup act)+            cgi_data . forM_ (W.otherVars r) $ \ (k, v) ->+                var ! key (toValue k) $ toMarkup v++        let serv = acServer conf+        server_environment $ do+            environment_name . toMarkup $ serverEnvironment serv+            forM_ (serverAppVersion serv) $ \ v ->+                app_version (toMarkup $ showVersion v)++            forM_ (serverRoot serv) $ \ v ->+                project_root (toMarkup v)+    where+        notice = Parent "notice" "<notice" "</notice>"+        name = Parent "name" "<name" "</name>"+        notifier = Parent "notifier" "<notifier" "</notifier>"+        api_key = Parent "api-key" "<api-key" "</api-key>"+        version = Parent "version" "<version" "</version>"+        url = Parent "url" "<url" "</url>"+        class_ = Parent "class" "<class" "</class>"+        error = Parent "error" "<error" "</error>"+        message = Parent "message" "<message" "</message>"+        backtrace = Parent "backtrace" "<backtrace" "</backtrace>"+        line = Leaf "line" "<line" " />"+        file = attribute "file" " file=\""+        number = attribute "number" " number=\""+        server_environment = Parent "server-environment" "<server-environment"+                                 "</server-environment>"+        environment_name = Parent "environment-name" "<environment-name"+                               "</environment-name>"+        app_version = Parent "app-version" "<app-version" "</app-version>"+        project_root = Parent "project-root" "<project-root" "</project-root>"+        request = Parent "request" "<request" "</request>"+        cgi_data = Parent "cgi-data" "<cgi-data" "</cgi-data>"+        action = Parent "action" "<action" "</action>"+        component = Parent "component" "<component" "</component>"+        var = Parent "var" "<var" "</var>"+        key = attribute "key" " key=\""+        nversion = attribute "version" " version=\""
+ src/Airbrake/WebRequest.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Class for extracting metadata from HTTP request types that come from+-- different libraries.+module Airbrake.WebRequest (+    WebRequest (..)+) where++import Data.ByteString.UTF8 (toString)+import Data.Maybe+import qualified Network.Wai as Wai+import Network.URI++class WebRequest a where+    -- | The request URL.+    url :: a -> URI++    -- | Current route.+    -- This is a carryover from Rails-style MVC and is optional.+    route :: a -> Maybe String++    -- | Controller action being used.+    -- This is a carryover from Rails-style MVC and is optional.+    action :: a -> Maybe String++    -- | Any other request metadata that you would like to include+    -- (server name, user agent, etc.)+    otherVars :: a -> [(String, String)]++-- | @wai@ requests+instance WebRequest Wai.Request where+    url req = case parseURI uriS of+                  Just u -> u+                  Nothing -> error "Failure producing URI from wai request."+        where+            uriS = (if Wai.isSecure req then "https://" else "http://")+                ++ show (Wai.remoteHost req)+                ++ toString (Wai.rawPathInfo req)+                ++ toString (Wai.rawQueryString req)++    route _ = Nothing+    action _ = Nothing++    otherVars req = catMaybes+        [ k "Host" "HTTP_HOST"+        , k "User-Agent" "HTTP_USER_AGENT"+        , k "Referer" "HTTP_REFERER"+        , k "Cookie" "HTTP_COOKIE"+        , if Wai.isSecure req then Just ("HTTPS", "on") else Nothing]+        where k hdr key = fmap (\ v -> (key, toString v))+                               (lookup hdr (Wai.requestHeaders req))