wai-middleware-rollbar 0.2.0 → 0.3.0

raw patch · 11 files changed

+497/−80 lines, 11 filesdep +QuickCheckdep +containersdep +lensdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, containers, lens, lens-aeson, wai-middleware-rollbar

Dependency ranges changed: aeson, base, bytestring, case-insensitive, text

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/Rollbar.hs +120/−32
• src/Rollbar/Item.hs +39/−10
• src/Rollbar/Item/Body.hs +6/−4
• src/Rollbar/Item/Data.hs +6/−4
• src/Rollbar/Item/MissingHeaders.hs +71/−0
• src/Rollbar/Item/Request.hs +12/−29
• test/Main.hs +14/−0
• test/Rollbar/Item/Data/Test.hs +49/−0
• test/Rollbar/Item/MissingHeaders/Test.hs +108/−0
• test/Rollbar/Item/Request/Test.hs +50/−0
• wai-middleware-rollbar.cabal +22/−1

@@ -1,7 +1,10 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}  {-|     Module      : Network.Wai.Middleware.Rollbar@@ -17,10 +20,11 @@     More to come shortly. -} -module Network.Wai.Middleware.Rollbar (requests) where+module Network.Wai.Middleware.Rollbar (Settings(..), exceptions, requests) where  import Control.Concurrent (forkIO)-import Control.Exception  (Handler(Handler), catches, displayException)+import Control.Exception+    (Handler(Handler), SomeException, catches, displayException, throwIO) import Control.Monad      (when)  import Data.Aeson   (ToJSON, defaultOptions, genericToEncoding, toEncoding)@@ -30,6 +34,7 @@ import Data.UUID.V4 (nextRandom)  import GHC.Generics (Generic)+import GHC.TypeLits (Symbol)  import Network.HostName          (getHostName) import Network.HTTP.Client       (HttpException)@@ -53,64 +58,80 @@ 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 +-- | Set up the middleware properly+--  The `headers` are  what you want removed from+--  the request headers sent to Rollbar.+data Settings (headers :: [Symbol])+    = Settings+        { accessToken :: RI.AccessToken+        -- ^ Should have a scope "post_server_item".+        , environment :: RI.Environment+        -- ^ Should be something meaningful to your program+        --+        -- E.g. "development" or "production"+        }++-- | Middleware that catches exceptions, sends an item to Rollbar,+--  and rethrows the exception.+--+--  Sends additional metadata including the request information.+exceptions :: RI.RemoveHeaders headers => Settings headers -> Middleware+exceptions settings app req handler = app req handler `catches`+    [ Handler $ handleSomeException settings req+    ]+ -- | 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+requests :: RI.RemoveHeaders headers => Settings headers -> Middleware+requests settings app req handler' = app req handler     where     handler :: NW.Response -> IO ResponseReceived     handler res = do-        _ <- forkIO $ handle500 accessToken environment req res+        _ <- forkIO $ handle500 settings 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)+handle500+    :: RI.RemoveHeaders headers+    => Settings headers+    -> NW.Request+    -> NW.Response+    -> IO ()+handle500 settings req res =+    when (statusIsServerError $ NW.responseStatus res) (send settings 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{..}+send+    :: forall headers+    . RI.RemoveHeaders headers+    => Settings headers+    -> NW.Request+    -> NW.Response+    -> IO ()+send settings req res = do+    rReq <- mkRollbarRequest settings req payload messageBody     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+    payload = RequestPayload         { 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:"@@ -121,7 +142,68 @@     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+handleSomeException+    :: forall a headers+    . RI.RemoveHeaders headers+    => Settings headers+    -> NW.Request+    -> SomeException+    -> IO a+handleSomeException settings req e = do+    rReq <- mkRollbarRequest settings req payload messageBody+    _ <- httpNoBody rReq+    throwIO e+    where+    exception = T.pack $ displayException e+    messageBody = Just $ RI.MessageBody $+        T.intercalate " "+            [ "Uncaught exception at:"+            , myDecodeUtf8' $ NW.requestMethod req+            , T.intercalate "/" $ NW.pathInfo req+            ]+    referer = myDecodeUtf8 =<< NW.requestHeaderReferer req+    range = myDecodeUtf8 =<< NW.requestHeaderRange req+    userAgent = myDecodeUtf8 =<< NW.requestHeaderUserAgent req+    payload = ExceptionPayload {..}++mkRollbarRequest+    :: forall headers+    . RI.RemoveHeaders headers+    => Settings headers+    -> NW.Request+    -> Payload+    -> Maybe RI.MessageBody+    -> IO Request+mkRollbarRequest Settings{..} 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.branch = Nothing, RI.serverCodeVersion = Nothing, .. }+    let itemData = (RI.error environment messageBody payload)+            { RI.request, RI.server, RI.timestamp, RI.uuid }+    pure $ rollbarRequest RI.Item{..}+    where+    headers :: RI.MissingHeaders headers+    headers = RI.MissingHeaders $ NW.requestHeaders req+    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++myDecodeUtf8 :: BS.ByteString -> Maybe T.Text+myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'++myDecodeUtf8' :: BS.ByteString -> T.Text+myDecodeUtf8' = fromMaybe "" . myDecodeUtf8++rollbarRequest+    :: (RI.RemoveHeaders headers, ToJSON a)+    => RI.Item a headers+    -> Network.HTTP.Simple.Request rollbarRequest payload =     setRequestMethod "POST"     . setRequestSecure True@@ -133,12 +215,18 @@     $ defaultRequest  data Payload-    = 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) 

