diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,31 @@ +# Changelog + +## 0.3.1.0 + +* [Drop some test dependencies](https://github.com/joneshf/rollbar-hs/pull/12) +* [Relax upper bound for `network` to 2.8](https://github.com/joneshf/rollbar-hs/pull/14) + +## 0.3.0.1 + +* [Add a changelog](https://github.com/joneshf/rollbar-hs/pull/10) + +## 0.3.0.0 + +* [Bump `aeson` upper bound](https://github.com/joneshf/rollbar-hs/pull/3) + +## 0.2.0.0 + +* [Fix the type of `Notifier` `name`](https://github.com/joneshf/rollbar-hs/commit/11a3a2463cf44735237d062f15a349d8bfa7ffce) + +## 0.1.0.1 + +* [Add synopsis](https://github.com/joneshf/rollbar-hs/commit/272c5764a9657f55e00e31c43a3d583362d823d5) + +## 0.1.0.0 + +* Extract core rollbar to its own package + + This is almost entirely copy-pasted from [`wai-middleware-rollbar` version 0.8.4](https://hackage.haskell.org/package/wai-middleware-rollbar-0.8.4). + + The intent is to make the core data types available for other packages. + If this gets unweildy, move it right back. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,3 @@ # rollbar-hs + +[![CircleCI](https://circleci.com/gh/joneshf/rollbar-hs.svg?style=svg)](https://circleci.com/gh/joneshf/rollbar-hs) diff --git a/rollbar-hs.cabal b/rollbar-hs.cabal --- a/rollbar-hs.cabal +++ b/rollbar-hs.cabal @@ -1,12 +1,14 @@ --- This file has been generated from package.yaml by hpack version 0.20.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: eac54e2631e9bbfada016ff0f7e6f51024450be3752b9c2c3894efb49efbace6 +-- hash: ada36aef8292b669d79078e0bd25b6fdd183acfef29e34ca61e5493dd8b8958f name: rollbar-hs -version: 0.2.0.0 +version: 0.3.1.0 synopsis: Core Rollbar data types and APIs. +description: Provides a type-safe encoding of the Rollbar API. + Also provides functions to communicate with the Rollbar API. category: Web homepage: https://github.com/joneshf/rollbar-hs#readme bug-reports: https://github.com/joneshf/rollbar-hs/issues @@ -17,8 +19,8 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10 - extra-source-files: + CHANGELOG.md README.md source-repository head @@ -26,22 +28,6 @@ location: https://github.com/joneshf/rollbar-hs library - hs-source-dirs: - src - build-depends: - aeson >=1.0 && <1.3 - , base >=4.9 && <5 - , 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 - , text >=1.2 && <1.3 - , time >=1.6 && <1.9 - , unordered-containers >=0.2 && <0.3 - , uuid >=1.3 && <1.4 exposed-modules: Rollbar.AccessToken Rollbar.API @@ -60,11 +46,34 @@ Rollbar.Item.Server other-modules: Paths_rollbar_hs + hs-source-dirs: + src + build-depends: + aeson >=1.0 && <1.5 + , base >=4.9 && <5 + , 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.8 + , text >=1.2 && <1.3 + , time >=1.6 && <1.9 + , unordered-containers >=0.2 && <0.3 + , uuid >=1.3 && <1.4 default-language: Haskell2010 test-suite doc-test type: exitcode-stdio-1.0 main-is: Main.hs + other-modules: + Rollbar.Golden + Rollbar.Item.Data.Test + Rollbar.Item.MissingHeaders.Test + Rollbar.Item.Request.Test + Rollbar.QuickCheck + Paths_rollbar_hs hs-source-dirs: test build-depends: @@ -73,18 +82,9 @@ , base >=4.9 , bytestring >=0.10 , case-insensitive >=1.2 - , containers >=0.5 , hspec >=2.4 , hspec-golden-aeson >=0.2 - , lens >=4.15 - , lens-aeson >=1.0 , rollbar-hs , text >=1.2 - other-modules: - Rollbar.Golden - Rollbar.Item.Data.Test - Rollbar.Item.MissingHeaders.Test - Rollbar.Item.Request.Test - Rollbar.QuickCheck - Paths_rollbar_hs + , unordered-containers >=0.2 default-language: Haskell2010 diff --git a/test/Rollbar/Item/Data/Test.hs b/test/Rollbar/Item/Data/Test.hs --- a/test/Rollbar/Item/Data/Test.hs +++ b/test/Rollbar/Item/Data/Test.hs @@ -1,17 +1,18 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Rollbar.Item.Data.Test where -import Control.Lens ((^@..)) +import Data.Aeson (Value (Null, Object), decode', encode, + toJSON) +import Data.Text (Text) -import Data.Aeson (encode, toJSON) -import Data.Aeson.Lens (key, members) -import Data.Text (Text) +import Rollbar.Item +import Rollbar.QuickCheck () -import Rollbar.Item -import Rollbar.QuickCheck () +import Test.QuickCheck (conjoin, quickCheck) -import Test.QuickCheck (conjoin, quickCheck) +import qualified Data.HashMap.Strict props :: IO () props = @@ -24,13 +25,20 @@ prop_valueDataBodyHasRequiredKey x = length ms == 1 && fst (head ms) `elem` requiredBodyKeys where - ms = toJSON x ^@.. key "body" . members + ms = key "body" (toJSON x) prop_encodingDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool prop_encodingDataBodyHasRequiredKey x = length ms == 1 && fst (head ms) `elem` requiredBodyKeys where - ms = encode x ^@.. key "body" . members + ms = foldMap (key "body") (decode' $ encode x) requiredBodyKeys :: [Text] requiredBodyKeys = ["trace", "trace_chain", "message", "crash_report"] + +key :: Text -> Value -> [(Text, Value)] +key k = \case + Object o -> case Data.HashMap.Strict.lookupDefault Null k o of + Object o -> Data.HashMap.Strict.toList o + _ -> mempty + _ -> mempty diff --git a/test/Rollbar/Item/MissingHeaders/Test.hs b/test/Rollbar/Item/MissingHeaders/Test.hs --- a/test/Rollbar/Item/MissingHeaders/Test.hs +++ b/test/Rollbar/Item/MissingHeaders/Test.hs @@ -1,23 +1,25 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators #-} module Rollbar.Item.MissingHeaders.Test where -import Control.Lens ((&), (^@..)) - -import Data.Aeson (encode, toJSON) -import Data.Aeson.Lens (members) +import Data.Aeson (Value (Object), decode', encode, + toJSON) +import Data.Functor (void) +import Data.HashSet (HashSet) +import Data.Text (Text) -import Prelude hiding (error) +import Prelude hiding (error) -import Rollbar.Item.MissingHeaders (MissingHeaders(..)) -import Rollbar.QuickCheck () +import Rollbar.Item.MissingHeaders (MissingHeaders (..)) +import Rollbar.QuickCheck () -import Test.QuickCheck (conjoin, quickCheck) +import Test.QuickCheck (conjoin, quickCheck) -import Data.Set as S +import qualified Data.HashSet props :: IO () props = do @@ -38,48 +40,55 @@ prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool prop_valueAuthorizationIsRemoved hs = - "Authorization" `S.notMember` actual + "Authorization" `notMember` actual where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = keys (toJSON hs) prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool prop_encodingAuthorizationIsRemoved hs = - "Authorization" `S.notMember` actual + "Authorization" `notMember` actual where - actual = encode hs ^@.. members & fmap fst & S.fromList + actual = foldMap keys (decode' $ encode hs) prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool prop_valueX_AccessTokenIsRemoved hs = - "X-AccessToken" `S.notMember` actual + "X-AccessToken" `notMember` actual where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = keys (toJSON hs) prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool prop_encodingX_AccessTokenIsRemoved hs = - "X-AccessToken" `S.notMember` actual + "X-AccessToken" `notMember` actual where - actual = encode hs ^@.. members & fmap fst & S.fromList + actual = foldMap keys (decode' $ encode hs) 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 + "Authorization" `notMember` actual + && "this is made up" `notMember` actual + && "Server" `notMember` actual + && "X-AccessToken" `notMember` actual where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = keys (toJSON hs) 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 + "Authorization" `notMember` actual + && "this is made up" `notMember` actual + && "Server" `notMember` actual + && "X-AccessToken" `notMember` actual where - actual = encode hs ^@.. members & fmap fst & S.fromList + actual = foldMap keys (decode' $ encode hs) + +keys :: Value -> HashSet Text +keys = \case + Object o -> Data.HashSet.fromMap (void o) + _ -> mempty + +notMember x = not . Data.HashSet.member x diff --git a/test/Rollbar/Item/Request/Test.hs b/test/Rollbar/Item/Request/Test.hs --- a/test/Rollbar/Item/Request/Test.hs +++ b/test/Rollbar/Item/Request/Test.hs @@ -1,24 +1,27 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators #-} module Rollbar.Item.Request.Test where -import Control.Lens ((&), (^@..)) +import Data.Aeson (Value (Object), decode', encode, toJSON) +import Data.CaseInsensitive (original) +import Data.Foldable (fold) +import Data.Functor (void) +import Data.HashSet (HashSet) +import Data.Text (Text) -import Data.Aeson (encode, toJSON) -import Data.Aeson.Lens (members) -import Data.CaseInsensitive (original) +import Prelude hiding (error) -import Prelude hiding (error) +import Rollbar.Item.Request (MissingHeaders (..)) +import Rollbar.QuickCheck () -import Rollbar.Item.Request (MissingHeaders(..)) -import Rollbar.QuickCheck () +import Test.QuickCheck (conjoin, quickCheck) -import Test.QuickCheck (conjoin, quickCheck) +import qualified Data.Text.Encoding as TE -import Data.Set as S -import Data.Text.Encoding as TE +import qualified Data.HashSet props :: IO () props = @@ -29,14 +32,22 @@ prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) = - actual `S.isSubsetOf` expected + actual `isSubsetOf` expected where - actual = toJSON hs ^@.. members & fmap fst & S.fromList - expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs + actual = keys (toJSON hs) + expected = Data.HashSet.fromList $ fold . TE.decodeUtf8' . original . fst <$> rhs + isSubsetOf x y = Data.HashSet.difference x y == mempty prop_encodingHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool prop_encodingHeadersArentWrapped hs@(MissingHeaders rhs) = - actual `S.isSubsetOf` expected + actual `isSubsetOf` expected where - actual = encode hs ^@.. members & fmap fst & S.fromList - expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs + actual = foldMap keys (decode' $ encode hs) + expected = Data.HashSet.fromList $ fold . TE.decodeUtf8' . original . fst <$> rhs + isSubsetOf x y = Data.HashSet.difference x y == mempty + +keys :: Value -> HashSet Text +keys = \case + Object o -> Data.HashSet.fromMap (void o) + _ -> mempty +