pyrox.dev
fork
Configure Feed
Select the types of activity you want to include in your feed.
lol
fork
Configure Feed
Select the types of activity you want to include in your feed.
1diff --git a/servant-client-core.cabal b/servant-client-core.cabal
2index 5789da601..3faf65bb4 100644
3--- a/servant-client-core.cabal
4+++ b/servant-client-core.cabal
5@@ -96,6 +96,7 @@ test-suite spec
6 main-is: Spec.hs
7 other-modules:
8 Servant.Client.Core.Internal.BaseUrlSpec
9+ Servant.Client.Core.RequestSpec
10
11 -- Dependencies inherited from the library. No need to specify bounds.
12 build-depends:
13diff --git a/src/Servant/Client/Core/Request.hs b/src/Servant/Client/Core/Request.hs
14index 73756e702..0276d46f8 100644
15--- a/src/Servant/Client/Core/Request.hs
16+++ b/src/Servant/Client/Core/Request.hs
17@@ -64,8 +64,32 @@ data RequestF body path = Request
18 , requestHeaders :: Seq.Seq Header
19 , requestHttpVersion :: HttpVersion
20 , requestMethod :: Method
21- } deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable)
22+ } deriving (Generic, Typeable, Eq, Functor, Foldable, Traversable)
23
24+instance (Show a, Show b) =>
25+ Show (Servant.Client.Core.Request.RequestF a b) where
26+ showsPrec p req
27+ = showParen
28+ (p >= 11)
29+ ( showString "Request {requestPath = "
30+ . showsPrec 0 (requestPath req)
31+ . showString ", requestQueryString = "
32+ . showsPrec 0 (requestQueryString req)
33+ . showString ", requestBody = "
34+ . showsPrec 0 (requestBody req)
35+ . showString ", requestAccept = "
36+ . showsPrec 0 (requestAccept req)
37+ . showString ", requestHeaders = "
38+ . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))
39+ . showString ", requestHttpVersion = "
40+ . showsPrec 0 (requestHttpVersion req)
41+ . showString ", requestMethod = "
42+ . showsPrec 0 (requestMethod req)
43+ . showString "}"
44+ where
45+ redactSensitiveHeader :: Header -> Header
46+ redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
47+ redactSensitiveHeader h = h
48 instance Bifunctor RequestF where bimap = bimapDefault
49 instance Bifoldable RequestF where bifoldMap = bifoldMapDefault
50 instance Bitraversable RequestF where
51diff --git a/test/Servant/Client/Core/RequestSpec.hs b/test/Servant/Client/Core/RequestSpec.hs
52new file mode 100644
53index 000000000..99a1db7d3
54--- /dev/null
55+++ b/test/Servant/Client/Core/RequestSpec.hs
56@@ -0,0 +1,19 @@
57+{-# OPTIONS_GHC -fno-warn-orphans #-}
58+{-# LANGUAGE OverloadedStrings #-}
59+module Servant.Client.Core.RequestSpec (spec) where
60+
61+
62+import Prelude ()
63+import Prelude.Compat
64+import Control.Monad
65+import Data.List (isInfixOf)
66+import Servant.Client.Core.Request
67+import Test.Hspec
68+
69+spec :: Spec
70+spec = do
71+ describe "Request" $ do
72+ describe "show" $ do
73+ it "redacts the authorization header" $ do
74+ let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
75+ isInfixOf "secret" (show request) `shouldBe` False