@@ -1,6 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}  {-|     Module      : Rollbar.Item@@ -59,6 +61,9 @@     , module Rollbar.Item.Hardcoded     , Hardcoded(..) +    , module Rollbar.Item.MissingHeaders+    , MissingHeaders(..)+     , module Rollbar.Item.Person     , Person(..)     , Email(..)@@ -67,9 +72,9 @@      , module Rollbar.Item.Request     , Get(..)-    , Headers(..)     , IP(..)     , Method(..)+    , MissingHeaders(..)     , QueryString(..)     , RawBody(..)     , URL(..)@@ -95,6 +100,7 @@ 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@@ -108,7 +114,11 @@ import qualified Paths_wai_middleware_rollbar  -- | Creates 'Data' with the level set to 'Debug'.-debug :: Environment -> Maybe MessageBody -> payload -> Data payload+debug+    :: Environment+    -> Maybe MessageBody+    -> payload+    -> Data payload ("Authorization" ': headers) debug environment messageBody payload =     Data         { body = Message (fromMaybe "" messageBody) payload@@ -132,40 +142,59 @@         }  -- | Creates 'Data' with the level set to 'Info'.-info :: Environment -> Maybe MessageBody -> payload -> Data payload+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+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+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+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+data Item a headers     = Item         { accessToken :: AccessToken         -- ^ Should have a scope "post_server_item".-        , itemData    :: Data a+        , itemData    :: Data a headers         }     deriving (Eq, Generic, Show) -itemKVs :: (KeyValue kv, ToJSON v) => Item v -> [kv]+itemKVs+    :: (KeyValue kv, RemoveHeaders headers, ToJSON v)+    => Item v headers+    -> [kv] itemKVs Item{..} =     [ "access_token" .= accessToken     , "data" .= itemData     ] -instance ToJSON a => ToJSON (Item a) where+instance (RemoveHeaders headers, ToJSON a) => ToJSON (Item a headers) where     toJSON = object . itemKVs     toEncoding = pairs . mconcat . itemKVs

@@ -19,8 +19,10 @@     , MessageBody(..)     ) where -import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))-import Data.String (IsString)+import Data.Aeson+    (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.Aeson.Encoding (pair)+import Data.String         (IsString)  import GHC.Generics (Generic) @@ -45,8 +47,8 @@     ]  instance ToJSON arbitrary => ToJSON (Body arbitrary) where-    toJSON = object . bodyKVs-    toEncoding = pairs . mconcat . bodyKVs+    toJSON x = object ["message" .= object (bodyKVs x)]+    toEncoding = pairs . pair "message" . pairs . mconcat . bodyKVs  -- | The primary message text to send to Rollbar. newtype MessageBody

