{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide, prune #-}
module Network.Http.Internal (
Hostname,
Port,
ContentType,
FieldName,
Request (..),
EntityBody (..),
ExpectMode (..),
Boundary,
unBoundary,
emptyBoundary,
randomBoundary,
packBoundary,
Response (..),
StatusCode,
TransferEncoding (..),
ContentEncoding (..),
getStatusCode,
getStatusMessage,
getHeader,
Method (..),
Headers,
emptyHeaders,
updateHeader,
removeHeader,
buildHeaders,
lookupHeader,
retrieveHeaders,
HttpType (getHeaders),
HttpParseException (..),
composeMultipartBytes,
composeMultipartEnding,
composeRequestBytes,
composeResponseBytes,
) where
import Prelude hiding (lookup)
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as Builder (
copyByteString,
fromByteString,
toByteString,
)
import qualified Blaze.ByteString.Builder.Char8 as Builder (
fromChar,
fromShow,
fromString,
)
import Control.Exception (Exception)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import Data.CaseInsensitive (CI, mk, original)
import Data.Char (chr)
import Data.HashMap.Strict (
HashMap,
delete,
empty,
foldrWithKey,
insert,
insertWith,
lookup,
toList,
)
import Data.Int (Int64)
import Data.List (foldl')
import Data.Typeable (Typeable)
import Data.Word (Word16)
import System.Random (newStdGen, randomRs)
type Hostname = ByteString
type Port = Word16
type ContentType = ByteString
type FieldName = ByteString
data Method
= GET
| HEAD
| POST
| PUT
| DELETE
| TRACE
| OPTIONS
| CONNECT
| PATCH
| Method ByteString
deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, ReadPrec [Method]
ReadPrec Method
Int -> ReadS Method
ReadS [Method]
(Int -> ReadS Method)
-> ReadS [Method]
-> ReadPrec Method
-> ReadPrec [Method]
-> Read Method
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Method]
$creadListPrec :: ReadPrec [Method]
readPrec :: ReadPrec Method
$creadPrec :: ReadPrec Method
readList :: ReadS [Method]
$creadList :: ReadS [Method]
readsPrec :: Int -> ReadS Method
$creadsPrec :: Int -> ReadS Method
Read, Eq Method
Eq Method
-> (Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
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 :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
$cp1Ord :: Eq Method
Ord)
instance Eq Method where
Method
GET == :: Method -> Method -> Bool
== Method
GET = Bool
True
Method
HEAD == Method
HEAD = Bool
True
Method
POST == Method
POST = Bool
True
Method
PUT == Method
PUT = Bool
True
Method
DELETE == Method
DELETE = Bool
True
Method
TRACE == Method
TRACE = Bool
True
Method
OPTIONS == Method
OPTIONS = Bool
True
Method
CONNECT == Method
CONNECT = Bool
True
Method
PATCH == Method
PATCH = Bool
True
Method
GET == Method ByteString
"GET" = Bool
True
Method
HEAD == Method ByteString
"HEAD" = Bool
True
Method
POST == Method ByteString
"POST" = Bool
True
Method
PUT == Method ByteString
"PUT" = Bool
True
Method
DELETE == Method ByteString
"DELETE" = Bool
True
Method
TRACE == Method ByteString
"TRACE" = Bool
True
Method
OPTIONS == Method ByteString
"OPTIONS" = Bool
True
Method
CONNECT == Method ByteString
"CONNECT" = Bool
True
Method
PATCH == Method ByteString
"PATCH" = Bool
True
Method ByteString
a == Method ByteString
b = ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b
m :: Method
m@(Method ByteString
_) == Method
other = Method
other Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
m
Method
_ == Method
_ = Bool
False
data Request = Request
{ Request -> Method
qMethod :: !Method
, Request -> Maybe ByteString
qHost :: !(Maybe ByteString)
, Request -> ByteString
qPath :: !ByteString
, Request -> EntityBody
qBody :: !EntityBody
, Request -> ExpectMode
qExpect :: !ExpectMode
, :: !Headers
, Request -> Boundary
qBoundary :: !Boundary
}
deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq)
instance Show Request where
show :: Request -> String
show Request
q =
{-# SCC "Request.show" #-}
ByteString -> String
S.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
S.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ByteString -> Builder
composeRequestBytes Request
q ByteString
"<to be determined>"
data EntityBody = Empty | Chunking | Static Int64 deriving (Int -> EntityBody -> ShowS
[EntityBody] -> ShowS
EntityBody -> String
(Int -> EntityBody -> ShowS)
-> (EntityBody -> String)
-> ([EntityBody] -> ShowS)
-> Show EntityBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityBody] -> ShowS
$cshowList :: [EntityBody] -> ShowS
show :: EntityBody -> String
$cshow :: EntityBody -> String
showsPrec :: Int -> EntityBody -> ShowS
$cshowsPrec :: Int -> EntityBody -> ShowS
Show, EntityBody -> EntityBody -> Bool
(EntityBody -> EntityBody -> Bool)
-> (EntityBody -> EntityBody -> Bool) -> Eq EntityBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityBody -> EntityBody -> Bool
$c/= :: EntityBody -> EntityBody -> Bool
== :: EntityBody -> EntityBody -> Bool
$c== :: EntityBody -> EntityBody -> Bool
Eq, Eq EntityBody
Eq EntityBody
-> (EntityBody -> EntityBody -> Ordering)
-> (EntityBody -> EntityBody -> Bool)
-> (EntityBody -> EntityBody -> Bool)
-> (EntityBody -> EntityBody -> Bool)
-> (EntityBody -> EntityBody -> Bool)
-> (EntityBody -> EntityBody -> EntityBody)
-> (EntityBody -> EntityBody -> EntityBody)
-> Ord EntityBody
EntityBody -> EntityBody -> Bool
EntityBody -> EntityBody -> Ordering
EntityBody -> EntityBody -> EntityBody
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 :: EntityBody -> EntityBody -> EntityBody
$cmin :: EntityBody -> EntityBody -> EntityBody
max :: EntityBody -> EntityBody -> EntityBody
$cmax :: EntityBody -> EntityBody -> EntityBody
>= :: EntityBody -> EntityBody -> Bool
$c>= :: EntityBody -> EntityBody -> Bool
> :: EntityBody -> EntityBody -> Bool
$c> :: EntityBody -> EntityBody -> Bool
<= :: EntityBody -> EntityBody -> Bool
$c<= :: EntityBody -> EntityBody -> Bool
< :: EntityBody -> EntityBody -> Bool
$c< :: EntityBody -> EntityBody -> Bool
compare :: EntityBody -> EntityBody -> Ordering
$ccompare :: EntityBody -> EntityBody -> Ordering
$cp1Ord :: Eq EntityBody
Ord)
data ExpectMode = Normal | Continue deriving (Int -> ExpectMode -> ShowS
[ExpectMode] -> ShowS
ExpectMode -> String
(Int -> ExpectMode -> ShowS)
-> (ExpectMode -> String)
-> ([ExpectMode] -> ShowS)
-> Show ExpectMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectMode] -> ShowS
$cshowList :: [ExpectMode] -> ShowS
show :: ExpectMode -> String
$cshow :: ExpectMode -> String
showsPrec :: Int -> ExpectMode -> ShowS
$cshowsPrec :: Int -> ExpectMode -> ShowS
Show, ExpectMode -> ExpectMode -> Bool
(ExpectMode -> ExpectMode -> Bool)
-> (ExpectMode -> ExpectMode -> Bool) -> Eq ExpectMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectMode -> ExpectMode -> Bool
$c/= :: ExpectMode -> ExpectMode -> Bool
== :: ExpectMode -> ExpectMode -> Bool
$c== :: ExpectMode -> ExpectMode -> Bool
Eq, Eq ExpectMode
Eq ExpectMode
-> (ExpectMode -> ExpectMode -> Ordering)
-> (ExpectMode -> ExpectMode -> Bool)
-> (ExpectMode -> ExpectMode -> Bool)
-> (ExpectMode -> ExpectMode -> Bool)
-> (ExpectMode -> ExpectMode -> Bool)
-> (ExpectMode -> ExpectMode -> ExpectMode)
-> (ExpectMode -> ExpectMode -> ExpectMode)
-> Ord ExpectMode
ExpectMode -> ExpectMode -> Bool
ExpectMode -> ExpectMode -> Ordering
ExpectMode -> ExpectMode -> ExpectMode
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 :: ExpectMode -> ExpectMode -> ExpectMode
$cmin :: ExpectMode -> ExpectMode -> ExpectMode
max :: ExpectMode -> ExpectMode -> ExpectMode
$cmax :: ExpectMode -> ExpectMode -> ExpectMode
>= :: ExpectMode -> ExpectMode -> Bool
$c>= :: ExpectMode -> ExpectMode -> Bool
> :: ExpectMode -> ExpectMode -> Bool
$c> :: ExpectMode -> ExpectMode -> Bool
<= :: ExpectMode -> ExpectMode -> Bool
$c<= :: ExpectMode -> ExpectMode -> Bool
< :: ExpectMode -> ExpectMode -> Bool
$c< :: ExpectMode -> ExpectMode -> Bool
compare :: ExpectMode -> ExpectMode -> Ordering
$ccompare :: ExpectMode -> ExpectMode -> Ordering
$cp1Ord :: Eq ExpectMode
Ord)
newtype Boundary = Boundary ByteString deriving (Int -> Boundary -> ShowS
[Boundary] -> ShowS
Boundary -> String
(Int -> Boundary -> ShowS)
-> (Boundary -> String) -> ([Boundary] -> ShowS) -> Show Boundary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Boundary] -> ShowS
$cshowList :: [Boundary] -> ShowS
show :: Boundary -> String
$cshow :: Boundary -> String
showsPrec :: Int -> Boundary -> ShowS
$cshowsPrec :: Int -> Boundary -> ShowS
Show, Boundary -> Boundary -> Bool
(Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool) -> Eq Boundary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Boundary -> Boundary -> Bool
$c/= :: Boundary -> Boundary -> Bool
== :: Boundary -> Boundary -> Bool
$c== :: Boundary -> Boundary -> Bool
Eq)
unBoundary :: Boundary -> ByteString
unBoundary :: Boundary -> ByteString
unBoundary (Boundary ByteString
b') = ByteString
b'
emptyBoundary :: Boundary
emptyBoundary :: Boundary
emptyBoundary = ByteString -> Boundary
Boundary ByteString
S.empty
represent :: Int -> Char
represent :: Int -> Char
represent Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
62 = Int -> Char
chr (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
36)
| Bool
otherwise = Char
'@'
randomBoundary :: IO Boundary
randomBoundary :: IO Boundary
randomBoundary = do
StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
let result :: ByteString
result = String -> ByteString
S.pack (String -> ByteString)
-> (StdGen -> String) -> StdGen -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
represent ([Int] -> String) -> (StdGen -> [Int]) -> StdGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
20 ([Int] -> [Int]) -> (StdGen -> [Int]) -> StdGen -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0, Int
61) (StdGen -> ByteString) -> StdGen -> ByteString
forall a b. (a -> b) -> a -> b
$ StdGen
gen
Boundary -> IO Boundary
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Boundary
Boundary ByteString
result)
packBoundary :: String -> Boundary
packBoundary :: String -> Boundary
packBoundary = ByteString -> Boundary
Boundary (ByteString -> Boundary)
-> (String -> ByteString) -> String -> Boundary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
S.pack
composeRequestBytes :: Request -> ByteString -> Builder
composeRequestBytes :: Request -> ByteString -> Builder
composeRequestBytes Request
q ByteString
h' =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
requestline
, Builder
hostLine
, Builder
headerFields
, Builder
crlf
]
where
requestline :: Builder
requestline =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
method
, Builder
sp
, Builder
uri
, Builder
sp
, Builder
version
, Builder
crlf
]
method :: Builder
method = case Request -> Method
qMethod Request
q of
Method
GET -> String -> Builder
Builder.fromString String
"GET"
Method
HEAD -> String -> Builder
Builder.fromString String
"HEAD"
Method
POST -> String -> Builder
Builder.fromString String
"POST"
Method
PUT -> String -> Builder
Builder.fromString String
"PUT"
Method
DELETE -> String -> Builder
Builder.fromString String
"DELETE"
Method
TRACE -> String -> Builder
Builder.fromString String
"TRACE"
Method
OPTIONS -> String -> Builder
Builder.fromString String
"OPTIONS"
Method
CONNECT -> String -> Builder
Builder.fromString String
"CONNECT"
Method
PATCH -> String -> Builder
Builder.fromString String
"PATCH"
(Method ByteString
x) -> ByteString -> Builder
Builder.fromByteString ByteString
x
uri :: Builder
uri = case Request -> ByteString
qPath Request
q of
ByteString
"" -> Char -> Builder
Builder.fromChar Char
'/'
ByteString
path -> ByteString -> Builder
Builder.copyByteString ByteString
path
version :: Builder
version = String -> Builder
Builder.fromString String
"HTTP/1.1"
hostLine :: Builder
hostLine =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ String -> Builder
Builder.fromString String
"Host: "
, Builder
hostname
, Builder
crlf
]
hostname :: Builder
hostname = case Request -> Maybe ByteString
qHost Request
q of
Just ByteString
x' -> ByteString -> Builder
Builder.copyByteString ByteString
x'
Maybe ByteString
Nothing -> ByteString -> Builder
Builder.copyByteString ByteString
h'
headerFields :: Builder
headerFields = HashMap (CI ByteString) ByteString -> Builder
joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
-> HashMap (CI ByteString) ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Headers -> HashMap (CI ByteString) ByteString
unWrap (Headers -> HashMap (CI ByteString) ByteString)
-> Headers -> HashMap (CI ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Request -> Headers
qHeaders Request
q
crlf :: Builder
crlf = String -> Builder
Builder.fromString String
"\r\n"
sp :: Builder
sp = Char -> Builder
Builder.fromChar Char
' '
dashdash :: Builder
dashdash = String -> Builder
Builder.fromString String
"--"
composeMultipartBytes :: Boundary -> FieldName -> Maybe FilePath -> Maybe ContentType -> Builder
composeMultipartBytes :: Boundary
-> ByteString -> Maybe String -> Maybe ByteString -> Builder
composeMultipartBytes Boundary
boundary ByteString
name Maybe String
possibleFilename Maybe ByteString
possibleContentType =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
boundaryLine
, Builder
dispositionLine
, Builder
mimetypeLine
, Builder
crlf
]
where
boundaryLine :: Builder
boundaryLine =
Builder
crlf
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
dashdash
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.copyByteString (Boundary -> ByteString
unBoundary Boundary
boundary)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
crlf
dispositionLine :: Builder
dispositionLine =
Builder
"Content-Disposition: form-data; name=\""
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.copyByteString ByteString
name
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Maybe String
possibleFilename of
Just String
filename ->
Builder
"; filename=\""
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Builder.fromString String
filename
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
Maybe String
Nothing -> Builder
forall a. Monoid a => a
mempty
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
crlf
mimetypeLine :: Builder
mimetypeLine =
case Maybe ByteString
possibleContentType of
Just ByteString
mimetype ->
Builder
"Content-Type: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.copyByteString ByteString
mimetype
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
crlf
Maybe ByteString
Nothing -> Builder
forall a. Monoid a => a
mempty
composeMultipartEnding :: Boundary -> Builder
composeMultipartEnding :: Boundary -> Builder
composeMultipartEnding Boundary
boundary =
Builder
crlf
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
dashdash
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.copyByteString (Boundary -> ByteString
unBoundary Boundary
boundary)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
dashdash
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
crlf
type StatusCode = Int
data Response = Response
{ Response -> Int
pStatusCode :: !StatusCode
, Response -> ByteString
pStatusMsg :: !ByteString
, Response -> TransferEncoding
pTransferEncoding :: !TransferEncoding
, Response -> ContentEncoding
pContentEncoding :: !ContentEncoding
, Response -> Maybe Int64
pContentLength :: !(Maybe Int64)
, :: !Headers
}
instance Show Response where
show :: Response -> String
show Response
p =
{-# SCC "Response.show" #-}
ByteString -> String
S.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
S.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Builder
composeResponseBytes Response
p
data TransferEncoding = None | Chunked
data ContentEncoding = Identity | Gzip | Deflate
deriving (Int -> ContentEncoding -> ShowS
[ContentEncoding] -> ShowS
ContentEncoding -> String
(Int -> ContentEncoding -> ShowS)
-> (ContentEncoding -> String)
-> ([ContentEncoding] -> ShowS)
-> Show ContentEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentEncoding] -> ShowS
$cshowList :: [ContentEncoding] -> ShowS
show :: ContentEncoding -> String
$cshow :: ContentEncoding -> String
showsPrec :: Int -> ContentEncoding -> ShowS
$cshowsPrec :: Int -> ContentEncoding -> ShowS
Show)
getStatusCode :: Response -> StatusCode
getStatusCode :: Response -> Int
getStatusCode = Response -> Int
pStatusCode
{-# INLINE getStatusCode #-}
getStatusMessage :: Response -> ByteString
getStatusMessage :: Response -> ByteString
getStatusMessage = Response -> ByteString
pStatusMsg
{-# INLINE getStatusMessage #-}
getHeader :: Response -> ByteString -> Maybe ByteString
Response
p ByteString
k =
Headers -> ByteString -> Maybe ByteString
lookupHeader Headers
h ByteString
k
where
h :: Headers
h = Response -> Headers
pHeaders Response
p
class HttpType τ where
:: τ -> Headers
instance HttpType Request where
getHeaders :: Request -> Headers
getHeaders Request
q = Request -> Headers
qHeaders Request
q
instance HttpType Response where
getHeaders :: Response -> Headers
getHeaders Response
p = Response -> Headers
pHeaders Response
p
composeResponseBytes :: Response -> Builder
composeResponseBytes :: Response -> Builder
composeResponseBytes Response
p =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
statusline
, Builder
headerFields
, Builder
crlf
]
where
statusline :: Builder
statusline =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
version
, Builder
sp
, Builder
code
, Builder
sp
, Builder
message
, Builder
crlf
]
code :: Builder
code = Int -> Builder
forall a. Show a => a -> Builder
Builder.fromShow (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Response -> Int
pStatusCode Response
p
message :: Builder
message = ByteString -> Builder
Builder.copyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Response -> ByteString
pStatusMsg Response
p
version :: Builder
version = String -> Builder
Builder.fromString String
"HTTP/1.1"
headerFields :: Builder
headerFields = HashMap (CI ByteString) ByteString -> Builder
joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
-> HashMap (CI ByteString) ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Headers -> HashMap (CI ByteString) ByteString
unWrap (Headers -> HashMap (CI ByteString) ByteString)
-> Headers -> HashMap (CI ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Headers
pHeaders Response
p
newtype = Wrap
{ Headers -> HashMap (CI ByteString) ByteString
unWrap :: HashMap (CI ByteString) ByteString
}
deriving (Headers -> Headers -> Bool
(Headers -> Headers -> Bool)
-> (Headers -> Headers -> Bool) -> Eq Headers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c== :: Headers -> Headers -> Bool
Eq)
instance Show Headers where
show :: Headers -> String
show Headers
x = ByteString -> String
S.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
S.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ HashMap (CI ByteString) ByteString -> Builder
joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
-> HashMap (CI ByteString) ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Headers -> HashMap (CI ByteString) ByteString
unWrap Headers
x
joinHeaders :: HashMap (CI ByteString) ByteString -> Builder
HashMap (CI ByteString) ByteString
m = (CI ByteString -> ByteString -> Builder -> Builder)
-> Builder -> HashMap (CI ByteString) ByteString -> Builder
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey CI ByteString -> ByteString -> Builder -> Builder
combine Builder
forall a. Monoid a => a
mempty HashMap (CI ByteString) ByteString
m
combine :: CI ByteString -> ByteString -> Builder -> Builder
combine :: CI ByteString -> ByteString -> Builder -> Builder
combine CI ByteString
k ByteString
v Builder
acc =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
acc, Builder
key, String -> Builder
Builder.fromString String
": ", Builder
value, Builder
crlf]
where
key :: Builder
key = ByteString -> Builder
Builder.copyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
k
value :: Builder
value = ByteString -> Builder
Builder.fromByteString ByteString
v
{-# INLINE combine #-}
emptyHeaders :: Headers
=
HashMap (CI ByteString) ByteString -> Headers
Wrap HashMap (CI ByteString) ByteString
forall k v. HashMap k v
empty
updateHeader :: Headers -> ByteString -> ByteString -> Headers
Headers
x ByteString
k ByteString
v =
HashMap (CI ByteString) ByteString -> Headers
Wrap HashMap (CI ByteString) ByteString
result
where
!result :: HashMap (CI ByteString) ByteString
result = CI ByteString
-> ByteString
-> HashMap (CI ByteString) ByteString
-> HashMap (CI ByteString) ByteString
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ByteString
k) ByteString
v HashMap (CI ByteString) ByteString
m
!m :: HashMap (CI ByteString) ByteString
m = Headers -> HashMap (CI ByteString) ByteString
unWrap Headers
x
removeHeader :: Headers -> ByteString -> Headers
Headers
x ByteString
k =
HashMap (CI ByteString) ByteString -> Headers
Wrap HashMap (CI ByteString) ByteString
result
where
!result :: HashMap (CI ByteString) ByteString
result = CI ByteString
-> HashMap (CI ByteString) ByteString
-> HashMap (CI ByteString) ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ByteString
k) HashMap (CI ByteString) ByteString
m
!m :: HashMap (CI ByteString) ByteString
m = Headers -> HashMap (CI ByteString) ByteString
unWrap Headers
x
buildHeaders :: [(ByteString, ByteString)] -> Headers
[(ByteString, ByteString)]
hs =
HashMap (CI ByteString) ByteString -> Headers
Wrap HashMap (CI ByteString) ByteString
result
where
result :: HashMap (CI ByteString) ByteString
result = (HashMap (CI ByteString) ByteString
-> (ByteString, ByteString) -> HashMap (CI ByteString) ByteString)
-> HashMap (CI ByteString) ByteString
-> [(ByteString, ByteString)]
-> HashMap (CI ByteString) ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashMap (CI ByteString) ByteString
-> (ByteString, ByteString) -> HashMap (CI ByteString) ByteString
addHeader HashMap (CI ByteString) ByteString
forall k v. HashMap k v
empty [(ByteString, ByteString)]
hs
addHeader ::
HashMap (CI ByteString) ByteString ->
(ByteString, ByteString) ->
HashMap (CI ByteString) ByteString
HashMap (CI ByteString) ByteString
m (ByteString
k, ByteString
v) =
(ByteString -> ByteString -> ByteString)
-> CI ByteString
-> ByteString
-> HashMap (CI ByteString) ByteString
-> HashMap (CI ByteString) ByteString
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
insertWith ByteString -> ByteString -> ByteString
f (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ByteString
k) ByteString
v HashMap (CI ByteString) ByteString
m
where
f :: ByteString -> ByteString -> ByteString
f ByteString
new ByteString
old = [ByteString] -> ByteString
S.concat [ByteString
old, ByteString
",", ByteString
new]
lookupHeader :: Headers -> ByteString -> Maybe ByteString
Headers
x ByteString
k =
CI ByteString
-> HashMap (CI ByteString) ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ByteString
k) HashMap (CI ByteString) ByteString
m
where
!m :: HashMap (CI ByteString) ByteString
m = Headers -> HashMap (CI ByteString) ByteString
unWrap Headers
x
retrieveHeaders :: Headers -> [(ByteString, ByteString)]
Headers
x =
((CI ByteString, ByteString) -> (ByteString, ByteString))
-> [(CI ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> (ByteString, ByteString)
down ([(CI ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(CI ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ HashMap (CI ByteString) ByteString -> [(CI ByteString, ByteString)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap (CI ByteString) ByteString
m
where
!m :: HashMap (CI ByteString) ByteString
m = Headers -> HashMap (CI ByteString) ByteString
unWrap Headers
x
down :: (CI ByteString, ByteString) -> (ByteString, ByteString)
down :: (CI ByteString, ByteString) -> (ByteString, ByteString)
down (CI ByteString
k, ByteString
v) =
(CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
k, ByteString
v)
data HttpParseException = HttpParseException String
deriving (Typeable, Int -> HttpParseException -> ShowS
[HttpParseException] -> ShowS
HttpParseException -> String
(Int -> HttpParseException -> ShowS)
-> (HttpParseException -> String)
-> ([HttpParseException] -> ShowS)
-> Show HttpParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpParseException] -> ShowS
$cshowList :: [HttpParseException] -> ShowS
show :: HttpParseException -> String
$cshow :: HttpParseException -> String
showsPrec :: Int -> HttpParseException -> ShowS
$cshowsPrec :: Int -> HttpParseException -> ShowS
Show)
instance Exception HttpParseException