------------------------------------------------------------------------------- |-- Module : Network.HTTP.Headers-- Copyright : See LICENSE file-- License : BSD---- Maintainer : Ganesh Sittampalam <ganesh@earth.li>-- Stability : experimental-- Portability : non-portable (not tested)---- This module provides the data types for representing HTTP headers, and-- operations for looking up header values and working with sequences of-- header values in 'Request's and 'Response's. To avoid having to provide-- separate set of operations for doing so, we introduce a type class 'HasHeaders'-- to facilitate writing such processing using overloading instead.-------------------------------------------------------------------------------moduleNetwork.HTTP.Headers(HasHeaders (..)-- type class,Header (..),mkHeader -- :: HeaderName -> String -> Header,hdrName -- :: Header -> HeaderName,hdrValue -- :: Header -> String,HeaderName (..),insertHeader -- :: HasHeaders a => HeaderName -> String -> a -> a,insertHeaderIfMissing -- :: HasHeaders a => HeaderName -> String -> a -> a,insertHeaders -- :: HasHeaders a => [Header] -> a -> a,retrieveHeaders -- :: HasHeaders a => HeaderName -> a -> [Header],replaceHeader -- :: HasHeaders a => HeaderName -> String -> a -> a,findHeader -- :: HasHeaders a => HeaderName -> a -> Maybe String,lookupHeader -- :: HeaderName -> [Header] -> Maybe String,parseHeader -- :: parseHeader :: String -> Result Header,parseHeaders -- :: [String] -> Result [Header],headerMap -- :: [(String, HeaderName)],HeaderSetter )whereimportData.Char(toLower)importNetwork.Stream (Result ,failParse )importNetwork.HTTP.Utils (trim ,split ,crlf )-- | The @Header@ data type pairs header names & values.dataHeader =Header HeaderName StringhdrName ::Header ->HeaderName hdrName :: Header -> HeaderName
hdrName (Header HeaderName
h String
_)=HeaderName
h hdrValue ::Header ->StringhdrValue :: Header -> String
hdrValue (Header HeaderName
_String
v )=String
v -- | Header constructor as a function, hiding above rep.mkHeader ::HeaderName ->String->Header mkHeader :: HeaderName -> String -> Header
mkHeader =HeaderName -> String -> Header
Header instanceShowHeader whereshow :: Header -> String
show(Header HeaderName
key String
value )=HeaderName -> ShowS
forall a. Show a => a -> ShowS
showsHeaderName
key (Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
value String -> ShowS
forall a. [a] -> [a] -> [a]
++String
crlf )-- | HTTP @HeaderName@ type, a Haskell data constructor for each-- specification-defined header, prefixed with @Hdr@ and CamelCased,-- (i.e., eliding the @-@ in the process.) Should you require using-- a custom header, there's the @HdrCustom@ constructor which takes-- a @String@ argument.---- Encoding HTTP header names differently, as Strings perhaps, is an-- equally fine choice..no decidedly clear winner, but let's stick-- with data constructors here.--dataHeaderName -- Generic Headers --=HdrCacheControl |HdrConnection |HdrDate |HdrPragma |HdrTransferEncoding |HdrUpgrade |HdrVia -- Request Headers --|HdrAccept |HdrAcceptCharset |HdrAcceptEncoding |HdrAcceptLanguage |HdrAuthorization |HdrCookie |HdrExpect |HdrFrom |HdrHost |HdrIfModifiedSince |HdrIfMatch |HdrIfNoneMatch |HdrIfRange |HdrIfUnmodifiedSince |HdrMaxForwards |HdrProxyAuthorization |HdrRange |HdrReferer |HdrUserAgent -- Response Headers|HdrAge |HdrLocation |HdrProxyAuthenticate |HdrPublic |HdrRetryAfter |HdrServer |HdrSetCookie |HdrTE |HdrTrailer |HdrVary |HdrWarning |HdrWWWAuthenticate -- Entity Headers|HdrAllow |HdrContentBase |HdrContentEncoding |HdrContentLanguage |HdrContentLength |HdrContentLocation |HdrContentMD5 |HdrContentRange |HdrContentType |HdrETag |HdrExpires |HdrLastModified -- | MIME entity headers (for sub-parts)|HdrContentTransferEncoding -- | Allows for unrecognised or experimental headers.|HdrCustom String-- not in header map below.instanceEqHeaderName whereHdrCustom String
a == :: HeaderName -> HeaderName -> Bool
==HdrCustom String
b =((Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapChar -> Char
toLowerString
a )String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==((Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapChar -> Char
toLowerString
b )HeaderName
HdrCacheControl ==HeaderName
HdrCacheControl =Bool
TrueHeaderName
HdrCacheControl ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrCacheControl =Bool
FalseHeaderName
HdrConnection ==HeaderName
HdrConnection =Bool
TrueHeaderName
HdrConnection ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrConnection =Bool
FalseHeaderName
HdrDate ==HeaderName
HdrDate =Bool
TrueHeaderName
HdrDate ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrDate =Bool
FalseHeaderName
HdrPragma ==HeaderName
HdrPragma =Bool
TrueHeaderName
HdrPragma ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrPragma =Bool
FalseHeaderName
HdrTransferEncoding ==HeaderName
HdrTransferEncoding =Bool
TrueHeaderName
HdrTransferEncoding ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrTransferEncoding =Bool
FalseHeaderName
HdrUpgrade ==HeaderName
HdrUpgrade =Bool
TrueHeaderName
HdrUpgrade ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrUpgrade =Bool
FalseHeaderName
HdrVia ==HeaderName
HdrVia =Bool
TrueHeaderName
HdrVia ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrVia =Bool
FalseHeaderName
HdrAccept ==HeaderName
HdrAccept =Bool
TrueHeaderName
HdrAccept ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAccept =Bool
FalseHeaderName
HdrAcceptCharset ==HeaderName
HdrAcceptCharset =Bool
TrueHeaderName
HdrAcceptCharset ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAcceptCharset =Bool
FalseHeaderName
HdrAcceptEncoding ==HeaderName
HdrAcceptEncoding =Bool
TrueHeaderName
HdrAcceptEncoding ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAcceptEncoding =Bool
FalseHeaderName
HdrAcceptLanguage ==HeaderName
HdrAcceptLanguage =Bool
TrueHeaderName
HdrAcceptLanguage ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAcceptLanguage =Bool
FalseHeaderName
HdrAuthorization ==HeaderName
HdrAuthorization =Bool
TrueHeaderName
HdrAuthorization ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAuthorization =Bool
FalseHeaderName
HdrCookie ==HeaderName
HdrCookie =Bool
TrueHeaderName
HdrCookie ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrCookie =Bool
FalseHeaderName
HdrExpect ==HeaderName
HdrExpect =Bool
TrueHeaderName
HdrExpect ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrExpect =Bool
FalseHeaderName
HdrFrom ==HeaderName
HdrFrom =Bool
TrueHeaderName
HdrFrom ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrFrom =Bool
FalseHeaderName
HdrHost ==HeaderName
HdrHost =Bool
TrueHeaderName
HdrHost ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrHost =Bool
FalseHeaderName
HdrIfModifiedSince ==HeaderName
HdrIfModifiedSince =Bool
TrueHeaderName
HdrIfModifiedSince ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrIfModifiedSince =Bool
FalseHeaderName
HdrIfMatch ==HeaderName
HdrIfMatch =Bool
TrueHeaderName
HdrIfMatch ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrIfMatch =Bool
FalseHeaderName
HdrIfNoneMatch ==HeaderName
HdrIfNoneMatch =Bool
TrueHeaderName
HdrIfNoneMatch ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrIfNoneMatch =Bool
FalseHeaderName
HdrIfRange ==HeaderName
HdrIfRange =Bool
TrueHeaderName
HdrIfRange ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrIfRange =Bool
FalseHeaderName
HdrIfUnmodifiedSince ==HeaderName
HdrIfUnmodifiedSince =Bool
TrueHeaderName
HdrIfUnmodifiedSince ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrIfUnmodifiedSince =Bool
FalseHeaderName
HdrMaxForwards ==HeaderName
HdrMaxForwards =Bool
TrueHeaderName
HdrMaxForwards ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrMaxForwards =Bool
FalseHeaderName
HdrProxyAuthorization ==HeaderName
HdrProxyAuthorization =Bool
TrueHeaderName
HdrProxyAuthorization ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrProxyAuthorization =Bool
FalseHeaderName
HdrRange ==HeaderName
HdrRange =Bool
TrueHeaderName
HdrRange ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrRange =Bool
FalseHeaderName
HdrReferer ==HeaderName
HdrReferer =Bool
TrueHeaderName
HdrReferer ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrReferer =Bool
FalseHeaderName
HdrUserAgent ==HeaderName
HdrUserAgent =Bool
TrueHeaderName
HdrUserAgent ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrUserAgent =Bool
FalseHeaderName
HdrAge ==HeaderName
HdrAge =Bool
TrueHeaderName
HdrAge ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAge =Bool
FalseHeaderName
HdrLocation ==HeaderName
HdrLocation =Bool
TrueHeaderName
HdrLocation ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrLocation =Bool
FalseHeaderName
HdrProxyAuthenticate ==HeaderName
HdrProxyAuthenticate =Bool
TrueHeaderName
HdrProxyAuthenticate ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrProxyAuthenticate =Bool
FalseHeaderName
HdrPublic ==HeaderName
HdrPublic =Bool
TrueHeaderName
HdrPublic ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrPublic =Bool
FalseHeaderName
HdrRetryAfter ==HeaderName
HdrRetryAfter =Bool
TrueHeaderName
HdrRetryAfter ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrRetryAfter =Bool
FalseHeaderName
HdrServer ==HeaderName
HdrServer =Bool
TrueHeaderName
HdrServer ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrServer =Bool
FalseHeaderName
HdrSetCookie ==HeaderName
HdrSetCookie =Bool
TrueHeaderName
HdrSetCookie ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrSetCookie =Bool
FalseHeaderName
HdrTE ==HeaderName
HdrTE =Bool
TrueHeaderName
HdrTE ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrTE =Bool
FalseHeaderName
HdrTrailer ==HeaderName
HdrTrailer =Bool
TrueHeaderName
HdrTrailer ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrTrailer =Bool
FalseHeaderName
HdrVary ==HeaderName
HdrVary =Bool
TrueHeaderName
HdrVary ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrVary =Bool
FalseHeaderName
HdrWarning ==HeaderName
HdrWarning =Bool
TrueHeaderName
HdrWarning ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrWarning =Bool
FalseHeaderName
HdrWWWAuthenticate ==HeaderName
HdrWWWAuthenticate =Bool
TrueHeaderName
HdrWWWAuthenticate ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrWWWAuthenticate =Bool
FalseHeaderName
HdrAllow ==HeaderName
HdrAllow =Bool
TrueHeaderName
HdrAllow ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrAllow =Bool
FalseHeaderName
HdrContentBase ==HeaderName
HdrContentBase =Bool
TrueHeaderName
HdrContentBase ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentBase =Bool
FalseHeaderName
HdrContentEncoding ==HeaderName
HdrContentEncoding =Bool
TrueHeaderName
HdrContentEncoding ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentEncoding =Bool
FalseHeaderName
HdrContentLanguage ==HeaderName
HdrContentLanguage =Bool
TrueHeaderName
HdrContentLanguage ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentLanguage =Bool
FalseHeaderName
HdrContentLength ==HeaderName
HdrContentLength =Bool
TrueHeaderName
HdrContentLength ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentLength =Bool
FalseHeaderName
HdrContentLocation ==HeaderName
HdrContentLocation =Bool
TrueHeaderName
HdrContentLocation ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentLocation =Bool
FalseHeaderName
HdrContentMD5 ==HeaderName
HdrContentMD5 =Bool
TrueHeaderName
HdrContentMD5 ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentMD5 =Bool
FalseHeaderName
HdrContentRange ==HeaderName
HdrContentRange =Bool
TrueHeaderName
HdrContentRange ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentRange =Bool
FalseHeaderName
HdrContentType ==HeaderName
HdrContentType =Bool
TrueHeaderName
HdrContentType ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentType =Bool
FalseHeaderName
HdrETag ==HeaderName
HdrETag =Bool
TrueHeaderName
HdrETag ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrETag =Bool
FalseHeaderName
HdrExpires ==HeaderName
HdrExpires =Bool
TrueHeaderName
HdrExpires ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrExpires =Bool
FalseHeaderName
HdrLastModified ==HeaderName
HdrLastModified =Bool
TrueHeaderName
HdrLastModified ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrLastModified =Bool
FalseHeaderName
HdrContentTransferEncoding ==HeaderName
HdrContentTransferEncoding =Bool
TrueHeaderName
HdrContentTransferEncoding ==HeaderName
_=Bool
FalseHeaderName
_==HeaderName
HdrContentTransferEncoding =Bool
False-- | @headerMap@ is a straight assoc list for translating between header names-- and values.headerMap ::[(String,HeaderName )]headerMap :: [(String, HeaderName)]
headerMap =[String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Cache-Control"HeaderName
HdrCacheControl ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Connection"HeaderName
HdrConnection ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Date"HeaderName
HdrDate ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Pragma"HeaderName
HdrPragma ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Transfer-Encoding"HeaderName
HdrTransferEncoding ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Upgrade"HeaderName
HdrUpgrade ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Via"HeaderName
HdrVia ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Accept"HeaderName
HdrAccept ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Accept-Charset"HeaderName
HdrAcceptCharset ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Accept-Encoding"HeaderName
HdrAcceptEncoding ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Accept-Language"HeaderName
HdrAcceptLanguage ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Authorization"HeaderName
HdrAuthorization ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Cookie"HeaderName
HdrCookie ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Expect"HeaderName
HdrExpect ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"From"HeaderName
HdrFrom ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Host"HeaderName
HdrHost ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"If-Modified-Since"HeaderName
HdrIfModifiedSince ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"If-Match"HeaderName
HdrIfMatch ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"If-None-Match"HeaderName
HdrIfNoneMatch ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"If-Range"HeaderName
HdrIfRange ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"If-Unmodified-Since"HeaderName
HdrIfUnmodifiedSince ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Max-Forwards"HeaderName
HdrMaxForwards ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Proxy-Authorization"HeaderName
HdrProxyAuthorization ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Range"HeaderName
HdrRange ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Referer"HeaderName
HdrReferer ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"User-Agent"HeaderName
HdrUserAgent ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Age"HeaderName
HdrAge ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Location"HeaderName
HdrLocation ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Proxy-Authenticate"HeaderName
HdrProxyAuthenticate ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Public"HeaderName
HdrPublic ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Retry-After"HeaderName
HdrRetryAfter ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Server"HeaderName
HdrServer ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Set-Cookie"HeaderName
HdrSetCookie ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"TE"HeaderName
HdrTE ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Trailer"HeaderName
HdrTrailer ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Vary"HeaderName
HdrVary ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Warning"HeaderName
HdrWarning ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"WWW-Authenticate"HeaderName
HdrWWWAuthenticate ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Allow"HeaderName
HdrAllow ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Base"HeaderName
HdrContentBase ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Encoding"HeaderName
HdrContentEncoding ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Language"HeaderName
HdrContentLanguage ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Length"HeaderName
HdrContentLength ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Location"HeaderName
HdrContentLocation ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-MD5"HeaderName
HdrContentMD5 ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Range"HeaderName
HdrContentRange ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Type"HeaderName
HdrContentType ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"ETag"HeaderName
HdrETag ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Expires"HeaderName
HdrExpires ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Last-Modified"HeaderName
HdrLastModified ,String -> HeaderName -> (String, HeaderName)
forall a b. a -> b -> (a, b)
p String
"Content-Transfer-Encoding"HeaderName
HdrContentTransferEncoding ]wherep :: a -> b -> (a, b)
p a
a b
b =(a
a ,b
b )instanceShowHeaderName whereshow :: HeaderName -> String
show (HdrCustom String
s )=String
s showHeaderName
x =case((String, HeaderName) -> Bool)
-> [(String, HeaderName)] -> [(String, HeaderName)]
forall a. (a -> Bool) -> [a] -> [a]
filter((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==HeaderName
x )(HeaderName -> Bool)
-> ((String, HeaderName) -> HeaderName)
-> (String, HeaderName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, HeaderName) -> HeaderName
forall a b. (a, b) -> b
snd)[(String, HeaderName)]
headerMap of[]->ShowS
forall a. HasCallStack => String -> a
errorString
"headerMap incomplete"((String, HeaderName)
h :[(String, HeaderName)]
_)->(String, HeaderName) -> String
forall a b. (a, b) -> a
fst(String, HeaderName)
h -- | @HasHeaders@ is a type class for types containing HTTP headers, allowing-- you to write overloaded header manipulation functions-- for both 'Request' and 'Response' data types, for instance.classHasHeaders x wheregetHeaders ::x ->[Header ]setHeaders ::x ->[Header ]->x -- Header manipulation functionstypeHeaderSetter a =HeaderName ->String->a ->a -- | @insertHeader hdr val x@ inserts a header with the given header name-- and value. Does not check for existing headers with same name, allowing-- duplicates to be introduce (use 'replaceHeader' if you want to avoid this.)insertHeader ::HasHeaders a =>HeaderSetter a insertHeader :: HeaderSetter a
insertHeader HeaderName
name String
value a
x =a -> [Header] -> a
forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x [Header]
newHeaders wherenewHeaders :: [Header]
newHeaders =(HeaderName -> String -> Header
Header HeaderName
name String
value )Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
:a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
x -- | @insertHeaderIfMissing hdr val x@ adds the new header only if no previous-- header with name @hdr@ exists in @x@.insertHeaderIfMissing ::HasHeaders a =>HeaderSetter a insertHeaderIfMissing :: HeaderSetter a
insertHeaderIfMissing HeaderName
name String
value a
x =a -> [Header] -> a
forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x ([Header] -> [Header]
newHeaders ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
x )wherenewHeaders :: [Header] -> [Header]
newHeaders list :: [Header]
list @(h :: Header
h @(Header HeaderName
n String
_):[Header]
rest )|HeaderName
n HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==HeaderName
name =[Header]
list |Bool
otherwise=Header
h Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
:[Header] -> [Header]
newHeaders [Header]
rest newHeaders []=[HeaderName -> String -> Header
Header HeaderName
name String
value ]-- | @replaceHeader hdr val o@ replaces the header @hdr@ with the-- value @val@, dropping any existingreplaceHeader ::HasHeaders a =>HeaderSetter a replaceHeader :: HeaderSetter a
replaceHeader HeaderName
name String
value a
h =a -> [Header] -> a
forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
h [Header]
newHeaders wherenewHeaders :: [Header]
newHeaders =HeaderName -> String -> Header
Header HeaderName
name String
value Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
:[Header
x |x :: Header
x @(Header HeaderName
n String
_)<-a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
h ,HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/=HeaderName
n ]-- | @insertHeaders hdrs x@ appends multiple headers to @x@'s existing-- set.insertHeaders ::HasHeaders a =>[Header ]->a ->a insertHeaders :: [Header] -> a -> a
insertHeaders [Header]
hdrs a
x =a -> [Header] -> a
forall x. HasHeaders x => x -> [Header] -> x
setHeaders a
x (a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
x [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++[Header]
hdrs )-- | @retrieveHeaders hdrNm x@ gets a list of headers with 'HeaderName' @hdrNm@.retrieveHeaders ::HasHeaders a =>HeaderName ->a ->[Header ]retrieveHeaders :: HeaderName -> a -> [Header]
retrieveHeaders HeaderName
name a
x =(Header -> Bool) -> [Header] -> [Header]
forall a. (a -> Bool) -> [a] -> [a]
filterHeader -> Bool
matchname (a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
x )wherematchname :: Header -> Bool
matchname (Header HeaderName
n String
_)=HeaderName
n HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==HeaderName
name -- | @findHeader hdrNm x@ looks up @hdrNm@ in @x@, returning the first-- header that matches, if any.findHeader ::HasHeaders a =>HeaderName ->a ->MaybeStringfindHeader :: HeaderName -> a -> Maybe String
findHeader HeaderName
n a
x =HeaderName -> [Header] -> Maybe String
lookupHeader HeaderName
n (a -> [Header]
forall x. HasHeaders x => x -> [Header]
getHeaders a
x )-- | @lookupHeader hdr hdrs@ locates the first header matching @hdr@ in the-- list @hdrs@.lookupHeader ::HeaderName ->[Header ]->MaybeStringlookupHeader :: HeaderName -> [Header] -> Maybe String
lookupHeader HeaderName
_[]=Maybe String
forall a. Maybe a
NothinglookupHeader HeaderName
v (Header HeaderName
n String
s :[Header]
t )|HeaderName
v HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==HeaderName
n =String -> Maybe String
forall a. a -> Maybe a
JustString
s |Bool
otherwise=HeaderName -> [Header] -> Maybe String
lookupHeader HeaderName
v [Header]
t -- | @parseHeader headerNameAndValueString@ tries to unscramble a-- @header: value@ pairing and returning it as a 'Header'.parseHeader ::String->Result Header parseHeader :: String -> Result Header
parseHeader String
str =caseChar -> String -> Maybe (String, String)
forall a. Eq a => a -> [a] -> Maybe ([a], [a])
split Char
':'String
str ofMaybe (String, String)
Nothing->String -> Result Header
forall a. String -> Result a
failParse (String
"Unable to parse header: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
str )Just(String
k ,String
v )->Header -> Result Header
forall (m :: * -> *) a. Monad m => a -> m a
return(Header -> Result Header) -> Header -> Result Header
forall a b. (a -> b) -> a -> b
$HeaderName -> String -> Header
Header (String -> HeaderName
fn String
k )(ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$Int -> ShowS
forall a. Int -> [a] -> [a]
dropInt
1String
v )wherefn :: String -> HeaderName
fn String
k =case((String, HeaderName) -> HeaderName)
-> [(String, HeaderName)] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map(String, HeaderName) -> HeaderName
forall a b. (a, b) -> b
snd([(String, HeaderName)] -> [HeaderName])
-> [(String, HeaderName)] -> [HeaderName]
forall a b. (a -> b) -> a -> b
$((String, HeaderName) -> Bool)
-> [(String, HeaderName)] -> [(String, HeaderName)]
forall a. (a -> Bool) -> [a] -> [a]
filter(String -> String -> Bool
match String
k (String -> Bool)
-> ((String, HeaderName) -> String) -> (String, HeaderName) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, HeaderName) -> String
forall a b. (a, b) -> a
fst)[(String, HeaderName)]
headerMap of[]->(String -> HeaderName
HdrCustom String
k )(HeaderName
h :[HeaderName]
_)->HeaderName
h match ::String->String->Boolmatch :: String -> String -> Bool
match String
s1 String
s2 =(Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
mapChar -> Char
toLowerString
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==(Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
mapChar -> Char
toLowerString
s2 -- | @parseHeaders hdrs@ takes a sequence of strings holding header-- information and parses them into a set of headers (preserving their-- order in the input argument.) Handles header values split up over-- multiple lines.parseHeaders ::[String]->Result [Header ]parseHeaders :: [String] -> Result [Header]
parseHeaders =[Header] -> [Result Header] -> Result [Header]
forall a. [a] -> [Result a] -> Result [a]
catRslts []([Result Header] -> Result [Header])
-> ([String] -> [Result Header]) -> [String] -> Result [Header]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> Result Header) -> [String] -> [Result Header]
forall a b. (a -> b) -> [a] -> [b]
map(String -> Result Header
parseHeader (String -> Result Header) -> ShowS -> String -> Result Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
clean )([String] -> [Result Header])
-> ([String] -> [String]) -> [String] -> [Result Header]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String] -> [String]
joinExtended String
""where-- Joins consecutive lines where the second line-- begins with ' ' or '\t'.joinExtended :: String -> [String] -> [String]
joinExtended String
old []=[String
old ]joinExtended String
old (String
h :[String]
t )|String -> Bool
isLineExtension String
h =String -> [String] -> [String]
joinExtended (String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
forall a. [a] -> [a]
tailString
h )[String]
t |Bool
otherwise=String
old String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String] -> [String]
joinExtended String
h [String]
t isLineExtension :: String -> Bool
isLineExtension (Char
x :String
_)=Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' 'Bool -> Bool -> Bool
||Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\t'isLineExtension String
_=Bool
Falseclean :: ShowS
clean []=[]clean (Char
h :String
t )|Char
h Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
"\t\r\n"=Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
clean String
t |Bool
otherwise=Char
h Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
clean String
t -- tolerant of errors? should parse-- errors here be reported or ignored?-- currently ignored.catRslts ::[a ]->[Result a ]->Result [a ]catRslts :: [a] -> [Result a] -> Result [a]
catRslts [a]
list (Result a
h :[Result a]
t )=caseResult a
h ofLeftConnError
_->[a] -> [Result a] -> Result [a]
forall a. [a] -> [Result a] -> Result [a]
catRslts [a]
list [Result a]
t Righta
v ->[a] -> [Result a] -> Result [a]
forall a. [a] -> [Result a] -> Result [a]
catRslts (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
list )[Result a]
t catRslts [a]
list []=[a] -> Result [a]
forall a b. b -> Either a b
Right([a] -> Result [a]) -> [a] -> Result [a]
forall a b. (a -> b) -> a -> b
$[a] -> [a]
forall a. [a] -> [a]
reverse[a]
list