module Network.HTTP.Headers
( HasHeaders(..)
, Header(..)
, mkHeader
, hdrName
, hdrValue
, HeaderName(..)
, insertHeader
, insertHeaderIfMissing
, insertHeaders
, retrieveHeaders
, replaceHeader
, findHeader
, lookupHeader
, parseHeader
, parseHeaders
, headerMap
, HeaderSetter
) where
import Data.Char (toLower)
import Network.Stream (Result, failParse)
import Network.HTTP.Utils ( trim, split, crlf )
data = HeaderName String
hdrName :: Header -> HeaderName
hdrName :: Header -> HeaderName
hdrName (Header HeaderName
h [Char]
_) = HeaderName
h
hdrValue :: Header -> String
hdrValue :: Header -> [Char]
hdrValue (Header HeaderName
_ [Char]
v) = [Char]
v
mkHeader :: HeaderName -> String -> Header
= HeaderName -> [Char] -> Header
Header
instance Show Header where
show :: Header -> [Char]
show (Header HeaderName
key [Char]
value) = forall a. Show a => a -> ShowS
shows HeaderName
key (Char
':'forall a. a -> [a] -> [a]
:Char
' 'forall a. a -> [a] -> [a]
:[Char]
value forall a. [a] -> [a] -> [a]
++ [Char]
crlf)
data
= HdrCacheControl
| HdrConnection
| HdrDate
| HdrPragma
| HdrTransferEncoding
| HdrUpgrade
| HdrVia
| HdrAccept
| HdrAcceptCharset
| HdrAcceptEncoding
| HdrAcceptLanguage
| HdrAuthorization
| HdrCookie
| HdrExpect
| HdrFrom
| HdrHost
| HdrIfModifiedSince
| HdrIfMatch
| HdrIfNoneMatch
| HdrIfRange
| HdrIfUnmodifiedSince
| HdrMaxForwards
| HdrProxyAuthorization
| HdrRange
| HdrReferer
| HdrUserAgent
| HdrAge
| HdrLocation
| HdrProxyAuthenticate
| HdrPublic
| HdrRetryAfter
| HdrServer
| HdrSetCookie
| HdrTE
| HdrTrailer
| HdrVary
| HdrWarning
| HdrWWWAuthenticate
| HdrAllow
| HdrContentBase
| HdrContentEncoding
| HdrContentLanguage
| HdrContentLength
| HdrContentLocation
| HdrContentMD5
| HdrContentRange
| HdrContentType
| HdrETag
| HdrExpires
| HdrLastModified
| HdrContentTransferEncoding
| HdrCustom String
instance Eq HeaderName where
HdrCustom [Char]
a == :: HeaderName -> HeaderName -> Bool
== HdrCustom [Char]
b = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
a) forall a. Eq a => a -> a -> Bool
== (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
b)
HeaderName
HdrCacheControl == HeaderName
HdrCacheControl = Bool
True
HeaderName
HdrCacheControl == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrCacheControl = Bool
False
HeaderName
HdrConnection == HeaderName
HdrConnection = Bool
True
HeaderName
HdrConnection == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrConnection = Bool
False
HeaderName
HdrDate == HeaderName
HdrDate = Bool
True
HeaderName
HdrDate == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrDate = Bool
False
HeaderName
HdrPragma == HeaderName
HdrPragma = Bool
True
HeaderName
HdrPragma == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrPragma = Bool
False
HeaderName
HdrTransferEncoding == HeaderName
HdrTransferEncoding = Bool
True
HeaderName
HdrTransferEncoding == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrTransferEncoding = Bool
False
HeaderName
HdrUpgrade == HeaderName
HdrUpgrade = Bool
True
HeaderName
HdrUpgrade == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrUpgrade = Bool
False
HeaderName
HdrVia == HeaderName
HdrVia = Bool
True
HeaderName
HdrVia == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrVia = Bool
False
HeaderName
HdrAccept == HeaderName
HdrAccept = Bool
True
HeaderName
HdrAccept == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAccept = Bool
False
HeaderName
HdrAcceptCharset == HeaderName
HdrAcceptCharset = Bool
True
HeaderName
HdrAcceptCharset == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAcceptCharset = Bool
False
HeaderName
HdrAcceptEncoding == HeaderName
HdrAcceptEncoding = Bool
True
HeaderName
HdrAcceptEncoding == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAcceptEncoding = Bool
False
HeaderName
HdrAcceptLanguage == HeaderName
HdrAcceptLanguage = Bool
True
HeaderName
HdrAcceptLanguage == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAcceptLanguage = Bool
False
HeaderName
HdrAuthorization == HeaderName
HdrAuthorization = Bool
True
HeaderName
HdrAuthorization == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAuthorization = Bool
False
HeaderName
HdrCookie == HeaderName
HdrCookie = Bool
True
HeaderName
HdrCookie == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrCookie = Bool
False
HeaderName
HdrExpect == HeaderName
HdrExpect = Bool
True
HeaderName
HdrExpect == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrExpect = Bool
False
HeaderName
HdrFrom == HeaderName
HdrFrom = Bool
True
HeaderName
HdrFrom == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrFrom = Bool
False
HeaderName
HdrHost == HeaderName
HdrHost = Bool
True
HeaderName
HdrHost == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrHost = Bool
False
HeaderName
HdrIfModifiedSince == HeaderName
HdrIfModifiedSince = Bool
True
HeaderName
HdrIfModifiedSince == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrIfModifiedSince = Bool
False
HeaderName
HdrIfMatch == HeaderName
HdrIfMatch = Bool
True
HeaderName
HdrIfMatch == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrIfMatch = Bool
False
HeaderName
HdrIfNoneMatch == HeaderName
HdrIfNoneMatch = Bool
True
HeaderName
HdrIfNoneMatch == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrIfNoneMatch = Bool
False
HeaderName
HdrIfRange == HeaderName
HdrIfRange = Bool
True
HeaderName
HdrIfRange == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrIfRange = Bool
False
HeaderName
HdrIfUnmodifiedSince == HeaderName
HdrIfUnmodifiedSince = Bool
True
HeaderName
HdrIfUnmodifiedSince == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrIfUnmodifiedSince = Bool
False
HeaderName
HdrMaxForwards == HeaderName
HdrMaxForwards = Bool
True
HeaderName
HdrMaxForwards == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrMaxForwards = Bool
False
HeaderName
HdrProxyAuthorization == HeaderName
HdrProxyAuthorization = Bool
True
HeaderName
HdrProxyAuthorization == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrProxyAuthorization = Bool
False
HeaderName
HdrRange == HeaderName
HdrRange = Bool
True
HeaderName
HdrRange == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrRange = Bool
False
HeaderName
HdrReferer == HeaderName
HdrReferer = Bool
True
HeaderName
HdrReferer == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrReferer = Bool
False
HeaderName
HdrUserAgent == HeaderName
HdrUserAgent = Bool
True
HeaderName
HdrUserAgent == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrUserAgent = Bool
False
HeaderName
HdrAge == HeaderName
HdrAge = Bool
True
HeaderName
HdrAge == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAge = Bool
False
HeaderName
HdrLocation == HeaderName
HdrLocation = Bool
True
HeaderName
HdrLocation == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrLocation = Bool
False
HeaderName
HdrProxyAuthenticate == HeaderName
HdrProxyAuthenticate = Bool
True
HeaderName
HdrProxyAuthenticate == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrProxyAuthenticate = Bool
False
HeaderName
HdrPublic == HeaderName
HdrPublic = Bool
True
HeaderName
HdrPublic == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrPublic = Bool
False
HeaderName
HdrRetryAfter == HeaderName
HdrRetryAfter = Bool
True
HeaderName
HdrRetryAfter == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrRetryAfter = Bool
False
HeaderName
HdrServer == HeaderName
HdrServer = Bool
True
HeaderName
HdrServer == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrServer = Bool
False
HeaderName
HdrSetCookie == HeaderName
HdrSetCookie = Bool
True
HeaderName
HdrSetCookie == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrSetCookie = Bool
False
HeaderName
HdrTE == HeaderName
HdrTE = Bool
True
HeaderName
HdrTE == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrTE = Bool
False
HeaderName
HdrTrailer == HeaderName
HdrTrailer = Bool
True
HeaderName
HdrTrailer == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrTrailer = Bool
False
HeaderName
HdrVary == HeaderName
HdrVary = Bool
True
HeaderName
HdrVary == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrVary = Bool
False
HeaderName
HdrWarning == HeaderName
HdrWarning = Bool
True
HeaderName
HdrWarning == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrWarning = Bool
False
HeaderName
HdrWWWAuthenticate == HeaderName
HdrWWWAuthenticate = Bool
True
HeaderName
HdrWWWAuthenticate == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrWWWAuthenticate = Bool
False
HeaderName
HdrAllow == HeaderName
HdrAllow = Bool
True
HeaderName
HdrAllow == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrAllow = Bool
False
HeaderName
HdrContentBase == HeaderName
HdrContentBase = Bool
True
HeaderName
HdrContentBase == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentBase = Bool
False
HeaderName
HdrContentEncoding == HeaderName
HdrContentEncoding = Bool
True
HeaderName
HdrContentEncoding == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentEncoding = Bool
False
HeaderName
HdrContentLanguage == HeaderName
HdrContentLanguage = Bool
True
HeaderName
HdrContentLanguage == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentLanguage = Bool
False
HeaderName
HdrContentLength == HeaderName
HdrContentLength = Bool
True
HeaderName
HdrContentLength == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentLength = Bool
False
HeaderName
HdrContentLocation == HeaderName
HdrContentLocation = Bool
True
HeaderName
HdrContentLocation == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentLocation = Bool
False
HeaderName
HdrContentMD5 == HeaderName
HdrContentMD5 = Bool
True
HeaderName
HdrContentMD5 == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentMD5 = Bool
False
HeaderName
HdrContentRange == HeaderName
HdrContentRange = Bool
True
HeaderName
HdrContentRange == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentRange = Bool
False
HeaderName
HdrContentType == HeaderName
HdrContentType = Bool
True
HeaderName
HdrContentType == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentType = Bool
False
HeaderName
HdrETag == HeaderName
HdrETag = Bool
True
HeaderName
HdrETag == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrETag = Bool
False
HeaderName
HdrExpires == HeaderName
HdrExpires = Bool
True
HeaderName
HdrExpires == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrExpires = Bool
False
HeaderName
HdrLastModified == HeaderName
HdrLastModified = Bool
True
HeaderName
HdrLastModified == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrLastModified = Bool
False
HeaderName
HdrContentTransferEncoding == HeaderName
HdrContentTransferEncoding = Bool
True
HeaderName
HdrContentTransferEncoding == HeaderName
_ = Bool
False
HeaderName
_ == HeaderName
HdrContentTransferEncoding = Bool
False
headerMap :: [ (String,HeaderName) ]
=
[ forall {a} {b}. a -> b -> (a, b)
p [Char]
"Cache-Control" HeaderName
HdrCacheControl
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Connection" HeaderName
HdrConnection
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Date" HeaderName
HdrDate
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Pragma" HeaderName
HdrPragma
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Transfer-Encoding" HeaderName
HdrTransferEncoding
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Upgrade" HeaderName
HdrUpgrade
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Via" HeaderName
HdrVia
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Accept" HeaderName
HdrAccept
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Accept-Charset" HeaderName
HdrAcceptCharset
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Accept-Encoding" HeaderName
HdrAcceptEncoding
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Accept-Language" HeaderName
HdrAcceptLanguage
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Authorization" HeaderName
HdrAuthorization
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Cookie" HeaderName
HdrCookie
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Expect" HeaderName
HdrExpect
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"From" HeaderName
HdrFrom
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Host" HeaderName
HdrHost
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"If-Modified-Since" HeaderName
HdrIfModifiedSince
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"If-Match" HeaderName
HdrIfMatch
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"If-None-Match" HeaderName
HdrIfNoneMatch
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"If-Range" HeaderName
HdrIfRange
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"If-Unmodified-Since" HeaderName
HdrIfUnmodifiedSince
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Max-Forwards" HeaderName
HdrMaxForwards
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Proxy-Authorization" HeaderName
HdrProxyAuthorization
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Range" HeaderName
HdrRange
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Referer" HeaderName
HdrReferer
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"User-Agent" HeaderName
HdrUserAgent
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Age" HeaderName
HdrAge
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Location" HeaderName
HdrLocation
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Proxy-Authenticate" HeaderName
HdrProxyAuthenticate
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Public" HeaderName
HdrPublic
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Retry-After" HeaderName
HdrRetryAfter
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Server" HeaderName
HdrServer
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Set-Cookie" HeaderName
HdrSetCookie
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"TE" HeaderName
HdrTE
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Trailer" HeaderName
HdrTrailer
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Vary" HeaderName
HdrVary
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Warning" HeaderName
HdrWarning
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"WWW-Authenticate" HeaderName
HdrWWWAuthenticate
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Allow" HeaderName
HdrAllow
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Base" HeaderName
HdrContentBase
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Encoding" HeaderName
HdrContentEncoding
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Language" HeaderName
HdrContentLanguage
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Length" HeaderName
HdrContentLength
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Location" HeaderName
HdrContentLocation
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-MD5" HeaderName
HdrContentMD5
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Range" HeaderName
HdrContentRange
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Type" HeaderName
HdrContentType
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"ETag" HeaderName
HdrETag
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Expires" HeaderName
HdrExpires
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Last-Modified" HeaderName
HdrLastModified
, forall {a} {b}. a -> b -> (a, b)
p [Char]
"Content-Transfer-Encoding" HeaderName
HdrContentTransferEncoding
]
where
p :: a -> b -> (a, b)
p a
a b
b = (a
a,b
b)
instance Show HeaderName where
show :: HeaderName -> [Char]
show (HdrCustom [Char]
s) = [Char]
s
show HeaderName
x = case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==HeaderName
x)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [([Char], HeaderName)]
headerMap of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"headerMap incomplete"
(([Char], HeaderName)
h:[([Char], HeaderName)]
_) -> forall a b. (a, b) -> a
fst ([Char], HeaderName)
h
class x where
:: x -> [Header]
:: x -> [Header] -> x
type a = HeaderName -> String -> a -> a
insertHeader :: HasHeaders a => HeaderSetter a
HeaderName
name [Char]
value a
x = forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x [Header]
newHeaders
where
newHeaders :: [Header]
newHeaders = (HeaderName -> [Char] -> Header
Header HeaderName
name [Char]
value) forall a. a -> [a] -> [a]
: forall x. HasHeaders x => x -> [Header]
getHeaders a
x
insertHeaderIfMissing :: HasHeaders a => HeaderSetter a
HeaderName
name [Char]
value a
x = forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x ([Header] -> [Header]
newHeaders forall a b. (a -> b) -> a -> b
$ forall x. HasHeaders x => x -> [Header]
getHeaders a
x)
where
newHeaders :: [Header] -> [Header]
newHeaders list :: [Header]
list@(h :: Header
h@(Header HeaderName
n [Char]
_): [Header]
rest)
| HeaderName
n forall a. Eq a => a -> a -> Bool
== HeaderName
name = [Header]
list
| Bool
otherwise = Header
h forall a. a -> [a] -> [a]
: [Header] -> [Header]
newHeaders [Header]
rest
newHeaders [] = [HeaderName -> [Char] -> Header
Header HeaderName
name [Char]
value]
replaceHeader :: HasHeaders a => HeaderSetter a
HeaderName
name [Char]
value a
h = forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
h [Header]
newHeaders
where
newHeaders :: [Header]
newHeaders = HeaderName -> [Char] -> Header
Header HeaderName
name [Char]
value forall a. a -> [a] -> [a]
: [ Header
x | x :: Header
x@(Header HeaderName
n [Char]
_) <- forall x. HasHeaders x => x -> [Header]
getHeaders a
h, HeaderName
name forall a. Eq a => a -> a -> Bool
/= HeaderName
n ]
insertHeaders :: HasHeaders a => [Header] -> a -> a
[Header]
hdrs a
x = forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x (forall x. HasHeaders x => x -> [Header]
getHeaders a
x forall a. [a] -> [a] -> [a]
++ [Header]
hdrs)
retrieveHeaders :: HasHeaders a => HeaderName -> a -> [Header]
HeaderName
name a
x = forall a. (a -> Bool) -> [a] -> [a]
filter Header -> Bool
matchname (forall x. HasHeaders x => x -> [Header]
getHeaders a
x)
where
matchname :: Header -> Bool
matchname (Header HeaderName
n [Char]
_) = HeaderName
n forall a. Eq a => a -> a -> Bool
== HeaderName
name
findHeader :: HasHeaders a => HeaderName -> a -> Maybe String
HeaderName
n a
x = HeaderName -> [Header] -> Maybe [Char]
lookupHeader HeaderName
n (forall x. HasHeaders x => x -> [Header]
getHeaders a
x)
lookupHeader :: HeaderName -> [Header] -> Maybe String
HeaderName
_ [] = forall a. Maybe a
Nothing
lookupHeader HeaderName
v (Header HeaderName
n [Char]
s:[Header]
t)
| HeaderName
v forall a. Eq a => a -> a -> Bool
== HeaderName
n = forall a. a -> Maybe a
Just [Char]
s
| Bool
otherwise = HeaderName -> [Header] -> Maybe [Char]
lookupHeader HeaderName
v [Header]
t
parseHeader :: String -> Result Header
[Char]
str =
case forall a. Eq a => a -> [a] -> Maybe ([a], [a])
split Char
':' [Char]
str of
Maybe ([Char], [Char])
Nothing -> forall a. [Char] -> Result a
failParse ([Char]
"Unable to parse header: " forall a. [a] -> [a] -> [a]
++ [Char]
str)
Just ([Char]
k,[Char]
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HeaderName -> [Char] -> Header
Header ([Char] -> HeaderName
fn [Char]
k) (ShowS
trim forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [Char]
v)
where
fn :: [Char] -> HeaderName
fn [Char]
k = case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
match [Char]
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], HeaderName)]
headerMap of
[] -> ([Char] -> HeaderName
HdrCustom [Char]
k)
(HeaderName
h:[HeaderName]
_) -> HeaderName
h
match :: String -> String -> Bool
match :: [Char] -> [Char] -> Bool
match [Char]
s1 [Char]
s2 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s1 forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s2
parseHeaders :: [String] -> Result [Header]
= forall a. [a] -> [Result a] -> Result [a]
catRslts [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Result Header
parseHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
clean) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [[Char]] -> [[Char]]
joinExtended [Char]
""
where
joinExtended :: [Char] -> [[Char]] -> [[Char]]
joinExtended [Char]
old [] = [[Char]
old]
joinExtended [Char]
old ([Char]
h : [[Char]]
t)
| [Char] -> Bool
isLineExtension [Char]
h = [Char] -> [[Char]] -> [[Char]]
joinExtended ([Char]
old forall a. [a] -> [a] -> [a]
++ Char
' ' forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail [Char]
h) [[Char]]
t
| Bool
otherwise = [Char]
old forall a. a -> [a] -> [a]
: [Char] -> [[Char]] -> [[Char]]
joinExtended [Char]
h [[Char]]
t
isLineExtension :: [Char] -> Bool
isLineExtension (Char
x:[Char]
_) = Char
x forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\t'
isLineExtension [Char]
_ = Bool
False
clean :: ShowS
clean [] = []
clean (Char
h:[Char]
t) | Char
h forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\t\r\n" = Char
' ' forall a. a -> [a] -> [a]
: ShowS
clean [Char]
t
| Bool
otherwise = Char
h forall a. a -> [a] -> [a]
: ShowS
clean [Char]
t
catRslts :: [a] -> [Result a] -> Result [a]
catRslts :: forall a. [a] -> [Result a] -> Result [a]
catRslts [a]
list (Result a
h:[Result a]
t) =
case Result a
h of
Left ConnError
_ -> forall a. [a] -> [Result a] -> Result [a]
catRslts [a]
list [Result a]
t
Right a
v -> forall a. [a] -> [Result a] -> Result [a]
catRslts (a
vforall a. a -> [a] -> [a]
:[a]
list) [Result a]
t
catRslts [a]
list [] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [a]
list