module Network.Bugsnag.BugsnagRequestHeaders
    ( BugsnagRequestHeaders
    , bugsnagRequestHeaders
    , redactBugsnagRequestHeaders
    )
where

import Prelude

import Data.Aeson
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
import Network.HTTP.Types

-- | Wrapper around Wai's 'RequestHeaders', for custom 'ToJSON' instance
newtype BugsnagRequestHeaders = BugsnagRequestHeaders
    { BugsnagRequestHeaders -> RequestHeaders
unBugsnagRequestHeaders :: RequestHeaders
    }
    deriving stock (Int -> BugsnagRequestHeaders -> ShowS
[BugsnagRequestHeaders] -> ShowS
BugsnagRequestHeaders -> String
(Int -> BugsnagRequestHeaders -> ShowS)
-> (BugsnagRequestHeaders -> String)
-> ([BugsnagRequestHeaders] -> ShowS)
-> Show BugsnagRequestHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BugsnagRequestHeaders] -> ShowS
$cshowList :: [BugsnagRequestHeaders] -> ShowS
show :: BugsnagRequestHeaders -> String
$cshow :: BugsnagRequestHeaders -> String
showsPrec :: Int -> BugsnagRequestHeaders -> ShowS
$cshowsPrec :: Int -> BugsnagRequestHeaders -> ShowS
Show, BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
(BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> Eq BugsnagRequestHeaders
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c/= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
== :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c== :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
Eq, Eq BugsnagRequestHeaders
Eq BugsnagRequestHeaders
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Ordering)
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> (BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool)
-> (BugsnagRequestHeaders
    -> BugsnagRequestHeaders -> BugsnagRequestHeaders)
-> (BugsnagRequestHeaders
    -> BugsnagRequestHeaders -> BugsnagRequestHeaders)
-> Ord BugsnagRequestHeaders
BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
BugsnagRequestHeaders -> BugsnagRequestHeaders -> Ordering
BugsnagRequestHeaders
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BugsnagRequestHeaders
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
$cmin :: BugsnagRequestHeaders
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
max :: BugsnagRequestHeaders
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
$cmax :: BugsnagRequestHeaders
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
>= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c>= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
> :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c> :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
<= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c<= :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
< :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
$c< :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Bool
compare :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Ordering
$ccompare :: BugsnagRequestHeaders -> BugsnagRequestHeaders -> Ordering
$cp1Ord :: Eq BugsnagRequestHeaders
Ord)

instance ToJSON BugsnagRequestHeaders where
    toJSON :: BugsnagRequestHeaders -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (BugsnagRequestHeaders -> [Pair])
-> BugsnagRequestHeaders
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Pair) -> RequestHeaders -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> Pair
forall kv. KeyValue kv => (CI ByteString, ByteString) -> kv
headerToKeyValue (RequestHeaders -> [Pair])
-> (BugsnagRequestHeaders -> RequestHeaders)
-> BugsnagRequestHeaders
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagRequestHeaders -> RequestHeaders
unBugsnagRequestHeaders
    toEncoding :: BugsnagRequestHeaders -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (BugsnagRequestHeaders -> Series)
-> BugsnagRequestHeaders
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Series) -> RequestHeaders -> Series
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CI ByteString, ByteString) -> Series
forall kv. KeyValue kv => (CI ByteString, ByteString) -> kv
headerToKeyValue (RequestHeaders -> Series)
-> (BugsnagRequestHeaders -> RequestHeaders)
-> BugsnagRequestHeaders
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagRequestHeaders -> RequestHeaders
unBugsnagRequestHeaders

headerToKeyValue :: KeyValue kv => (CI ByteString, ByteString) -> kv
headerToKeyValue :: (CI ByteString, ByteString) -> kv
headerToKeyValue (CI ByteString
name, ByteString
value) =
    ByteString -> Text
TE.decodeUtf8 (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
name) Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
TE.decodeUtf8 ByteString
value)

-- | Create 'BugsnagRequestHeaders'
bugsnagRequestHeaders :: RequestHeaders -> BugsnagRequestHeaders
bugsnagRequestHeaders :: RequestHeaders -> BugsnagRequestHeaders
bugsnagRequestHeaders = RequestHeaders -> BugsnagRequestHeaders
BugsnagRequestHeaders

-- | For headers with the given names, replace their value with "<redacted>".
--
-- This is intended to remove sensitive data from headers.
redactBugsnagRequestHeaders
    :: [HeaderName] -> BugsnagRequestHeaders -> BugsnagRequestHeaders
redactBugsnagRequestHeaders :: [CI ByteString] -> BugsnagRequestHeaders -> BugsnagRequestHeaders
redactBugsnagRequestHeaders [CI ByteString]
redactList = ((CI ByteString, ByteString) -> (CI ByteString, ByteString))
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
mapBugsnagRequestHeaders (CI ByteString, ByteString) -> (CI ByteString, ByteString)
redactHeader
  where
    redactHeader :: Header -> Header
    redactHeader :: (CI ByteString, ByteString) -> (CI ByteString, ByteString)
redactHeader (CI ByteString
k, ByteString
_) | CI ByteString
k CI ByteString -> [CI ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CI ByteString]
redactList = (CI ByteString
k, ByteString
"<redacted>")
    redactHeader (CI ByteString, ByteString)
h = (CI ByteString, ByteString)
h

mapBugsnagRequestHeaders
    :: (Header -> Header) -> BugsnagRequestHeaders -> BugsnagRequestHeaders
mapBugsnagRequestHeaders :: ((CI ByteString, ByteString) -> (CI ByteString, ByteString))
-> BugsnagRequestHeaders -> BugsnagRequestHeaders
mapBugsnagRequestHeaders (CI ByteString, ByteString) -> (CI ByteString, ByteString)
fn (BugsnagRequestHeaders RequestHeaders
headers) =
    RequestHeaders -> BugsnagRequestHeaders
BugsnagRequestHeaders (RequestHeaders -> BugsnagRequestHeaders)
-> RequestHeaders -> BugsnagRequestHeaders
forall a b. (a -> b) -> a -> b
$ ((CI ByteString, ByteString) -> (CI ByteString, ByteString))
-> RequestHeaders -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> (CI ByteString, ByteString)
fn RequestHeaders
headers