@@ -1,23 +1,26 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE LambdaCase #-}
45{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE TypeOperators #-}
67module Rollbar.Item.MissingHeaders.Test where
78
8−import Control.Lens ((&), (^@..))
9+import Data.Aeson (Value (Object), decode', encode,
10+ toJSON)
11+import Data.Functor (void)
12+import Data.Hashable
13+import Data.HashSet (HashSet)
14+import Data.Text (Text)
915
10−import Data.Aeson (encode, toJSON)
11−import Data.Aeson.Lens (members)
16+import Prelude hiding (error)
1217
13−import Prelude hiding (error)
18+import Rollbar.Item.MissingHeaders (MissingHeaders (..))
19+import Rollbar.QuickCheck ()
1420
15−import Rollbar.Item.MissingHeaders (MissingHeaders(..))
16−import Rollbar.QuickCheck ()
21+import Test.QuickCheck (conjoin, quickCheck)
1722
18−import Test.QuickCheck (conjoin, quickCheck)
19−
20−import Data.Set as S
23+import qualified Data.HashSet
2124
2225props :: IO ()
2326props = do
@@ -38,48 +41,56 @@ props = do
3841
3942prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool
4043prop_valueAuthorizationIsRemoved hs =
41− "Authorization" `S.notMember` actual
44+ "Authorization" `notMember` actual
4245 where
43− actual = toJSON hs ^@.. members & fmap fst & S.fromList
46+ actual = keys (toJSON hs)
4447
4548prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool
4649prop_encodingAuthorizationIsRemoved hs =
47− "Authorization" `S.notMember` actual
50+ "Authorization" `notMember` actual
4851 where
49− actual = encode hs ^@.. members & fmap fst & S.fromList
52+ actual = foldMap keys (decode' $ encode hs)
5053
5154prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool
5255prop_valueX_AccessTokenIsRemoved hs =
53− "X-AccessToken" `S.notMember` actual
56+ "X-AccessToken" `notMember` actual
5457 where
55− actual = toJSON hs ^@.. members & fmap fst & S.fromList
58+ actual = keys (toJSON hs)
5659
5760prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool
5861prop_encodingX_AccessTokenIsRemoved hs =
59− "X-AccessToken" `S.notMember` actual
62+ "X-AccessToken" `notMember` actual
6063 where
61− actual = encode hs ^@.. members & fmap fst & S.fromList
64+ actual = foldMap keys (decode' $ encode hs)
6265
6366prop_valueAllHeadersAreRemoved
6467 :: MissingHeaders
6568 '["Authorization", "this is made up", "Server", "X-AccessToken"]
6669 -> Bool
6770prop_valueAllHeadersAreRemoved hs =
68− "Authorization" `S.notMember` actual
69− && "this is made up" `S.notMember` actual
70− && "Server" `S.notMember` actual
71− && "X-AccessToken" `S.notMember` actual
71+ "Authorization" `notMember` actual
72+ && "this is made up" `notMember` actual
73+ && "Server" `notMember` actual
74+ && "X-AccessToken" `notMember` actual
7275 where
73− actual = toJSON hs ^@.. members & fmap fst & S.fromList
76+ actual = keys (toJSON hs)
7477
7578prop_encodingAllHeadersAreRemoved
7679 :: MissingHeaders
7780 '["Authorization", "this is made up", "Server", "X-AccessToken"]
7881 -> Bool
7982prop_encodingAllHeadersAreRemoved hs =
80− "Authorization" `S.notMember` actual
81− && "this is made up" `S.notMember` actual
82− && "Server" `S.notMember` actual
83− && "X-AccessToken" `S.notMember` actual
83+ "Authorization" `notMember` actual
84+ && "this is made up" `notMember` actual
85+ && "Server" `notMember` actual
86+ && "X-AccessToken" `notMember` actual
8487 where
85− actual = encode hs ^@.. members & fmap fst & S.fromList
88+ actual = foldMap keys (decode' $ encode hs)
89+
90+keys :: Value -> HashSet Text
91+keys = \case
92+ Object o -> Data.HashSet.fromMap (void o)
93+ _ -> mempty
94+
95+notMember :: (Eq a, Hashable a) => a -> HashSet a -> Bool
96+notMember x = not . Data.HashSet.member x