wai-middleware-rollbar 0.8.4 → 0.9.0

raw patch · 24 files changed

+81/−1628 lines, 24 filesdep +rollbar-hsdep −QuickCheckdep −case-insensitivedep −containersdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: rollbar-hs

Dependencies removed: QuickCheck, case-insensitive, containers, hspec, hspec-golden-aeson, lens, lens-aeson, network, unordered-containers, wai-middleware-rollbar

Dependency ranges changed: aeson, base, bytestring, text

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/Rollbar.hs +39/−41
• src/Network/Wai/Middleware/Rollbar/Payload.hs +39/−0
• src/Rollbar/API.hs +0/−172
• src/Rollbar/AccessToken.hs +0/−24
• src/Rollbar/Item.hs +0/−215
• src/Rollbar/Item/Body.hs +0/−74
• src/Rollbar/Item/CodeVersion.hs +0/−50
• src/Rollbar/Item/Data.hs +0/−144
• src/Rollbar/Item/Environment.hs +0/−25
• src/Rollbar/Item/Hardcoded.hs +0/−42
• src/Rollbar/Item/Internal/Notifier.hs +0/−40
• src/Rollbar/Item/Internal/Platform.hs +0/−26
• src/Rollbar/Item/Level.hs +0/−51
• src/Rollbar/Item/MissingHeaders.hs +0/−76
• src/Rollbar/Item/Person.hs +0/−67
• src/Rollbar/Item/Request.hs +0/−202
• src/Rollbar/Item/Server.hs +0/−89
• test/Main.hs +0/−14
• test/Rollbar/Golden.hs +0/−14
• test/Rollbar/Item/Data/Test.hs +0/−36
• test/Rollbar/Item/MissingHeaders/Test.hs +0/−85
• test/Rollbar/Item/Request/Test.hs +0/−42
• test/Rollbar/QuickCheck.hs +0/−53
• wai-middleware-rollbar.cabal +3/−46

