packages feed

wai-middleware-rollbar (empty) → 0.1.0.0

raw patch · 18 files changed

+1112/−0 lines, 18 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, hostname, http-client, http-conduit, http-types, network, text, time, unordered-containers, uuid, wai

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Hardy Jones (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Hardy Jones nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++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.
+ README.md view
@@ -0,0 +1,1 @@+# wai-middleware-rollbar
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Network/Wai/Middleware/Rollbar.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+    Module      : Network.Wai.Middleware.Rollbar+    Description : WAI middleware for interfacing with Rollbar+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Provides middleware for communicating with Rollbar.++    Currently has middleware for sending all server errors to Rollbar.+    More to come shortly.+-}++module Network.Wai.Middleware.Rollbar (requests) where++import Control.Concurrent (forkIO)+import Control.Exception  (Handler(Handler), catches, displayException)+import Control.Monad      (when)++import Data.Aeson   (ToJSON, defaultOptions, genericToEncoding, toEncoding)+import Data.Functor (void)+import Data.Maybe   (fromMaybe)+import Data.Time    (getCurrentTime)+import Data.UUID.V4 (nextRandom)++import GHC.Generics (Generic)++import Network.HostName          (getHostName)+import Network.HTTP.Client       (HttpException)+import Network.HTTP.Simple+    ( JSONException+    , Request+    , defaultRequest+    , httpNoBody+    , setRequestBodyJSON+    , setRequestHost+    , setRequestIgnoreStatus+    , setRequestMethod+    , setRequestPath+    , setRequestPort+    , setRequestSecure+    )+import Network.HTTP.Types.Status+    (Status(Status), statusCode, statusIsServerError, statusMessage)+import Network.Wai               (Middleware, ResponseReceived)++import System.Environment (getExecutablePath)+import System.IO          (hPutStrLn, stderr)++import qualified Data.Text          as T+import qualified Data.Text.Encoding as TE+import qualified Network.Wai        as NW+import qualified Rollbar.Item       as RI++-- | Middleware that watches responses+--  and sends an item to Rollbar if it is a server error (5xx).+--+--  Sends additional metadata including the request information.+requests :: RI.AccessToken -> RI.Environment -> Middleware+requests accessToken environment app req handler' = app req handler+    where+    handler :: NW.Response -> IO ResponseReceived+    handler res = do+        _ <- forkIO $ handle500 accessToken environment req res+        handler' res++handle500 :: RI.AccessToken -> RI.Environment -> NW.Request -> NW.Response -> IO ()+handle500 accessToken environment req res =+    when (statusIsServerError $ NW.responseStatus res) (send accessToken environment req res)+        `catches`+            [ Handler handleHttpException+            , Handler handleJSONException+            ]++send :: RI.AccessToken -> RI.Environment -> NW.Request -> NW.Response -> IO ()+send accessToken environment req res = do+    uuid <- Just . RI.UUID4 <$> nextRandom+    timestamp <- Just <$> getCurrentTime+    host <- Just <$> getHostName+    root <- Just . RI.Root . T.pack <$> getExecutablePath+    let request = Just RI.Request {..}+    let server = Just RI.Server { RI.branch = Nothing, RI.serverCodeVersion = Nothing, .. }+    let itemData = (RI.error environment messageBody payload)+            { RI.request, RI.server, RI.timestamp, RI.uuid }+    let rReq = rollbarRequest RI.Item{..}+    void $ httpNoBody rReq+    where+    Status{..} = NW.responseStatus res+    headers = RI.Headers $ NW.requestHeaders req+    messageBody = RI.MessageBody <$> myDecodeUtf8 statusMessage+    rawBody = ""+    get = RI.Get $ NW.queryString req+    method = RI.Method $ NW.requestMethod req+    queryString = RI.QueryString $ NW.rawQueryString req+    url = RI.URL (NW.requestHeaderHost req, NW.pathInfo req)+    userIP = RI.IP $ NW.remoteHost req+    referer = myDecodeUtf8 =<< NW.requestHeaderReferer req+    range = myDecodeUtf8 =<< NW.requestHeaderRange req+    userAgent = myDecodeUtf8 =<< NW.requestHeaderUserAgent req+    payload = Payload+        { statusMessage = myDecodeUtf8' statusMessage+        , ..+        }++    myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'+    myDecodeUtf8' = fromMaybe "" . myDecodeUtf8++handleHttpException :: HttpException -> IO ()+handleHttpException e = do+    hPutStrLn stderr "Ran into an exception while sending a request to Rollbar:"+    hPutStrLn stderr $ displayException e++handleJSONException :: JSONException -> IO ()+handleJSONException e = do+    hPutStrLn stderr "Ran into an exception while parsing JSON response from Rollbar:"+    hPutStrLn stderr $ displayException e++rollbarRequest :: ToJSON a => RI.Item a -> Network.HTTP.Simple.Request+rollbarRequest payload =+    setRequestMethod "POST"+    . setRequestSecure True+    . setRequestHost "api.rollbar.com"+    . setRequestPort 443+    . setRequestPath "api/1/item/"+    . setRequestBodyJSON payload+    . setRequestIgnoreStatus+    $ defaultRequest++data Payload+    = Payload+        { statusCode    :: Int+        , statusMessage :: T.Text+        , userAgent     :: Maybe T.Text+        , range         :: Maybe T.Text+        , referer       :: Maybe T.Text+        }+    deriving (Generic, Show)++instance ToJSON Payload where+    toEncoding = genericToEncoding defaultOptions
+ src/Rollbar/AccessToken.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.AccessToken+    Description : The access token for a project on Rollbar.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.AccessToken+    ( AccessToken(..)+    ) where++import Data.Aeson  (ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should have the scope "post_server_item".+newtype AccessToken+    = AccessToken T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ src/Rollbar/Item.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+    Module      : Rollbar.Item+    Description : Datatype for reporting to Rollbar+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Provides a data type that subsumes most of what Rollbar expects for "item"s.++    See Rollbar's <https://rollbar.com/docs/api/items_post/#data-format Data Format>+    for more details.+-}++module Rollbar.Item+    ( -- * Data helpers+      -- |  These functions are probably what you want to use most of the time.+      --+      --    They create a 'Data' with lots of data prefilled.+      --    You can then override what you need with record updates.+      debug+    , info+    , warning+    , error+    , critical+    -- * Item+    , Item(..)+    -- * Item data+    , module Rollbar.AccessToken+    , AccessToken(..)++    , module Rollbar.Item.Data+    , Data(..)+    , Context(..)+    , Fingerprint(..)+    , Framework(..)+    , Title(..)+    , UUID4(..)++    -- * Required data+    , module Rollbar.Item.Body+    , Body(..)+    , MessageBody(..)++    , module Rollbar.Item.Environment+    , Environment(..)++    , module Rollbar.Item.Level+    , Level(..)++    -- * Optional data+    , module Rollbar.Item.CodeVersion+    , CodeVersion(..)++    , module Rollbar.Item.Hardcoded+    , Hardcoded(..)++    , module Rollbar.Item.Person+    , Person(..)+    , Email(..)+    , Id(..)+    , Username(..)++    , module Rollbar.Item.Request+    , Get(..)+    , Headers(..)+    , IP(..)+    , Method(..)+    , QueryString(..)+    , RawBody(..)+    , URL(..)++    , module Rollbar.Item.Server+    , Server(..)+    , Branch(..)+    , Root(..)+    ) where++import Data.Aeson   (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.Maybe   (fromMaybe)+import Data.Version (showVersion)++import GHC.Generics (Generic)++import Prelude hiding (error)++import Rollbar.AccessToken+import Rollbar.Item.Body+import Rollbar.Item.CodeVersion+import Rollbar.Item.Data+import Rollbar.Item.Environment+import Rollbar.Item.Hardcoded+import Rollbar.Item.Level+import Rollbar.Item.Person+import Rollbar.Item.Request+import Rollbar.Item.Server++import Rollbar.Item.Internal.Notifier+import Rollbar.Item.Internal.Platform++import System.Info (os)++import qualified Data.Text                    as T+import qualified Paths_wai_middleware_rollbar++-- | Creates 'Data' with the level set to 'Debug'.+debug :: Environment -> Maybe MessageBody -> payload -> Data payload+debug environment messageBody payload =+    Data+        { body = Message (fromMaybe "" messageBody) payload+        , codeVersion =+            SemVer . T.pack $ showVersion Paths_wai_middleware_rollbar.version+        , context = Nothing+        , custom = Nothing+        , environment = environment+        , fingerprint = Nothing+        , framework = Nothing+        , language = Hardcoded+        , level = Debug+        , notifier = Notifier Hardcoded Paths_wai_middleware_rollbar.version+        , person = Nothing+        , platform = Platform $ T.pack os+        , request = Nothing+        , server = Nothing+        , timestamp = Nothing+        , title = Nothing+        , uuid = Nothing+        }++-- | Creates 'Data' with the level set to 'Info'.+info :: Environment -> Maybe MessageBody -> payload -> Data payload+info environment messageBody payload =+    (debug environment messageBody payload) { level = Info }++-- | Creates 'Data' with the level set to 'Warning'.+warning :: Environment -> Maybe MessageBody -> payload -> Data payload+warning environment messageBody payload =+    (debug environment messageBody payload) { level = Warning }++-- | Creates 'Data' with the level set to 'Error'.+error :: Environment -> Maybe MessageBody -> payload -> Data payload+error environment messageBody payload =+    (debug environment messageBody payload) { level = Error }++-- | Creates 'Data' with the level set to 'Critical'.+critical :: Environment -> Maybe MessageBody -> payload -> Data payload+critical environment messageBody payload =+    (debug environment messageBody payload) { level = Critical }++-- | The thing we actually give to Rollbar.+data Item a+    = Item+        { accessToken :: AccessToken+        -- ^ Should have a scope "post_server_item".+        , itemData    :: Data a+        }+    deriving (Eq, Generic, Show)++itemKVs :: (KeyValue kv, ToJSON v) => Item v -> [kv]+itemKVs Item{..} =+    [ "access_token" .= accessToken+    , "data" .= itemData+    ]++instance ToJSON a => ToJSON (Item a) where+    toJSON = object . itemKVs+    toEncoding = pairs . mconcat . itemKVs
+ src/Rollbar/Item/Body.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+    Module      : Rollbar.Item.Body+    Description : The meat of the Rollbar item+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Use this for providing the majority of your specific data to Rollbar.+-}++module Rollbar.Item.Body+    ( Body(..)+    , MessageBody(..)+    ) where++import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.String (IsString)++import GHC.Generics (Generic)++import qualified Data.Text as T++-- | This is the actual data that you want to give to Rollbar.+--  Most of the rest of Rollbar is metadata.+data Body arbitrary+    -- | No stack trace, just a message and some arbitrary data.+    = Message+        { messageBody :: MessageBody+        -- ^ The primary message text.+        , messageData :: arbitrary+        -- ^ Any arbitrary data you want to send with this message.+        }+    deriving (Eq, Generic, Show)++bodyKVs :: (KeyValue kv, ToJSON v) => Body v -> [kv]+bodyKVs Message{..} =+    [ "body" .= messageBody+    , "data" .= messageData+    ]++instance ToJSON arbitrary => ToJSON (Body arbitrary) where+    toJSON = object . bodyKVs+    toEncoding = pairs . mconcat . bodyKVs++-- | The primary message text to send to Rollbar.+newtype MessageBody+    = MessageBody T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ src/Rollbar/Item/CodeVersion.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveGeneric #-}++{-|+    Module      : Rollbar.Item.CodeVersion+    Description : Metadata for describing versions of software+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.CodeVersion+    ( CodeVersion(..)+    ) where++import Data.Aeson (ToJSON, toEncoding, toJSON)++import GHC.Generics (Generic)++import qualified Data.Text as T++-- | Rollbar supports different ways to say what version the code is.+data CodeVersion+    -- | Good ole SemVer.+    --  It's 'T.Text' because who knows if you actually got it right...+    = SemVer T.Text+    -- | Plain integers.+    | Number Int+    -- | Should be a Git SHA.+    | SHA T.Text+    deriving (Eq, Generic, Show)++prettyCodeVersion :: CodeVersion -> T.Text+prettyCodeVersion (SemVer s) = s+prettyCodeVersion (Number n) = T.pack . show $ n+prettyCodeVersion (SHA h)    = h++instance ToJSON CodeVersion where+    toJSON = toJSON . prettyCodeVersion+    toEncoding = toEncoding . prettyCodeVersion
+ src/Rollbar/Item/Data.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Data+    Description : Metadata about the item being reported+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    The majority of this module is metadata that is reported for each item.+-}++module Rollbar.Item.Data+    ( Data(..)+    , Context(..)+    , Fingerprint(..)+    , Framework(..)+    , Title(..)+    , UUID4(..)+    ) where++import Data.Aeson+    ( ToJSON+    , Value+    , defaultOptions+    , genericToEncoding+    , genericToJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types (fieldLabelModifier, omitNothingFields)+import Data.String      (IsString)+import Data.Time        (UTCTime)+import Data.UUID        (UUID, toText)++import GHC.Generics (Generic)++import Rollbar.Item.Body        (Body)+import Rollbar.Item.CodeVersion (CodeVersion)+import Rollbar.Item.Environment (Environment)+import Rollbar.Item.Hardcoded   (Hardcoded)+import Rollbar.Item.Level       (Level)+import Rollbar.Item.Person      (Person)+import Rollbar.Item.Request     (Request)+import Rollbar.Item.Server      (Server)++import Rollbar.Item.Internal.Notifier (Notifier)+import Rollbar.Item.Internal.Platform (Platform)++import qualified Data.HashMap.Lazy as HM+import qualified Data.Text         as T++-- | The main payload of an item.+--  Most of this is metadata.+--+--  N.B. While it's entirely possible for you to create one of these yourself,+--  it's usually easier to use helpers like 'info' and 'error'.+data Data body+    = Data+        { body        :: Body body+        , codeVersion :: CodeVersion+        -- ^ Metadata about this package. You probably shouldn't create this yourself.+        , context     :: Maybe Context+        , custom      :: Maybe (HM.HashMap T.Text Value)+        , environment :: Environment+        , fingerprint :: Maybe Fingerprint+        , framework   :: Maybe Framework+        , language    :: Hardcoded "haskell"+        , level       :: Level+        , notifier    :: Notifier+        -- ^ Metadata about this package. You probably shouldn't create this yourself.+        , person      :: Maybe Person+        , platform    :: Platform+        -- ^ Metadata about this package. You probably shouldn't create this yourself.+        , request     :: Maybe Request+        , server      :: Maybe Server+        , timestamp   :: Maybe UTCTime+        , title       :: Maybe Title+        , uuid        :: Maybe UUID4+        }+    deriving (Eq, Generic, Show)++instance ToJSON body => ToJSON (Data body) where+    toJSON = genericToJSON defaultOptions+        { fieldLabelModifier = codeVersionModifier+        , omitNothingFields = True+        }+    toEncoding = genericToEncoding defaultOptions+        { fieldLabelModifier = codeVersionModifier+        , omitNothingFields = True+        }++codeVersionModifier :: (Eq s, IsString s) => s -> s+codeVersionModifier = \case+    "codeVersion" -> "code_version"+    str -> str++-- | The framework that is using this package.+--  E.g. "scotty", "servant", "yesod"+newtype Framework+    = Framework T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | The place in the code where this item came from.+newtype Context+    = Context T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | How to group the item.+newtype Fingerprint+    = Fingerprint T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | The title of the item.+newtype Title+    = Title T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | A unique identifier for each item.+newtype UUID4+    = UUID4 UUID+    deriving (Eq, Generic, Show)++instance ToJSON UUID4 where+    toJSON (UUID4 u) = toJSON (toText u)+    toEncoding (UUID4 u) = toEncoding (toText u)
+ src/Rollbar/Item/Environment.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.Item.Environment+    Description : The environment from which this package is running.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Environment+    ( Environment(..)+    ) where++import Data.Aeson  (ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should be something meaningful to your program.+--  E.g. "development", "production", "staging"+newtype Environment+    = Environment T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ src/Rollbar/Item/Hardcoded.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}++{-|+    Module      : Rollbar.Item.Hardcoded+    Description : Provides a way to hard code a value in JSOn+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Probably this could live outside the package...+-}++module Rollbar.Item.Hardcoded+    ( Hardcoded(..)+    ) where++import Data.Aeson (ToJSON, toEncoding, toJSON)++import GHC.Generics (Generic)+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)++-- | This is basically 'Data.Proxy' with the variable restricted to 'Symbol'.+--  It's mostly useful so a value can be insert into a JSON blob easily.+data Hardcoded (symbol :: Symbol)+    = Hardcoded+    deriving (Eq, Generic, Show)++instance KnownSymbol symbol => ToJSON (Hardcoded symbol) where+    toJSON = toJSON . symbolVal+    toEncoding = toEncoding . symbolVal
+ src/Rollbar/Item/Internal/Notifier.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Internal.Notifier+    Description : Metadata about this actual package+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Mostly, you shouldn't have to worry about this.+-}++module Rollbar.Item.Internal.Notifier+    ( Notifier(..)+    ) where++import Data.Aeson   (ToJSON, defaultOptions, genericToEncoding, toEncoding)+import Data.Version (Version)++import GHC.Generics (Generic)++import Rollbar.Item.Hardcoded (Hardcoded)++-- | Metadata describing this package.+data Notifier+    = Notifier+        { name    :: Hardcoded "wai-middleware-rollbar"+        -- ^ The name of this package+        , version :: Version+        -- ^ The version of this package+        }+    deriving (Eq, Generic, Show)++instance ToJSON Notifier where+    toEncoding = genericToEncoding defaultOptions
+ src/Rollbar/Item/Internal/Platform.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+    Module      : Rollbar.Item.Internal.Platform+    Description : Metadata describing the platform this package is running on.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Mostly, you shouldn't have to worry about this.+-}++module Rollbar.Item.Internal.Platform+    ( Platform(..)+    ) where++import Data.Aeson  (ToJSON)+import Data.String (IsString)++import qualified Data.Text as T++-- | Should be something meaningful to rollbar, like "linux".+newtype Platform+    = Platform T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ src/Rollbar/Item/Level.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveGeneric #-}++{-|+    Module      : Rollbar.Item.Level+    Description : The severity of the item.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Level+    ( Level(..)+    ) where++import Data.Aeson+    ( ToJSON+    , defaultOptions+    , genericToEncoding+    , genericToJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types (constructorTagModifier)+import Data.Char        (toLower)++import GHC.Generics (Generic)++-- | Corresponds to the levels Rollbar allows in order of severity.+data Level+    = Debug+    | Info+    | Warning+    | Error+    | Critical+    deriving (Bounded, Enum, Eq, Generic, Ord, Show)++instance ToJSON Level where+    toJSON = genericToJSON defaultOptions+        { constructorTagModifier = fmap toLower+        }+    toEncoding = genericToEncoding defaultOptions+        { constructorTagModifier = fmap toLower+        }
+ src/Rollbar/Item/Person.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+    Module      : Rollbar.Item.Person+    Description : The user this item affects.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Person+    ( Person(..)+    , Id(..)+    , Username(..)+    , Email(..)+    ) where++import Data.Aeson+    ( ToJSON+    , defaultOptions+    , genericToEncoding+    , genericToJSON+    , toEncoding+    , toJSON+    )+import Data.Aeson.Types (omitNothingFields)+import Data.String      (IsString)++import GHC.Generics (Generic)++import qualified Data.Text as T++-- | The affected user.+--+--  The 'Email' and 'Username' associated with the latest 'Id'+--  will overwrite any previous.+data Person+    = Person+        { id       :: Id+        , username :: Maybe Username+        , email    :: Maybe Email+        }+    deriving (Eq, Generic, Show)++instance ToJSON Person where+    toJSON = genericToJSON defaultOptions { omitNothingFields = True }+    toEncoding = genericToEncoding defaultOptions { omitNothingFields = True }++-- | The user's identifier. This uniquely identifies a 'Person' to Rollbar.+newtype Id+    = Id T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | The user's name.+newtype Username+    = Username T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | The user's email.+newtype Email+    = Email T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ src/Rollbar/Item/Request.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-|+    Module      : Rollbar.Item.Request+    Description : Data about the request sent to the server.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Request+    ( Request(..)+    , Get(..)+    , Headers(..)+    , IP(..)+    , Method(..)+    , QueryString(..)+    , RawBody(..)+    , URL(..)+    ) where++import Data.Aeson+    (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.CaseInsensitive (original)+import Data.Maybe           (catMaybes, fromMaybe)+import Data.String          (IsString)++import GHC.Generics (Generic)++import Network.HTTP.Types (Header, Query, RequestHeaders)+import Network.Socket     (SockAddr)++import qualified Data.ByteString    as BS+import qualified Data.Text          as T+import qualified Data.Text.Encoding as TE++-- | Data sent to the server+data Request+    = Request+        { rawBody     :: RawBody+        , get         :: Get+        -- ^ Query parameters+        , headers     :: Headers+        , method      :: Method+        , queryString :: QueryString+        -- ^ The entire query string+        , url         :: URL+        , userIP      :: IP+        -- ^ The client's IP address+        }+    deriving (Eq, Generic, Show)++-- | The raw request body as a 'BS.ByteString'.+newtype RawBody+    = RawBody BS.ByteString+    deriving (Eq, Generic, IsString, Show)++instance ToJSON RawBody where+    toJSON (RawBody body) = toJSON (myDecodeUtf8 body)+    toEncoding (RawBody body) = toEncoding (myDecodeUtf8 body)++-- | The query string parameters as a more useful data structure.+newtype Get+    = Get Query+    deriving (Eq, Generic, Show)++instance ToJSON Get where+    toJSON (Get q) = object . catMaybes . queryKVs $ q+    toEncoding (Get q) = pairs . mconcat . catMaybes . queryKVs $ q++queryKVs :: forall kv. (KeyValue kv) => Query -> [Maybe kv]+queryKVs = fmap go+    where+    go :: (BS.ByteString, Maybe BS.ByteString) -> Maybe kv+    go (key', val') = do+        key <- myDecodeUtf8 key'+        let val = val' >>= myDecodeUtf8+        pure (key .= val)++-- | The request headers+newtype Headers+    = Headers RequestHeaders+    deriving (Eq, Generic, Show)++instance ToJSON Headers where+    toJSON (Headers hs) = object . catMaybes . requestHeadersKVs $ hs+    toEncoding (Headers hs) = pairs . mconcat . catMaybes . requestHeadersKVs $ hs++requestHeadersKVs :: forall kv. KeyValue kv => RequestHeaders -> [Maybe kv]+requestHeadersKVs = fmap go+    where+    go :: Header -> Maybe kv+    go (key', val') = do+        key <- myDecodeUtf8 $ original key'+        val <- myDecodeUtf8 val'+        pure (T.pack (show key) .= val)++-- | The HTTP Verb+newtype Method+    = Method BS.ByteString+    deriving (Eq, Generic, Show)++instance ToJSON Method where+    toJSON (Method q) = toJSON (myDecodeUtf8 q)+    toEncoding (Method q) = toEncoding (myDecodeUtf8 q)++-- | The raw querystring.+newtype QueryString+    = QueryString BS.ByteString+    deriving (Eq, Generic, Show)++instance ToJSON QueryString where+    toJSON (QueryString q) = toJSON (myDecodeUtf8' q)+    toEncoding (QueryString q) = toEncoding (myDecodeUtf8' q)++-- | The IP address of the client.+newtype IP+    = IP SockAddr+    deriving (Eq, Generic, Show)++instance ToJSON IP where+    toJSON (IP ip) = toJSON (show ip)+    toEncoding (IP ip) = toEncoding (show ip)++requestKVs :: KeyValue kv => Request -> [kv]+requestKVs Request{..} =+    [ "body" .= rawBody+    , "GET" .= get+    , "headers" .= headers+    , "method" .= method+    , "query_string" .= queryString+    , "url" .= url+    , "user_ip" .= userIP+    ]++instance ToJSON Request where+    toJSON = object . requestKVs+    toEncoding = pairs . mconcat . requestKVs++-- | The URL as a slightly more useful structure.+newtype URL+    = URL (Maybe BS.ByteString, [T.Text])+    deriving (Eq, Generic, Show)++prettyURL :: URL -> T.Text+prettyURL (URL (host, parts)) =+    T.intercalate "/" (fromMaybe "" (host >>= myDecodeUtf8) : parts)++instance ToJSON URL where+    toJSON = toJSON . prettyURL+    toEncoding = toEncoding . prettyURL++myDecodeUtf8 :: BS.ByteString -> Maybe T.Text+myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'++myDecodeUtf8' :: BS.ByteString -> T.Text+myDecodeUtf8' = fromMaybe "" . myDecodeUtf8
+ src/Rollbar/Item/Server.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+    Module      : Rollbar.Item.Server+    Description : Metadata about the server this package is running on.+    Copyright   : (c) Hardy Jones, 2017+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental+-}++module Rollbar.Item.Server+    ( Server(..)+    , Root(..)+    , Branch(..)+    ) where++import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.Maybe  (catMaybes)+import Data.String (IsString)++import GHC.Generics (Generic)++import Network.HostName (HostName)++import Rollbar.Item.CodeVersion (CodeVersion)++import qualified Data.Text as T++-- | Information about the server using this package.+data Server+    = Server+        { host              :: Maybe HostName+        -- ^ The hostname of the server.+        , root              :: Maybe Root+        -- ^ The root directory the server is running in.+        , branch            :: Maybe Branch+        -- ^ The checked out branch the server is running on.+        , serverCodeVersion :: Maybe CodeVersion+        -- ^ The version of the server.+        }+    deriving (Eq, Generic, Show)++serverKVs :: KeyValue kv => Server -> [Maybe kv]+serverKVs Server{..} =+    [ ("host" .=) <$> host+    , ("root" .=) <$> root+    , ("branch" .=) <$> branch+    , ("code_version" .=) <$> serverCodeVersion+    ]++instance ToJSON Server where+    toJSON = object . catMaybes . serverKVs+    toEncoding = pairs . mconcat . catMaybes . serverKVs++-- | The root directory.+newtype Root+    = Root T.Text+    deriving (Eq, IsString, Show, ToJSON)++-- | The git branch the server is running on.+newtype Branch+    = Branch T.Text+    deriving (Eq, IsString, Show, ToJSON)
+ wai-middleware-rollbar.cabal view
@@ -0,0 +1,53 @@+name:                wai-middleware-rollbar+version:             0.1.0.0+synopsis:            Middleware that communicates to Rollbar.+description:         Middleware that communicates to Rollbar.+homepage:            https://github.com/joneshf/wai-middleware-rollbar#readme+license:             BSD3+license-file:        LICENSE+author:              Hardy Jones+maintainer:          jones3.hardy@gmail.com+copyright:           2017 Hardy Jones+category:            Web, Wai+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Network.Wai.Middleware.Rollbar+                     , Rollbar.Item+                     , Rollbar.AccessToken+                     , Rollbar.Item.Body+                     , Rollbar.Item.Data+                     , Rollbar.Item.CodeVersion+                     , Rollbar.Item.Environment+                     , Rollbar.Item.Hardcoded+                     , Rollbar.Item.Level+                     , Rollbar.Item.Person+                     , Rollbar.Item.Request+                     , Rollbar.Item.Server++                     , Rollbar.Item.Internal.Notifier+                     , Rollbar.Item.Internal.Platform+  other-modules:       Paths_wai_middleware_rollbar+  build-depends:       base >= 4.7 && < 5+                     , aeson >= 1.0 && < 1.1+                     , bytestring >= 0.10 && < 0.11+                     , case-insensitive >= 1.2 && < 1.3+                     , hostname >= 1.0 && < 1.1+                     , http-client >= 0.5 && < 0.6+                     , http-conduit >= 2.2 && < 2.3+                     , http-types >= 0.9 && < 0.10+                     , network >= 2.6 && < 2.7+                     , text >= 1.2 && < 1.3+                     , time >= 1.6 && < 1.7+                     , unordered-containers >= 0.2 && < 0.3+                     , uuid >= 1.3 && < 1.4+                     , wai >= 3.2 && < 3.3+  default-language:    Haskell2010+  ghc-options:        -Wall++source-repository head+  type:     git+  location: https://github.com/joneshf/wai-middleware-rollbar