|
| 1 | +diff --git a/servant-client-core.cabal b/servant-client-core.cabal |
| 2 | +index 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: |
| 13 | +diff --git a/src/Servant/Client/Core/Request.hs b/src/Servant/Client/Core/Request.hs |
| 14 | +index 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 |
| 51 | +diff --git a/test/Servant/Client/Core/RequestSpec.hs b/test/Servant/Client/Core/RequestSpec.hs |
| 52 | +new file mode 100644 |
| 53 | +index 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 |
0 commit comments