Fix ordering logic in replaceHeader function

This commit is contained in:
Sibi Prabakaran 2017-07-13 16:29:08 +05:30
parent f3ed12ed81
commit 89fc6c46e2
No known key found for this signature in database
GPG Key ID: D19E3E0EBB557613

View File

@ -798,19 +798,30 @@ setHeader = addHeader
-- @since 1.4.36
replaceOrAddHeader :: MonadHandler m => Text -> Text -> m ()
replaceOrAddHeader a b =
let header = Header (encodeUtf8 a) (encodeUtf8 b)
in modify $ \g -> g {ghsHeaders = replaceHeader header (ghsHeaders g)}
modify $ \g -> g {ghsHeaders = replaceHeader (ghsHeaders g)}
where
repHeader = Header (encodeUtf8 a) (encodeUtf8 b)
sameHeaderName :: Header -> Header -> Bool
sameHeaderName (Header n1 _) (Header n2 _) = n1 == n2
sameHeaderName _ _ = False
replaceHeader :: Header -> Endo [Header] -> Endo [Header]
replaceHeader header endo =
replaceIndividualHeader :: [Header] -> [Header]
replaceIndividualHeader [] = [repHeader]
replaceIndividualHeader xs = aux xs []
where
aux [] acc = acc ++ [repHeader]
aux (x:xs') acc =
if sameHeaderName repHeader x
then acc ++
[repHeader] ++
(filter (\header -> not (sameHeaderName header repHeader)) xs')
else aux xs' (acc ++ [x])
replaceHeader :: Endo [Header] -> Endo [Header]
replaceHeader endo =
let allHeaders :: [Header] = appEndo endo []
in Endo
(\rest ->
header : filter (\x -> not (sameHeaderName x header)) allHeaders ++ rest)
in Endo (\rest -> replaceIndividualHeader allHeaders ++ rest)
-- | Set the Cache-Control header to indicate this response should be cached
-- for the given number of seconds.