pyrox.dev
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