servant-client-core: Redact Authorization header

This commit is contained in:
Robert Hensing 2019-11-05 16:31:06 +01:00
parent 925d50d752
commit ce3c68f94b
3 changed files with 45 additions and 1 deletions

View file

@ -96,6 +96,7 @@ test-suite spec
main-is: Spec.hs main-is: Spec.hs
other-modules: other-modules:
Servant.Client.Core.Internal.BaseUrlSpec Servant.Client.Core.Internal.BaseUrlSpec
Servant.Client.Core.RequestSpec
-- Dependencies inherited from the library. No need to specify bounds. -- Dependencies inherited from the library. No need to specify bounds.
build-depends: build-depends:

View file

@ -64,8 +64,32 @@ data RequestF body path = Request
, requestHeaders :: Seq.Seq Header , requestHeaders :: Seq.Seq Header
, requestHttpVersion :: HttpVersion , requestHttpVersion :: HttpVersion
, requestMethod :: Method , requestMethod :: Method
} deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable) } deriving (Generic, Typeable, Eq, Functor, Foldable, Traversable)
instance (Show a, Show b) =>
Show (Servant.Client.Core.Request.RequestF a b) where
showsPrec p req
= showParen
(p >= 11)
( showString "Request {requestPath = "
. showsPrec 0 (requestPath req)
. showString ", requestQueryString = "
. showsPrec 0 (requestQueryString req)
. showString ", requestBody = "
. showsPrec 0 (requestBody req)
. showString ", requestAccept = "
. showsPrec 0 (requestAccept req)
. showString ", requestHeaders = "
. showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))
. showString ", requestHttpVersion = "
. showsPrec 0 (requestHttpVersion req)
. showString ", requestMethod = "
. showsPrec 0 (requestMethod req)
. showString "}"
where
redactSensitiveHeader :: Header -> Header
redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
redactSensitiveHeader h = h
instance Bifunctor RequestF where bimap = bimapDefault instance Bifunctor RequestF where bimap = bimapDefault
instance Bifoldable RequestF where bifoldMap = bifoldMapDefault instance Bifoldable RequestF where bifoldMap = bifoldMapDefault
instance Bitraversable RequestF where instance Bitraversable RequestF where

View file

@ -0,0 +1,19 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
module Servant.Client.Core.RequestSpec (spec) where
import Prelude ()
import Prelude.Compat
import Control.Monad
import Data.List (isInfixOf)
import Servant.Client.Core.Request
import Test.Hspec
spec :: Spec
spec = do
describe "Request" $ do
describe "show" $ do
it "redacts the authorization header" $ do
let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
isInfixOf "secret" (show request) `shouldBe` False