@@ -3,7 +3,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}  {-|@@ -27,17 +26,16 @@     (Handler(Handler), SomeException, catches, displayException, throwIO) import Control.Monad      (when) -import Data.Aeson   (ToJSON, defaultOptions, genericToEncoding, toEncoding)+import Data.Aeson   (ToJSON) import Data.Functor (void) import Data.Maybe   (fromMaybe) import Data.Time    (getCurrentTime) import Data.UUID.V4 (nextRandom) -import GHC.Generics (Generic) import GHC.TypeLits (Symbol) -import Network.HostName          (getHostName)-import Network.HTTP.Client       (HttpException)+import Network.HostName                       (getHostName)+import Network.HTTP.Client                    (HttpException) import Network.HTTP.Simple     ( JSONException     , Request@@ -53,16 +51,18 @@     ) import Network.HTTP.Types.Status     (Status(Status), statusCode, statusIsServerError, statusMessage)-import Network.Wai               (Middleware, ResponseReceived)+import Network.Wai                            (Middleware, ResponseReceived)+import Network.Wai.Middleware.Rollbar.Payload (Payload)  import System.Environment (getExecutablePath) import System.IO          (hPutStrLn, stderr) -import qualified Data.ByteString    as BS-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+import qualified Data.ByteString                        as BS+import qualified Data.Text                              as T+import qualified Data.Text.Encoding                     as TE+import qualified Network.Wai                            as NW+import qualified Network.Wai.Middleware.Rollbar.Payload as Payload+import qualified Rollbar.Item                           as RI  -- | Set up the middleware properly --  The `headers` are  what you want removed from@@ -71,7 +71,7 @@     = Settings         { accessToken :: RI.AccessToken         -- ^ Should have a scope "post_server_item".-        , branch :: Maybe RI.Branch+        , branch      :: Maybe RI.Branch         -- ^ Should be the branch of the running application.         --         -- Will default to `master` if not set.@@ -128,14 +128,17 @@     rReq <- mkRollbarRequest settings req payload messageBody     void $ httpNoBody rReq     where-    Status{..} = NW.responseStatus res+    Status{statusCode, statusMessage} = NW.responseStatus res     messageBody = RI.MessageBody <$> myDecodeUtf8 statusMessage     referer = myDecodeUtf8 =<< NW.requestHeaderReferer req     range = myDecodeUtf8 =<< NW.requestHeaderRange req     userAgent = myDecodeUtf8 =<< NW.requestHeaderUserAgent req-    payload = RequestPayload-        { statusMessage = myDecodeUtf8' statusMessage-        , ..+    payload = Payload.RequestPayload+        { Payload.range+        , Payload.referer+        , Payload.statusCode+        , Payload.statusMessage = myDecodeUtf8' statusMessage+        , Payload.userAgent         }  handleHttpException :: HttpException -> IO ()@@ -170,7 +173,12 @@     referer = myDecodeUtf8 =<< NW.requestHeaderReferer req     range = myDecodeUtf8 =<< NW.requestHeaderRange req     userAgent = myDecodeUtf8 =<< NW.requestHeaderUserAgent req-    payload = ExceptionPayload {..}+    payload = Payload.ExceptionPayload+      { Payload.exception+      , Payload.referer+      , Payload.range+      , Payload.userAgent+      }  mkRollbarRequest     :: forall headers@@ -180,16 +188,25 @@     -> Payload     -> Maybe RI.MessageBody     -> IO Request-mkRollbarRequest Settings{..} req payload messageBody = do+mkRollbarRequest Settings{accessToken, branch, codeVersion, environment} req payload messageBody = 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.serverCodeVersion = codeVersion, .. }+    let request = Just RI.Request+          { RI.get+          , RI.headers+          , RI.method+          , RI.queryString+          , RI.rawBody+          , RI.url+          , RI.userIP+          }+    let server = Just RI.Server+          { RI.branch, RI.host, RI.root, RI.serverCodeVersion = codeVersion }     let itemData = (RI.error environment messageBody payload)-            { RI.codeVersion, RI.request, RI.server, RI.timestamp, RI.uuid }-    pure $ rollbarRequest RI.Item{..}+          { RI.codeVersion, RI.request, RI.server, RI.timestamp, RI.uuid }+    pure $ rollbarRequest RI.Item{RI.accessToken, RI.itemData}     where     headers :: RI.MissingHeaders headers     headers = RI.MissingHeaders $ NW.requestHeaders req@@ -219,22 +236,3 @@     . setRequestBodyJSON payload     . setRequestIgnoreStatus     $ defaultRequest--data Payload-    = RequestPayload-        { statusCode    :: Int-        , statusMessage :: T.Text-        , userAgent     :: Maybe T.Text-        , range         :: Maybe T.Text-        , referer       :: Maybe T.Text-        }-    | ExceptionPayload-        { exception :: T.Text-        , userAgent :: Maybe T.Text-        , range     :: Maybe T.Text-        , referer   :: Maybe T.Text-        }-    deriving (Generic, Show)--instance ToJSON Payload where-    toEncoding = genericToEncoding defaultOptions

@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveGeneric #-}++{-|+    Module      : Network.Wai.Middleware.Rollbar.Payload+    Description : The payload to send to Rollbar+    Copyright   : (c) Hardy Jones, 2018+    License     : BSD3+    Maintainer  : jones3.hardy@gmail.com+    Stability   : experimental++    Provides the payload for communicating with Rollbar.+-}++module Network.Wai.Middleware.Rollbar.Payload where++import Data.Aeson (ToJSON, defaultOptions, genericToEncoding, toEncoding)++import GHC.Generics (Generic)++import qualified Data.Text as T++data Payload+    = RequestPayload+        { statusCode    :: Int+        , statusMessage :: T.Text+        , userAgent     :: Maybe T.Text+        , range         :: Maybe T.Text+        , referer       :: Maybe T.Text+        }+    | ExceptionPayload+        { exception :: T.Text+        , userAgent :: Maybe T.Text+        , range     :: Maybe T.Text+        , referer   :: Maybe T.Text+        }+    deriving (Generic, Show)++instance ToJSON Payload where+    toEncoding = genericToEncoding defaultOptions

@@ -1,172 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}--{-|-    Module      : Rollbar.API-    Description : Codifies Rollbar's API-    Copyright   : (c) Hardy Jones, 2017-    License     : BSD3-    Maintainer  : jones3.hardy@gmail.com-    Stability   : experimental--    Provides functions for communicating with Rollbar through the public API.--    See Rollbar's <https://rollbar.com/docs/api/ API> for more details.--}-module Rollbar.API-    ( -- * Helpful functions-      -- | These functions are probably what you want most of the time.-      itemsPOST-    , itemsPOST'-    , itemsPOSTRaw-    , itemsPOSTRaw'-    , makeRequest-    -- * Response data types-    , ItemsPOSTResponse(..)-    , ItemsPOSTErrorMessage(..)-    , ItemsPOSTSuccessResult(..)-    -- * Impure functions-    -- | Use with caution.-    , itemsPOSTWithException-    ) where--import Control.Monad.IO.Class (MonadIO)--import Data.Aeson.Types-    ( FromJSON(parseJSON)-    , SumEncoding(UntaggedValue)-    , ToJSON-    , defaultOptions-    , fieldLabelModifier-    , genericParseJSON-    , sumEncoding-    )-import Data.Text  (Text)--import GHC.Generics (Generic)--import Network.HTTP.Client-    ( Manager-    , Request(host, method, path, port, secure)-    , Response-    , defaultRequest-    , setRequestIgnoreStatus-    )-import Network.HTTP.Simple-    ( JSONException-    , httpJSON-    , httpJSONEither-    , setRequestBodyJSON-    , setRequestManager-    )--import Rollbar.Item (Item, RemoveHeaders, UUID4)---- | The response received from sending an 'Rollbar.Item.Item' to Rollbar.-data ItemsPOSTResponse-    = ItemsPOSTSuccess-        { err_ItemsPOSTSuccess    :: Int-        -- ^ This `err` field is always 0.-        , result_ItemsPOSTSuccess :: ItemsPOSTSuccessResult-        -- ^ The part you probably care about.-        }-    | ItemsPOSTError-        { err_ItemsPOSTError     :: Int-        -- ^ This `err` field is always 1.-        , message_ItemsPOSTError :: Text-        -- ^ A human-readable message describing the error.-        }-    deriving (Eq, Generic, Show)--instance FromJSON ItemsPOSTResponse where-    parseJSON = genericParseJSON defaultOptions-        { fieldLabelModifier = takeWhile (/= '_')-        , sumEncoding = UntaggedValue-        }---- | The successful response from sending an 'Rollbar.Item.Item' to Rollbar.-newtype ItemsPOSTSuccessResult-    = ItemsPOSTSuccessResult-        { uuid :: UUID4-        -- ^ 'Rollbar.Item.UUID4' of the item.-        --   Matches sent 'Rollbar.Item.UUID4' or generated by Rollbar if missing.-        }-    deriving (Eq, FromJSON, Generic, Show)---- | The human readable error message from sending an 'Rollbar.Item.Item' to Rollbar.-newtype ItemsPOSTErrorMessage-    = ItemsPOSTErrorMessage Text-    deriving (Eq, FromJSON, Generic, Show)---- | Sends an 'Rollbar.Item.Item' off to Rollbar.------   Creates a new 'Network.HTTP.Client.Manager' to send off the request.-itemsPOST-    :: (MonadIO f, RemoveHeaders b, ToJSON a)-    => Item a b-    -> f (Response (Either JSONException ItemsPOSTResponse))-itemsPOST = itemsPOSTRaw---- | Sends an 'Rollbar.Item.Item' off to Rollbar.-itemsPOST'-    :: (MonadIO f, RemoveHeaders b, ToJSON a)-    => Manager-    -> Item a b-    -> f (Response (Either JSONException ItemsPOSTResponse))-itemsPOST' = itemsPOSTRaw'---- | Sends an 'Rollbar.Item.Item' off to Rollbar.------   Creates a new 'Network.HTTP.Client.Manager' to send off the request.---   Makes no claims about what you get back.-itemsPOSTRaw-    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)-    => Item a b-    -> f (Response (Either JSONException c))-itemsPOSTRaw = httpJSONEither . makeRequest---- | Sends an 'Rollbar.Item.Item' off to Rollbar.------   Makes no claims about what you get back.-itemsPOSTRaw'-    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)-    => Manager-    -> Item a b-    -> f (Response (Either JSONException c))-itemsPOSTRaw' manager = httpJSONEither . setRequestManager manager . makeRequest---- | Sends an 'Rollbar.Item.Item' off to Rollbar.------   Creates a new 'Network.HTTP.Client.Manager' to send off the request.---   Makes no claims about what you get back.---   Throws a 'Network.HTTP.Simple.JSONException' if it cannot parse the response.------   Yes, this name is annoying, so are exceptions.-itemsPOSTWithException-    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)-    => Item a b-    -> f (Response c)-itemsPOSTWithException = httpJSON . makeRequest---- | Converts an item into a request ready to send to Rollbar.------   If you need a different scheme for sending items,---   you'll probably want to use this along with a function like 'Network.HTTP.Client.httpLbs'---   or 'Network.HTTP.Simple.httpLbs'.------   If you want the JSON back and already have a 'Network.HTTP.Client.Manager',---   you can use this function with 'Network.HTTP.Simple.setRequestManager'.---   Then send off the request with something like 'Network.HTTP.Simple.httpJSONEither'.-makeRequest :: (RemoveHeaders headers, ToJSON a) => Item a headers -> Request-makeRequest payload =-    setRequestBodyJSON payload-        . setRequestIgnoreStatus-        $ defaultRequest-            { host = "api.rollbar.com"-            , method = "POST"-            , path = "api/1/item/"-            , port = 443-            , secure = True-            }

@@ -1,24 +0,0 @@-{-# 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  (FromJSON, 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, FromJSON, IsString, Show, ToJSON)

@@ -1,215 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeOperators #-}--{-|-    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.MissingHeaders-    , MissingHeaders(..)--    , module Rollbar.Item.Person-    , Person(..)-    , Email(..)-    , Id(..)-    , Username(..)--    , module Rollbar.Item.Request-    , Get(..)-    , IP(..)-    , Method(..)-    , MissingHeaders(..)-    , QueryString(..)-    , RawBody(..)-    , URL(..)--    , module Rollbar.Item.Server-    , Server(..)-    , Branch(..)-    , Root(..)-    ) where--import Data.Aeson-    ( FromJSON-    , KeyValue-    , ToJSON-    , Value(Object)-    , object-    , pairs-    , parseJSON-    , toEncoding-    , toJSON-    , (.:)-    , (.=)-    )-import Data.Aeson.Types (typeMismatch)-import Data.Maybe       (fromMaybe)--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.MissingHeaders-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 ("Authorization" ': headers)-debug environment messageBody payload =-    Data-        { body = Message (fromMaybe "" messageBody) payload-        , codeVersion = Nothing-        , 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 ("Authorization" ': headers)-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 ("Authorization" ': headers)-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 ("Authorization" ': headers)-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 ("Authorization" ': headers)-critical environment messageBody payload =-    (debug environment messageBody payload) { level = Critical }---- | The thing we actually give to Rollbar.-data Item a headers-    = Item-        { accessToken :: AccessToken-        -- ^ Should have a scope "post_server_item".-        , itemData    :: Data a headers-        }-    deriving (Eq, Generic, Show)--itemKVs-    :: (KeyValue kv, RemoveHeaders headers, ToJSON v)-    => Item v headers-    -> [kv]-itemKVs Item{..} =-    [ "access_token" .= accessToken-    , "data" .= itemData-    ]--instance FromJSON a => FromJSON (Item a headers) where-    parseJSON (Object o) = Item <$> o .: "access_token" <*> o .: "data"-    parseJSON v          = typeMismatch "Item a headers" v--instance (RemoveHeaders headers, ToJSON a) => ToJSON (Item a headers) where-    toJSON = object . itemKVs-    toEncoding = pairs . mconcat . itemKVs

@@ -1,74 +0,0 @@-{-# 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-    ( FromJSON-    , KeyValue-    , ToJSON-    , Value(Object)-    , object-    , pairs-    , parseJSON-    , toEncoding-    , toJSON-    , (.:)-    , (.=)-    )-import Data.Aeson.Encoding (pair)-import Data.Aeson.Types    (typeMismatch)-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 FromJSON arbitrary => FromJSON (Body arbitrary) where-    parseJSON (Object o') = do-        o <- o' .: "message"-        Message <$> o .: "body" <*> o .: "data"-    parseJSON v = typeMismatch "Body arbitrary" v--instance ToJSON arbitrary => ToJSON (Body arbitrary) where-    toJSON x = object ["message" .= object (bodyKVs x)]-    toEncoding = pairs . pair "message" . pairs . mconcat . bodyKVs---- | The primary message text to send to Rollbar.-newtype MessageBody-    = MessageBody T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,50 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}--{-|-    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       (FromJSON, ToJSON, parseJSON, toEncoding, toJSON)-import Data.Aeson.Types (typeMismatch)--import GHC.Generics (Generic)--import qualified Data.Aeson as A-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 FromJSON CodeVersion where-    parseJSON (A.String s) = case T.splitOn "." s of-        [_major, _minor, _patch] -> pure $ SemVer s-        _                        -> pure $ SHA s-    parseJSON (A.Number n) = pure $ Number $ floor n-    parseJSON v = typeMismatch "CodeVersion" v--instance ToJSON CodeVersion where-    toJSON = toJSON . prettyCodeVersion-    toEncoding = toEncoding . prettyCodeVersion

@@ -1,144 +0,0 @@-{-# 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(..)--    , RemoveHeaders-    ) where--import Data.Aeson-    ( FromJSON-    , ToJSON-    , Value(String)-    , defaultOptions-    , genericParseJSON-    , genericToEncoding-    , genericToJSON-    , parseJSON-    , toEncoding-    , toJSON-    )-import Data.Aeson.Types-    (Options, fieldLabelModifier, omitNothingFields, typeMismatch)-import Data.String      (IsString)-import Data.Time        (UTCTime)-import Data.UUID        (UUID, fromText, 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     (RemoveHeaders, 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 headers-    = Data-        { body        :: Body body-        , codeVersion :: Maybe CodeVersion-        , 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 headers)-        , server      :: Maybe Server-        , timestamp   :: Maybe UTCTime-        , title       :: Maybe Title-        , uuid        :: Maybe UUID4-        }-    deriving (Eq, Generic, Show)--instance FromJSON body => FromJSON (Data body headers) where-    parseJSON = genericParseJSON options--instance (RemoveHeaders headers, ToJSON body) => ToJSON (Data body headers) where-    toJSON = genericToJSON options-    toEncoding = genericToEncoding options--options :: Options-options = 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, FromJSON, IsString, Show, ToJSON)---- | The place in the code where this item came from.-newtype Context-    = Context T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)---- | How to group the item.-newtype Fingerprint-    = Fingerprint T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)---- | The title of the item.-newtype Title-    = Title T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)---- | A unique identifier for each item.-newtype UUID4-    = UUID4 UUID-    deriving (Eq, Generic, Show)--instance FromJSON UUID4 where-    parseJSON v@(String s) =-        maybe (typeMismatch "UUID4" v) (pure . UUID4) $ fromText s-    parseJSON v = typeMismatch "UUID4" v--instance ToJSON UUID4 where-    toJSON (UUID4 u) = toJSON (toText u)-    toEncoding (UUID4 u) = toEncoding (toText u)

@@ -1,25 +0,0 @@-{-# 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  (FromJSON, 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, FromJSON, IsString, Show, ToJSON)

@@ -1,42 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}--{-|-    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-    (FromJSON, ToJSON, Value(String), parseJSON, toEncoding, toJSON)-import Data.Aeson.Types (typeMismatch)-import Data.Text        (pack)--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--instance KnownSymbol symbol => FromJSON (Hardcoded symbol) where-    parseJSON (String str)-        | str == pack (symbolVal (Hardcoded :: Hardcoded symbol)) = pure Hardcoded-    parseJSON v = typeMismatch "Hardcoded symbol" v

@@ -1,40 +0,0 @@-{-# 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-    (FromJSON, 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 FromJSON Notifier-instance ToJSON Notifier where-    toEncoding = genericToEncoding defaultOptions

@@ -1,26 +0,0 @@-{-# 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  (FromJSON, 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, FromJSON, IsString, Show, ToJSON)

@@ -1,51 +0,0 @@-{-# 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-    ( FromJSON-    , ToJSON-    , defaultOptions-    , genericParseJSON-    , genericToEncoding-    , genericToJSON-    , parseJSON-    , toEncoding-    , toJSON-    )-import Data.Aeson.Types (Options, 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 FromJSON Level where-    parseJSON = genericParseJSON options--instance ToJSON Level where-    toJSON = genericToJSON options-    toEncoding = genericToEncoding options--options :: Options-options = defaultOptions-    { constructorTagModifier = fmap toLower-    }

@@ -1,76 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--{-|-    Module      : Rollbar.Item.MissingHeaders-    Description : Headers with some missing from the JSON instance.-    Copyright   : (c) Hardy Jones, 2017-    License     : BSD3-    Maintainer  : jones3.hardy@gmail.com-    Stability   : experimental--}--module Rollbar.Item.MissingHeaders-    ( MissingHeaders(..)-    , RemoveHeaders-    ) where--import Data.Aeson-    (FromJSON, KeyValue, ToJSON, object, parseJSON, toJSON, (.=))-import Data.Bifunctor       (bimap)-import Data.CaseInsensitive (mk, original)-import Data.Maybe           (catMaybes)-import Data.Proxy           (Proxy(Proxy))--import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)--import Network.HTTP.Types (Header, RequestHeaders)--import qualified Data.ByteString       as BS-import qualified Data.ByteString.Char8 as BSC8-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as TE---- | The request headers with some missing------  This is useful for removing sensitive information---  like the `Authorization` header.-newtype MissingHeaders (headers :: [Symbol])-    = MissingHeaders RequestHeaders-    deriving (Eq, Show)---- | Remove the headers given from the underlying request headers.-class RemoveHeaders (headers :: [Symbol]) where-    removeHeaders :: MissingHeaders headers -> RequestHeaders--instance RemoveHeaders '[] where-    removeHeaders (MissingHeaders rhs) = rhs--instance (KnownSymbol header, RemoveHeaders headers)-    => RemoveHeaders (header ': headers) where-    removeHeaders (MissingHeaders rhs) =-        removeHeaders (MissingHeaders $ filter go rhs :: MissingHeaders headers)-        where-        go (rh, _) =-            rh /= (mk . BSC8.pack $ symbolVal (Proxy :: Proxy header))--instance FromJSON (MissingHeaders headers) where-    parseJSON v = MissingHeaders . fmap (bimap (mk . BS.pack) BS.pack) <$> parseJSON v--instance RemoveHeaders headers => ToJSON (MissingHeaders headers) where-    toJSON = object . catMaybes . requestHeadersKVs . removeHeaders--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 (key .= val)--myDecodeUtf8 :: BS.ByteString -> Maybe T.Text-myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'

@@ -1,67 +0,0 @@-{-# 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-    ( FromJSON-    , 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 FromJSON Person-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, FromJSON, IsString, Show, ToJSON)---- | The user's name.-newtype Username-    = Username T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)---- | The user's email.-newtype Email-    = Email T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,202 +0,0 @@-{-# 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(..)-    , IP(..)-    , Method(..)-    , MissingHeaders(..)-    , QueryString(..)-    , RawBody(..)-    , URL(..)-    , RemoveHeaders-    ) where--import Data.Aeson-    ( FromJSON-    , KeyValue-    , ToJSON-    , Value(Object, String)-    , object-    , pairs-    , parseJSON-    , toEncoding-    , toJSON-    , (.:)-    , (.=)-    )-import Data.Aeson.Types (typeMismatch)-import Data.Bifunctor   (bimap)-import Data.Maybe       (catMaybes, fromMaybe)-import Data.String      (IsString)--import GHC.Generics (Generic)--import Network.HTTP.Types (Query)-import Network.Socket     (SockAddr(SockAddrInet), tupleToHostAddress)--import Rollbar.Item.MissingHeaders--import Text.Read (readMaybe)--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 headers-    = Request-        { rawBody     :: RawBody-        , get         :: Get-        -- ^ Query parameters-        , headers     :: MissingHeaders 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 FromJSON RawBody where-    parseJSON v = RawBody . BS.pack <$> parseJSON v--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 FromJSON Get where-    parseJSON v = Get . fmap (bimap BS.pack (fmap BS.pack)) <$> parseJSON v--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 HTTP Verb-newtype Method-    = Method BS.ByteString-    deriving (Eq, Generic, Show)--instance FromJSON Method where-    parseJSON v = Method . BS.pack <$> parseJSON v--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 FromJSON QueryString where-    parseJSON v = QueryString . BS.pack <$> parseJSON v--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 FromJSON IP where-    parseJSON v@(String s) = case T.splitOn "." s of-        [a', b', c', d] -> case T.splitOn ":" d of-            [e', f'] -> maybe (typeMismatch "IP" v) pure $ do-                [a, b, c, e] <- traverse (readMaybe . T.unpack) [a', b', c', e']-                f <- (readMaybe . T.unpack) f'-                pure . IP . SockAddrInet f $ tupleToHostAddress (a, b, c, e)-            _ -> typeMismatch "IP" v-        _ -> typeMismatch "IP" v-    parseJSON v = typeMismatch "IP" v--instance ToJSON IP where-    toJSON (IP ip) = toJSON (show ip)-    toEncoding (IP ip) = toEncoding (show ip)--requestKVs :: (KeyValue kv, RemoveHeaders headers) => Request headers -> [kv]-requestKVs Request{..} =-    [ "body" .= rawBody-    , "GET" .= get-    , "headers" .= headers-    , "method" .= method-    , "query_string" .= queryString-    , "url" .= url-    , "user_ip" .= userIP-    ]--instance FromJSON (Request headers) where-    parseJSON (Object o) =-        Request-            <$> o .: "body"-            <*> o .: "GET"-            <*> o .: "headers"-            <*> o .: "method"-            <*> o .: "query_string"-            <*> o .: "url"-            <*> o .: "user_ip"-    parseJSON v = typeMismatch "Request headers" v--instance (RemoveHeaders headers) => ToJSON (Request headers) 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 FromJSON URL where-    parseJSON (String s) = case T.splitOn "/" s of-        host:parts | "http" `T.isPrefixOf` host -> pure $ URL (Just $ TE.encodeUtf8 host, parts)-        parts -> pure $ URL (Nothing, parts)-    parseJSON v       = typeMismatch "URL" v--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

@@ -1,89 +0,0 @@-{-# 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-    ( FromJSON-    , KeyValue-    , ToJSON-    , Value(Object)-    , object-    , pairs-    , parseJSON-    , toEncoding-    , toJSON-    , (.:)-    , (.=)-    )-import Data.Aeson.Types (typeMismatch)-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 FromJSON Server where-    parseJSON (Object o) =-        Server-            <$> o .: "host"-            <*> o .: "root"-            <*> o .: "branch"-            <*> o .: "code_version"-    parseJSON v = typeMismatch "Server" v--instance ToJSON Server where-    toJSON = object . catMaybes . serverKVs-    toEncoding = pairs . mconcat . catMaybes . serverKVs---- | The root directory.-newtype Root-    = Root T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)---- | The git branch the server is running on.-newtype Branch-    = Branch T.Text-    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import qualified Rollbar.Golden-import qualified Rollbar.Item.Data.Test-import qualified Rollbar.Item.MissingHeaders.Test-import qualified Rollbar.Item.Request.Test--main :: IO ()-main = do-    Rollbar.Golden.main-    Rollbar.Item.Data.Test.props-    Rollbar.Item.MissingHeaders.Test.props-    Rollbar.Item.Request.Test.props

@@ -1,14 +0,0 @@-{-# LANGUAGE DataKinds #-}-module Rollbar.Golden where--import Data.Proxy (Proxy(Proxy))--import Rollbar.Item       (Item)-import Rollbar.QuickCheck ()--import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)-import Test.Hspec              (hspec)--main :: IO ()-main =-  hspec $ roundtripAndGoldenSpecs (Proxy :: Proxy (Item () '["Authorization"]))

@@ -1,36 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-module Rollbar.Item.Data.Test where--import Control.Lens ((^@..))--import Data.Aeson      (encode, toJSON)-import Data.Aeson.Lens (key, members)-import Data.Text       (Text)--import Rollbar.Item-import Rollbar.QuickCheck ()--import Test.QuickCheck (conjoin, quickCheck)--props :: IO ()-props =-    quickCheck $ conjoin-        [ prop_valueDataBodyHasRequiredKey-        , prop_encodingDataBodyHasRequiredKey-        ]--prop_valueDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool-prop_valueDataBodyHasRequiredKey x =-    length ms == 1 && fst (head ms) `elem` requiredBodyKeys-    where-    ms = toJSON x ^@.. key "body" . members--prop_encodingDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool-prop_encodingDataBodyHasRequiredKey x =-    length ms == 1 && fst (head ms) `elem` requiredBodyKeys-    where-    ms = encode x ^@.. key "body" . members--requiredBodyKeys :: [Text]-requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"]

@@ -1,85 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}-module Rollbar.Item.MissingHeaders.Test where--import Control.Lens ((&), (^@..))--import Data.Aeson      (encode, toJSON)-import Data.Aeson.Lens (members)--import Prelude hiding (error)--import Rollbar.Item.MissingHeaders (MissingHeaders(..))-import Rollbar.QuickCheck          ()--import Test.QuickCheck (conjoin, quickCheck)--import Data.Set as S--props :: IO ()-props = do-    quickCheck $ conjoin-        [ prop_valueAuthorizationIsRemoved-        , prop_encodingAuthorizationIsRemoved-        ]--    quickCheck $ conjoin-        [ prop_valueX_AccessTokenIsRemoved-        , prop_encodingX_AccessTokenIsRemoved-        ]--    quickCheck $ conjoin-        [ prop_valueAllHeadersAreRemoved-        , prop_encodingAllHeadersAreRemoved-        ]--prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool-prop_valueAuthorizationIsRemoved hs =-    "Authorization" `S.notMember` actual-    where-    actual = toJSON hs ^@.. members & fmap fst & S.fromList--prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool-prop_encodingAuthorizationIsRemoved hs =-    "Authorization" `S.notMember` actual-    where-    actual = encode hs ^@.. members & fmap fst & S.fromList--prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool-prop_valueX_AccessTokenIsRemoved hs =-    "X-AccessToken" `S.notMember` actual-    where-    actual = toJSON hs ^@.. members & fmap fst & S.fromList--prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool-prop_encodingX_AccessTokenIsRemoved hs =-    "X-AccessToken" `S.notMember` actual-    where-    actual = encode hs ^@.. members & fmap fst & S.fromList--prop_valueAllHeadersAreRemoved-    :: MissingHeaders-        '["Authorization", "this is made up", "Server", "X-AccessToken"]-    -> Bool-prop_valueAllHeadersAreRemoved hs =-    "Authorization" `S.notMember` actual-        && "this is made up" `S.notMember` actual-        && "Server" `S.notMember` actual-        && "X-AccessToken" `S.notMember` actual-    where-    actual = toJSON hs ^@.. members & fmap fst & S.fromList--prop_encodingAllHeadersAreRemoved-    :: MissingHeaders-        '["Authorization", "this is made up", "Server", "X-AccessToken"]-    -> Bool-prop_encodingAllHeadersAreRemoved hs =-    "Authorization" `S.notMember` actual-        && "this is made up" `S.notMember` actual-        && "Server" `S.notMember` actual-        && "X-AccessToken" `S.notMember` actual-    where-    actual = encode hs ^@.. members & fmap fst & S.fromList

@@ -1,42 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}-module Rollbar.Item.Request.Test where--import Control.Lens ((&), (^@..))--import Data.Aeson           (encode, toJSON)-import Data.Aeson.Lens      (members)-import Data.CaseInsensitive (original)--import Prelude hiding (error)--import Rollbar.Item.Request (MissingHeaders(..))-import Rollbar.QuickCheck   ()--import Test.QuickCheck (conjoin, quickCheck)--import Data.Set           as S-import Data.Text.Encoding as TE--props :: IO ()-props =-    quickCheck $ conjoin-        [ prop_valueHeadersArentWrapped-        , prop_encodingHeadersArentWrapped-        ]--prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool-prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) =-    actual `S.isSubsetOf` expected-    where-    actual = toJSON hs ^@.. members & fmap fst & S.fromList-    expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs--prop_encodingHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool-prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) =-    actual `S.isSubsetOf` expected-    where-    actual = encode hs ^@.. members & fmap fst & S.fromList-    expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs

@@ -1,53 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-module Rollbar.QuickCheck where--import Data.Bifunctor       (bimap)-import Data.CaseInsensitive (mk)-import Data.Proxy           (Proxy(Proxy))--import GHC.TypeLits (KnownSymbol, symbolVal)--import Prelude hiding (error)--import Rollbar.Item--import Test.QuickCheck-import Test.QuickCheck.Modifiers (getASCIIString)--import qualified Data.ByteString.Char8 as BSC8-import qualified Data.Text             as T--instance Arbitrary a => Arbitrary (Item a '["Authorization"]) where-    arbitrary = Item <$> arbitrary <*> arbitrary--instance Arbitrary AccessToken where-    arbitrary = AccessToken . T.pack . getASCIIString <$> arbitrary--instance Arbitrary a => Arbitrary (Data a '["Authorization"]) where-    arbitrary = do-        env <- Environment . T.pack . getASCIIString <$> arbitrary-        message <- fmap (MessageBody . T.pack . getASCIIString) <$> arbitrary-        payload <- arbitrary-        elements $ (\f -> f env message payload) <$> datas--datas :: [Environment -> Maybe MessageBody -> a -> Data a '["Authorization"]]-datas = [debug, info, warning, error, critical]--instance Arbitrary (MissingHeaders '[]) where-    arbitrary = do-        xs <- arbitrary-        let hs = bimap (mk . BSC8.pack) BSC8.pack <$> xs-        pure . MissingHeaders $ hs--instance (KnownSymbol header, Arbitrary (MissingHeaders headers))-    => Arbitrary (MissingHeaders (header ': headers)) where-    arbitrary = do-        MissingHeaders hs <- arbitrary :: Gen (MissingHeaders headers)-        let name = mk . BSC8.pack $ symbolVal (Proxy :: Proxy header)-        value <- BSC8.pack <$> arbitrary-        pure . MissingHeaders $ (name, value) : hs

@@ -1,5 +1,5 @@ name:                wai-middleware-rollbar-version:             0.8.4+version:             0.9.0 synopsis:            Middleware that communicates to Rollbar. description:         Middleware that communicates to Rollbar. homepage:            https://github.com/joneshf/wai-middleware-rollbar#readme@@ -17,62 +17,19 @@ library   hs-source-dirs:      src   exposed-modules:     Network.Wai.Middleware.Rollbar-                     , Rollbar.API-                     , Rollbar.AccessToken-                     , Rollbar.Item-                     , Rollbar.Item.Body-                     , Rollbar.Item.CodeVersion-                     , Rollbar.Item.Data-                     , Rollbar.Item.Environment-                     , Rollbar.Item.Hardcoded-                     , Rollbar.Item.Level-                     , Rollbar.Item.MissingHeaders-                     , Rollbar.Item.Person-                     , Rollbar.Item.Request-                     , Rollbar.Item.Server--                     , Rollbar.Item.Internal.Notifier-                     , Rollbar.Item.Internal.Platform-  other-modules:       Paths_wai_middleware_rollbar+                     , Network.Wai.Middleware.Rollbar.Payload   build-depends:       base >= 4.9 && < 5                      , aeson >= 1.0 && < 1.3                      , 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.4                      , http-types >= 0.9 && < 0.13-                     , network >= 2.6 && < 2.7+                     , rollbar-hs >= 0.1 && < 0.2                      , text >= 1.2 && < 1.3                      , time >= 1.6 && < 1.9-                     , unordered-containers >= 0.2 && < 0.3                      , uuid >= 1.3 && < 1.4                      , wai >= 3.2 && < 3.3-  default-language:    Haskell2010-  ghc-options:        -Wall--test-suite doc-test-  default-language:    Haskell2010-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Main.hs-  other-modules:       Rollbar.Golden-                     , Rollbar.Item.Data.Test-                     , Rollbar.Item.MissingHeaders.Test-                     , Rollbar.Item.Request.Test-                     , Rollbar.QuickCheck-  build-depends:       base-                     , QuickCheck >= 2.9 && < 2.12-                     , aeson-                     , bytestring-                     , case-insensitive-                     , containers >= 0.5 && < 0.6-                     , hspec >= 2.4 && < 2.5-                     , hspec-golden-aeson >= 0.2 && < 0.6-                     , lens >= 4.15 && < 4.17-                     , lens-aeson >= 1.0 && < 1.1-                     , text-                     , wai-middleware-rollbar   default-language:    Haskell2010   ghc-options:        -Wall