@@ -1,26 +1,23 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE LambdaCase #-}
54{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE TypeOperators #-}
76module Rollbar.Item.MissingHeaders.Test where
87
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)
8+import Control.Lens ((&), (^@..))
159
16−import Prelude hiding (error)
10+import Data.Aeson (encode, toJSON)
11+import Data.Aeson.Lens (members)
1712
18−import Rollbar.Item.MissingHeaders (MissingHeaders (..))
19−import Rollbar.QuickCheck ()
13+import Prelude hiding (error)
2014
21−import Test.QuickCheck (conjoin, quickCheck)
15+import Rollbar.Item.MissingHeaders (MissingHeaders(..))
16+import Rollbar.QuickCheck ()
2217
23−import qualified Data.HashSet
18+import Test.QuickCheck (conjoin, quickCheck)
19+
20+import Data.Set as S
2421
2522props :: IO ()
2623props = do
@@ -41,56 +38,48 @@ props = do
4138
4239prop_valueAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool
4340prop_valueAuthorizationIsRemoved hs =
44− "Authorization" `notMember` actual
41+ "Authorization" `S.notMember` actual
4542 where
46− actual = keys (toJSON hs)
43+ actual = toJSON hs ^@.. members & fmap fst & S.fromList
4744
4845prop_encodingAuthorizationIsRemoved :: MissingHeaders '["Authorization"] -> Bool
4946prop_encodingAuthorizationIsRemoved hs =
50− "Authorization" `notMember` actual
47+ "Authorization" `S.notMember` actual
5148 where
52− actual = foldMap keys (decode' $ encode hs)
49+ actual = encode hs ^@.. members & fmap fst & S.fromList
5350
5451prop_valueX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool
5552prop_valueX_AccessTokenIsRemoved hs =
56− "X-AccessToken" `notMember` actual
53+ "X-AccessToken" `S.notMember` actual
5754 where
58− actual = keys (toJSON hs)
55+ actual = toJSON hs ^@.. members & fmap fst & S.fromList
5956
6057prop_encodingX_AccessTokenIsRemoved :: MissingHeaders '["X-AccessToken"] -> Bool
6158prop_encodingX_AccessTokenIsRemoved hs =
62− "X-AccessToken" `notMember` actual
59+ "X-AccessToken" `S.notMember` actual
6360 where
64− actual = foldMap keys (decode' $ encode hs)
61+ actual = encode hs ^@.. members & fmap fst & S.fromList
6562
6663prop_valueAllHeadersAreRemoved
6764 :: MissingHeaders
6865 '["Authorization", "this is made up", "Server", "X-AccessToken"]
6966 -> Bool
7067prop_valueAllHeadersAreRemoved hs =
71− "Authorization" `notMember` actual
72− && "this is made up" `notMember` actual
73− && "Server" `notMember` actual
74− && "X-AccessToken" `notMember` actual
68+ "Authorization" `S.notMember` actual
69+ && "this is made up" `S.notMember` actual
70+ && "Server" `S.notMember` actual
71+ && "X-AccessToken" `S.notMember` actual
7572 where
76− actual = keys (toJSON hs)
73+ actual = toJSON hs ^@.. members & fmap fst & S.fromList
7774
7875prop_encodingAllHeadersAreRemoved
7976 :: MissingHeaders
8077 '["Authorization", "this is made up", "Server", "X-AccessToken"]
8178 -> Bool
8279prop_encodingAllHeadersAreRemoved hs =
83− "Authorization" `notMember` actual
84− && "this is made up" `notMember` actual
85− && "Server" `notMember` actual
86− && "X-AccessToken" `notMember` actual
80+ "Authorization" `S.notMember` actual
81+ && "this is made up" `S.notMember` actual
82+ && "Server" `S.notMember` actual
83+ && "X-AccessToken" `S.notMember` actual
8784 where
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
85+ actual = encode hs ^@.. members & fmap fst & S.fromList