wai-middleware-rollbar 0.3.0 → 0.4.0

raw patch · 21 files changed

+315/−127 lines, 21 filesdep +hspecdep +hspec-golden-aesondep ~QuickCheckdep ~aesondep ~http-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, hspec-golden-aeson

Dependency ranges changed: QuickCheck, aeson, http-client, http-conduit, lens

API changes (from Hackage documentation)

Files

• src/Rollbar/AccessToken.hs +2/−2
• src/Rollbar/Item.hs +20/−3
• src/Rollbar/Item/Body.hs +20/−2
• src/Rollbar/Item/CodeVersion.hs +12/−2
• src/Rollbar/Item/Data.hs +28/−16
• src/Rollbar/Item/Environment.hs +2/−2
• src/Rollbar/Item/Hardcoded.hs +10/−1
• src/Rollbar/Item/Internal/Notifier.hs +3/−1
• src/Rollbar/Item/Internal/Platform.hs +2/−2
• src/Rollbar/Item/Level.hs +15/−8
• src/Rollbar/Item/MissingHeaders.hs +6/−1
• src/Rollbar/Item/Person.hs +6/−4
• src/Rollbar/Item/Request.hs +61/−4
• src/Rollbar/Item/Server.hs +27/−5
• test/Main.hs +2/−2
• test/Rollbar/Golden.hs +14/−0
• test/Rollbar/Item/Data/Test.hs +3/−16
• test/Rollbar/Item/MissingHeaders/Test.hs +11/−34
• test/Rollbar/Item/Request/Test.hs +7/−15
• test/Rollbar/QuickCheck.hs +52/−0
• wai-middleware-rollbar.cabal +12/−7

@@ -13,7 +13,7 @@     ( AccessToken(..)     ) where -import Data.Aeson  (ToJSON)+import Data.Aeson  (FromJSON, ToJSON) import Data.String (IsString)  import qualified Data.Text as T@@ -21,4 +21,4 @@ -- | Should have the scope "post_server_item". newtype AccessToken     = AccessToken T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -85,9 +85,22 @@     , Root(..)     ) where -import Data.Aeson   (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))-import Data.Maybe   (fromMaybe)-import Data.Version (showVersion)+import Data.Aeson+    ( FromJSON+    , KeyValue+    , ToJSON+    , Value(Object)+    , object+    , pairs+    , parseJSON+    , toEncoding+    , toJSON+    , (.:)+    , (.=)+    )+import Data.Aeson.Types (typeMismatch)+import Data.Maybe       (fromMaybe)+import Data.Version     (showVersion)  import GHC.Generics (Generic) @@ -194,6 +207,10 @@     [ "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

@@ -20,8 +20,20 @@     ) where  import Data.Aeson-    (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))+    ( 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)@@ -46,6 +58,12 @@     , "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@@ -53,4 +71,4 @@ -- | The primary message text to send to Rollbar. newtype MessageBody     = MessageBody T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}  {-|     Module      : Rollbar.Item.CodeVersion@@ -13,11 +14,13 @@     ( CodeVersion(..)     ) where -import Data.Aeson (ToJSON, toEncoding, toJSON)+import Data.Aeson       (FromJSON, ToJSON, parseJSON, toEncoding, toJSON)+import Data.Aeson.Types (typeMismatch)  import GHC.Generics (Generic) -import qualified Data.Text as T+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@@ -34,6 +37,13 @@ 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

@@ -27,18 +27,22 @@     ) where  import Data.Aeson-    ( ToJSON-    , Value+    ( FromJSON+    , ToJSON+    , Value(String)     , defaultOptions+    , genericParseJSON     , genericToEncoding     , genericToJSON+    , parseJSON     , toEncoding     , toJSON     )-import Data.Aeson.Types (fieldLabelModifier, omitNothingFields)+import Data.Aeson.Types+    (Options, fieldLabelModifier, omitNothingFields, typeMismatch) import Data.String      (IsString) import Data.Time        (UTCTime)-import Data.UUID        (UUID, toText)+import Data.UUID        (UUID, fromText, toText)  import GHC.Generics (Generic) @@ -87,16 +91,19 @@         }     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 defaultOptions-        { fieldLabelModifier = codeVersionModifier-        , omitNothingFields = True-        }-    toEncoding = genericToEncoding defaultOptions-        { fieldLabelModifier = codeVersionModifier-        , omitNothingFields = True-        }+    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"@@ -106,27 +113,32 @@ --  E.g. "scotty", "servant", "yesod" newtype Framework     = Framework T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | The place in the code where this item came from. newtype Context     = Context T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | How to group the item. newtype Fingerprint     = Fingerprint T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | The title of the item. newtype Title     = Title T.Text-    deriving (Eq, IsString, Show, ToJSON)+    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)