@@ -22,6 +22,8 @@     , Framework(..)     , Title(..)     , UUID4(..)++    , RemoveHeaders     ) where  import Data.Aeson@@ -46,7 +48,7 @@ import Rollbar.Item.Hardcoded   (Hardcoded) import Rollbar.Item.Level       (Level) import Rollbar.Item.Person      (Person)-import Rollbar.Item.Request     (Request)+import Rollbar.Item.Request     (RemoveHeaders, Request) import Rollbar.Item.Server      (Server)  import Rollbar.Item.Internal.Notifier (Notifier)@@ -60,7 +62,7 @@ -- --  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 Data body headers     = Data         { body        :: Body body         , codeVersion :: CodeVersion@@ -77,7 +79,7 @@         , person      :: Maybe Person         , platform    :: Platform         -- ^ Metadata about this package. You probably shouldn't create this yourself.-        , request     :: Maybe Request+        , request     :: Maybe (Request headers)         , server      :: Maybe Server         , timestamp   :: Maybe UTCTime         , title       :: Maybe Title@@ -85,7 +87,7 @@         }     deriving (Eq, Generic, Show) -instance ToJSON body => ToJSON (Data body) where+instance (RemoveHeaders headers, ToJSON body) => ToJSON (Data body headers) where     toJSON = genericToJSON defaultOptions         { fieldLabelModifier = codeVersionModifier         , omitNothingFields = True

@@ -0,0 +1,71 @@+{-# 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           (KeyValue, ToJSON, object, toJSON, (.=))+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 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'

@@ -16,36 +16,37 @@ module Rollbar.Item.Request     ( Request(..)     , Get(..)-    , Headers(..)     , IP(..)     , Method(..)+    , MissingHeaders(..)     , QueryString(..)     , RawBody(..)     , URL(..)+    , RemoveHeaders     ) where -import Data.Aeson-    (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))-import Data.CaseInsensitive (original)-import Data.Maybe           (catMaybes, fromMaybe)-import Data.String          (IsString)+import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+import Data.Maybe  (catMaybes, fromMaybe)+import Data.String (IsString)  import GHC.Generics (Generic) -import Network.HTTP.Types (Header, Query, RequestHeaders)+import Network.HTTP.Types (Query) import Network.Socket     (SockAddr) +import Rollbar.Item.MissingHeaders+ 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+data Request headers     = Request         { rawBody     :: RawBody         , get         :: Get         -- ^ Query parameters-        , headers     :: Headers+        , headers     :: MissingHeaders headers         , method      :: Method         , queryString :: QueryString         -- ^ The entire query string@@ -82,24 +83,6 @@         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@@ -127,7 +110,7 @@     toJSON (IP ip) = toJSON (show ip)     toEncoding (IP ip) = toEncoding (show ip) -requestKVs :: KeyValue kv => Request -> [kv]+requestKVs :: (KeyValue kv, RemoveHeaders headers) => Request headers -> [kv] requestKVs Request{..} =     [ "body" .= rawBody     , "GET" .= get@@ -138,7 +121,7 @@     , "user_ip" .= userIP     ] -instance ToJSON Request where+instance (RemoveHeaders headers) => ToJSON (Request headers) where     toJSON = object . requestKVs     toEncoding = pairs . mconcat . requestKVs 

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

@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# 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, pack)++import Prelude hiding (error)++import Rollbar.Item++import Test.QuickCheck+    (Arbitrary, Property, arbitrary, conjoin, elements, 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++instance Arbitrary a => Arbitrary (Data a '["Authorization"]) where+    arbitrary = do+        env <- Environment . pack <$> arbitrary+        message <- fmap (MessageBody . pack) <$> arbitrary+        payload <- arbitrary+        elements $ (\f -> f env message payload) <$> datas++datas :: [Environment -> Maybe MessageBody -> a -> Data a '["Authorization"]]+datas = [debug, info, warning, error, critical]++requiredBodyKeys :: [Text]+requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"]

@@ -0,0 +1,108 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+module Rollbar.Item.MissingHeaders.Test where++import Control.Lens ((&), (^@..))++import Data.Aeson           (encode, toJSON)+import Data.Aeson.Lens      (key, members)+import Data.Bifunctor       (bimap)+import Data.CaseInsensitive (mk, original)+import Data.Proxy           (Proxy(Proxy))+import Data.Text            (Text, pack)++import GHC.TypeLits (KnownSymbol, symbolVal)++import Prelude hiding (error)++import Rollbar.Item.MissingHeaders (MissingHeaders(..))++import Test.QuickCheck+    (Arbitrary, Gen, Property, arbitrary, conjoin, elements, quickCheck)++import Data.ByteString.Char8 as BSC8+import Data.Set              as S+import Data.Text.Encoding    as TE++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@(MissingHeaders rhs) =+    "Authorization" `S.notMember` actual+    where+    actual = toJSON hs ^@.. members & fmap fst & S.fromList++prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool+prop_encodingAuthorizationIsRemoved hs@(MissingHeaders rhs) =+    "Authorization" `S.notMember` actual+    where+    actual = encode hs ^@.. members & fmap fst & S.fromList++prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool+prop_valueX_AccessTokenIsRemoved hs@(MissingHeaders rhs) =+    "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@(MissingHeaders rhs) =+    "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@(MissingHeaders rhs) =+    "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@(MissingHeaders rhs) =+    "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++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

@@ -0,0 +1,50 @@+{-# 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      (key, members)+import Data.Bifunctor       (bimap)+import Data.CaseInsensitive (mk, original)+import Data.Text            (Text, pack)++import Prelude hiding (error)++import Rollbar.Item.Request (MissingHeaders(..), RemoveHeaders)++import Test.QuickCheck+    (Arbitrary, Property, arbitrary, conjoin, elements, quickCheck)++import Data.ByteString.Char8 as BSC8+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++instance Arbitrary (MissingHeaders ("Authorization" ': headers)) where+    arbitrary = do+        xs <- arbitrary+        pure . MissingHeaders $ bimap (mk . BSC8.pack) BSC8.pack <$> xs

@@ -1,5 +1,5 @@ name:                wai-middleware-rollbar-version:             0.2.0+version:             0.3.0 synopsis:            Middleware that communicates to Rollbar. description:         Middleware that communicates to Rollbar. homepage:            https://github.com/joneshf/wai-middleware-rollbar#readme@@ -25,6 +25,7 @@                      , Rollbar.Item.Environment                      , Rollbar.Item.Hardcoded                      , Rollbar.Item.Level+                     , Rollbar.Item.MissingHeaders                      , Rollbar.Item.Person                      , Rollbar.Item.Request                      , Rollbar.Item.Server@@ -48,6 +49,26 @@                      , 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.Item.Data.Test+                     , Rollbar.Item.MissingHeaders.Test+                     , Rollbar.Item.Request.Test+  build-depends:       base+                     , aeson+                     , bytestring+                     , case-insensitive+                     , containers >= 0.5 && < 0.6+                     , lens >= 4.15 && < 4.16+                     , lens-aeson >= 1.0 && < 1.1+                     , QuickCheck >= 2.9 && < 2.10+                     , text+                     , wai-middleware-rollbar+  default-language:    Haskell2010  source-repository head   type:     git