diff --git a/package.yaml b/package.yaml index 150f9c8..e0c065a 100644 --- a/package.yaml +++ b/package.yaml @@ -39,10 +39,9 @@ tests: - containers >= 0.5 - hspec >= 2.4 - hspec-golden-aeson >= 0.2 - - lens >= 4.15 - - lens-aeson >= 1.0 - rollbar-hs - text >= 1.2 + - unordered-containers >= 0.2 main: Main.hs source-dirs: test version: '0.3.0.1' diff --git a/test/Rollbar/Item/Data/Test.hs b/test/Rollbar/Item/Data/Test.hs index 1fd0cf1..6404e2c 100644 --- a/test/Rollbar/Item/Data/Test.hs +++ b/test/Rollbar/Item/Data/Test.hs @@ -1,11 +1,9 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Rollbar.Item.Data.Test where -import Control.Lens ((^@..)) - -import Data.Aeson (encode, toJSON) -import Data.Aeson.Lens (key, members) +import Data.Aeson (Value(Null, Object), decode', encode, toJSON) import Data.Text (Text) import Rollbar.Item @@ -13,6 +11,8 @@ import Rollbar.QuickCheck () import Test.QuickCheck (conjoin, quickCheck) +import qualified Data.HashMap.Strict + props :: IO () props = quickCheck $ conjoin @@ -24,13 +24,20 @@ prop_valueDataBodyHasRequiredKey :: Data () '["Authorization"] -> Bool 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 index 34f9c7e..606f939 100644 --- a/test/Rollbar/Item/MissingHeaders/Test.hs +++ b/test/Rollbar/Item/MissingHeaders/Test.hs @@ -1,14 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# 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.Text (Text) import Prelude hiding (error) @@ -19,6 +18,8 @@ import Test.QuickCheck (conjoin, quickCheck) import Data.Set as S +import qualified Data.HashMap.Strict + props :: IO () props = do quickCheck $ conjoin @@ -40,25 +41,25 @@ prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool prop_valueAuthorizationIsRemoved hs = "Authorization" `S.notMember` actual where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = S.fromList (keys $ toJSON hs) prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool prop_encodingAuthorizationIsRemoved hs = "Authorization" `S.notMember` actual where - actual = encode hs ^@.. members & fmap fst & S.fromList + actual = S.fromList (foldMap keys $ decode' $ encode hs) 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 + actual = S.fromList (keys $ toJSON hs) 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 + actual = S.fromList (foldMap keys $ decode' $ encode hs) prop_valueAllHeadersAreRemoved :: MissingHeaders @@ -70,7 +71,7 @@ prop_valueAllHeadersAreRemoved hs = && "Server" `S.notMember` actual && "X-AccessToken" `S.notMember` actual where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = S.fromList (keys $ toJSON hs) prop_encodingAllHeadersAreRemoved :: MissingHeaders @@ -82,4 +83,9 @@ prop_encodingAllHeadersAreRemoved hs = && "Server" `S.notMember` actual && "X-AccessToken" `S.notMember` actual where - actual = encode hs ^@.. members & fmap fst & S.fromList + actual = S.fromList (foldMap keys $ decode' $ encode hs) + +keys :: Value -> [Text] +keys = \case + Object o -> Data.HashMap.Strict.keys o + _ -> mempty diff --git a/test/Rollbar/Item/Request/Test.hs b/test/Rollbar/Item/Request/Test.hs index 0f4d612..6efb048 100644 --- a/test/Rollbar/Item/Request/Test.hs +++ b/test/Rollbar/Item/Request/Test.hs @@ -1,14 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# 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.Aeson (Value(Object), decode', encode, toJSON) import Data.CaseInsensitive (original) +import Data.Text (Text) import Prelude hiding (error) @@ -20,6 +19,8 @@ import Test.QuickCheck (conjoin, quickCheck) import Data.Set as S import Data.Text.Encoding as TE +import qualified Data.HashMap.Strict + props :: IO () props = quickCheck $ conjoin @@ -31,12 +32,17 @@ prop_valueHeadersArentWrapped :: MissingHeaders '["Authorization"] -> Bool prop_valueHeadersArentWrapped hs@(MissingHeaders rhs) = actual `S.isSubsetOf` expected where - actual = toJSON hs ^@.. members & fmap fst & S.fromList + actual = S.fromList (keys $ toJSON hs) 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 + actual = S.fromList (foldMap keys $ decode' $ encode hs) expected = S.fromList $ either (const "") id . TE.decodeUtf8' . original . fst <$> rhs + +keys :: Value -> [Text] +keys = \case + Object o -> Data.HashMap.Strict.keys o + _ -> mempty