@@ -13,7 +13,7 @@     ( Environment(..)     ) where -import Data.Aeson  (ToJSON)+import Data.Aeson  (FromJSON, ToJSON) import Data.String (IsString)  import qualified Data.Text as T@@ -22,4 +22,4 @@ --  E.g. "development", "production", "staging" newtype Environment     = Environment T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}  {-|     Module      : Rollbar.Item.Hardcoded@@ -17,7 +18,10 @@     ( Hardcoded(..)     ) where -import Data.Aeson (ToJSON, toEncoding, toJSON)+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)@@ -31,3 +35,8 @@ 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

@@ -17,7 +17,8 @@     ( Notifier(..)     ) where -import Data.Aeson   (ToJSON, defaultOptions, genericToEncoding, toEncoding)+import Data.Aeson+    (FromJSON, ToJSON, defaultOptions, genericToEncoding, toEncoding) import Data.Version (Version)  import GHC.Generics (Generic)@@ -34,5 +35,6 @@         }     deriving (Eq, Generic, Show) +instance FromJSON Notifier instance ToJSON Notifier where     toEncoding = genericToEncoding defaultOptions

@@ -15,7 +15,7 @@     ( Platform(..)     ) where -import Data.Aeson  (ToJSON)+import Data.Aeson  (FromJSON, ToJSON) import Data.String (IsString)  import qualified Data.Text as T@@ -23,4 +23,4 @@ -- | Should be something meaningful to rollbar, like "linux". newtype Platform     = Platform T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -14,14 +14,17 @@     ) where  import Data.Aeson-    ( ToJSON+    ( FromJSON+    , ToJSON     , defaultOptions+    , genericParseJSON     , genericToEncoding     , genericToJSON+    , parseJSON     , toEncoding     , toJSON     )-import Data.Aeson.Types (constructorTagModifier)+import Data.Aeson.Types (Options, constructorTagModifier) import Data.Char        (toLower)  import GHC.Generics (Generic)@@ -35,10 +38,14 @@     | Critical     deriving (Bounded, Enum, Eq, Generic, Ord, Show) +instance FromJSON Level where+    parseJSON = genericParseJSON options+ instance ToJSON Level where-    toJSON = genericToJSON defaultOptions-        { constructorTagModifier = fmap toLower-        }-    toEncoding = genericToEncoding defaultOptions-        { constructorTagModifier = fmap toLower-        }+    toJSON = genericToJSON options+    toEncoding = genericToEncoding options++options :: Options+options = defaultOptions+    { constructorTagModifier = fmap toLower+    }

@@ -18,7 +18,9 @@     , RemoveHeaders     ) where -import Data.Aeson           (KeyValue, ToJSON, object, toJSON, (.=))+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))@@ -54,6 +56,9 @@         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

@@ -19,7 +19,8 @@     ) where  import Data.Aeson-    ( ToJSON+    ( FromJSON+    , ToJSON     , defaultOptions     , genericToEncoding     , genericToJSON@@ -45,6 +46,7 @@         }     deriving (Eq, Generic, Show) +instance FromJSON Person instance ToJSON Person where     toJSON = genericToJSON defaultOptions { omitNothingFields = True }     toEncoding = genericToEncoding defaultOptions { omitNothingFields = True }@@ -52,14 +54,14 @@ -- | The user's identifier. This uniquely identifies a 'Person' to Rollbar. newtype Id     = Id T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | The user's name. newtype Username     = Username T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | The user's email. newtype Email     = Email T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -25,17 +25,33 @@     , RemoveHeaders     ) where -import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))-import Data.Maybe  (catMaybes, fromMaybe)-import Data.String (IsString)+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)+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@@ -61,6 +77,9 @@     = 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)@@ -70,6 +89,9 @@     = 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@@ -88,6 +110,9 @@     = 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)@@ -97,6 +122,9 @@     = 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)@@ -106,6 +134,17 @@     = 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)@@ -121,6 +160,18 @@     , "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@@ -133,6 +184,12 @@ 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

@@ -18,9 +18,22 @@     , Branch(..)     ) where -import Data.Aeson  (KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))-import Data.Maybe  (catMaybes)-import Data.String (IsString)+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) @@ -52,6 +65,15 @@     , ("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@@ -59,9 +81,9 @@ -- | The root directory. newtype Root     = Root T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)  -- | The git branch the server is running on. newtype Branch     = Branch T.Text-    deriving (Eq, IsString, Show, ToJSON)+    deriving (Eq, FromJSON, IsString, Show, ToJSON)

@@ -1,14 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Test.QuickCheck (conjoin, quickCheck)-+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

@@ -0,0 +1,14 @@+{-# 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,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Rollbar.Item.Data.Test where @@ -7,14 +6,12 @@  import Data.Aeson      (encode, toJSON) import Data.Aeson.Lens (key, members)-import Data.Text       (Text, pack)--import Prelude hiding (error)+import Data.Text       (Text)  import Rollbar.Item+import Rollbar.QuickCheck () -import Test.QuickCheck-    (Arbitrary, Property, arbitrary, conjoin, elements, quickCheck)+import Test.QuickCheck (conjoin, quickCheck)  props :: IO () props =@@ -34,16 +31,6 @@     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"]

@@ -2,31 +2,22 @@ {-# 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 Data.Aeson      (encode, toJSON)+import Data.Aeson.Lens (members)  import Prelude hiding (error)  import Rollbar.Item.MissingHeaders (MissingHeaders(..))+import Rollbar.QuickCheck          () -import Test.QuickCheck-    (Arbitrary, Gen, Property, arbitrary, conjoin, elements, quickCheck)+import Test.QuickCheck (conjoin, quickCheck) -import Data.ByteString.Char8 as BSC8-import Data.Set              as S-import Data.Text.Encoding    as TE+import Data.Set as S  props :: IO () props = do@@ -46,25 +37,25 @@         ]  prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool-prop_valueAuthorizationIsRemoved hs@(MissingHeaders rhs) =+prop_valueAuthorizationIsRemoved hs =     "Authorization" `S.notMember` actual     where     actual = toJSON hs ^@.. members & fmap fst & S.fromList  prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool-prop_encodingAuthorizationIsRemoved hs@(MissingHeaders rhs) =+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@(MissingHeaders rhs) =+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@(MissingHeaders rhs) =+prop_encodingX_AccessTokenIsRemoved hs =     "X-AccessToken" `S.notMember` actual     where     actual = encode hs ^@.. members & fmap fst & S.fromList@@ -73,7 +64,7 @@     :: MissingHeaders         '["Authorization", "this is made up", "Server", "X-AccessToken"]     -> Bool-prop_valueAllHeadersAreRemoved hs@(MissingHeaders rhs) =+prop_valueAllHeadersAreRemoved hs =     "Authorization" `S.notMember` actual         && "this is made up" `S.notMember` actual         && "Server" `S.notMember` actual@@ -85,24 +76,10 @@     :: MissingHeaders         '["Authorization", "this is made up", "Server", "X-AccessToken"]     -> Bool-prop_encodingAllHeadersAreRemoved hs@(MissingHeaders rhs) =+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--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

@@ -7,21 +7,18 @@ 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 Data.Aeson.Lens      (members)+import Data.CaseInsensitive (original)  import Prelude hiding (error) -import Rollbar.Item.Request (MissingHeaders(..), RemoveHeaders)+import Rollbar.Item.Request (MissingHeaders(..))+import Rollbar.QuickCheck   () -import Test.QuickCheck-    (Arbitrary, Property, arbitrary, conjoin, elements, quickCheck)+import Test.QuickCheck (conjoin, quickCheck) -import Data.ByteString.Char8 as BSC8-import Data.Set              as S-import Data.Text.Encoding    as TE+import Data.Set           as S+import Data.Text.Encoding as TE  props :: IO () props =@@ -43,8 +40,3 @@     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

@@ -0,0 +1,52 @@+{-# 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 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 <$> arbitrary++instance Arbitrary a => Arbitrary (Data a '["Authorization"]) where+    arbitrary = do+        env <- Environment . T.pack <$> arbitrary+        message <- fmap (MessageBody . T.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]++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.3.0+version:             0.4.0 synopsis:            Middleware that communicates to Rollbar. description:         Middleware that communicates to Rollbar. homepage:            https://github.com/joneshf/wai-middleware-rollbar#readme@@ -34,12 +34,12 @@                      , Rollbar.Item.Internal.Platform   other-modules:       Paths_wai_middleware_rollbar   build-depends:       base >= 4.7 && < 5-                     , aeson >= 1.0 && < 1.2+                     , 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.3+                     , http-client >= 0.4 && < 0.6+                     , http-conduit >= 2.1 && < 2.3                      , http-types >= 0.9 && < 0.10                      , network >= 2.6 && < 2.7                      , text >= 1.2 && < 1.3@@ -55,20 +55,25 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Main.hs-  other-modules:       Rollbar.Item.Data.Test+  other-modules:       Rollbar.Golden+                     , Rollbar.Item.Data.Test                      , Rollbar.Item.MissingHeaders.Test                      , Rollbar.Item.Request.Test+                     , Rollbar.QuickCheck   build-depends:       base+                     , QuickCheck >= 2.8 && < 2.10                      , aeson                      , bytestring                      , case-insensitive                      , containers >= 0.5 && < 0.6-                     , lens >= 4.15 && < 4.16+                     , hspec >= 2.2 && < 2.5+                     , hspec-golden-aeson >= 0.2 && < 0.3+                     , lens >= 4.14 && < 4.16                      , lens-aeson >= 1.0 && < 1.1-                     , QuickCheck >= 2.9 && < 2.10                      , text                      , wai-middleware-rollbar   default-language:    Haskell2010+  ghc-options:        -Wall  source-repository head   type:     git