{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
module Http.Request
( Request(..)
, RequestLine(..)
, builder
, toChunks
, toChunksOnto
, bodiedToChunks
) where
import Data.Bytes.Builder (Builder)
import Data.Bytes.Chunks (Chunks)
import Data.Primitive (SmallArray)
import Data.Text (Text)
import Data.Word (Word8)
import GHC.Exts (Ptr(Ptr))
import Http.Bodied (Bodied(..))
import Http.Header (Header)
import Http.Headers (Headers)
import qualified Data.Bytes.Text.Utf8 as Utf8
import qualified Data.Bytes.Builder as Builder
import qualified Data.Bytes.Chunks as Chunks
import qualified Http.Header as Header
import qualified Http.Headers as Headers
data Request = Request
{ Request -> RequestLine
requestLine :: !RequestLine
, :: !Headers
} deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)
data RequestLine = RequestLine
{ RequestLine -> Text
method :: {-# UNPACK #-} !Text
, RequestLine -> Text
path :: {-# UNPACK #-} !Text
} deriving (Int -> RequestLine -> ShowS
[RequestLine] -> ShowS
RequestLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestLine] -> ShowS
$cshowList :: [RequestLine] -> ShowS
show :: RequestLine -> String
$cshow :: RequestLine -> String
showsPrec :: Int -> RequestLine -> ShowS
$cshowsPrec :: Int -> RequestLine -> ShowS
Show)
builderRequestLine :: RequestLine -> Builder
builderRequestLine :: RequestLine -> Builder
builderRequestLine RequestLine{Text
method :: Text
$sel:method:RequestLine :: RequestLine -> Text
method,Text
path :: Text
$sel:path:RequestLine :: RequestLine -> Text
path} =
Bytes -> Builder
Builder.copy (Text -> Bytes
Utf8.fromText Text
method)
forall a. Semigroup a => a -> a -> a
<>
Char -> Builder
Builder.ascii Char
' '
forall a. Semigroup a => a -> a -> a
<>
Bytes -> Builder
Builder.copy (Text -> Bytes
Utf8.fromText Text
path)
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Char -> Char -> Char -> Char -> Builder
Builder.ascii6 Char
' ' Char
'H' Char
'T' Char
'T' Char
'P' Char
'/'
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Char -> Char -> Char -> Builder
Builder.ascii5 Char
'1' Char
'.' Char
'1' Char
'\r' Char
'\n'
toChunks :: Request -> Chunks
toChunks :: Request -> Chunks
toChunks = Int -> Builder -> Chunks
Builder.run Int
256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Builder
builder
toChunksOnto :: Request -> Chunks -> Chunks
toChunksOnto :: Request -> Chunks -> Chunks
toChunksOnto Request
r Chunks
ch = Int -> Builder -> Chunks -> Chunks
Builder.runOnto Int
256 (Request -> Builder
builder Request
r) Chunks
ch
builder :: Request -> Builder
builder :: Request -> Builder
builder Request{RequestLine
requestLine :: RequestLine
$sel:requestLine:Request :: Request -> RequestLine
requestLine,Headers
headers :: Headers
$sel:headers:Request :: Request -> Headers
headers} =
RequestLine -> Builder
builderRequestLine RequestLine
requestLine
forall a. Semigroup a => a -> a -> a
<>
SmallArray Header -> Builder
Header.builderSmallArray SmallArray Header
headersArray
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Builder
Builder.ascii2 Char
'\r' Char
'\n'
where
headersArray :: SmallArray Header
headersArray = Headers -> SmallArray Header
Headers.toArray Headers
headers
bodiedToChunks :: Bodied Request -> Chunks
bodiedToChunks :: Bodied Request -> Chunks
bodiedToChunks Bodied{metadata :: forall a. Bodied a -> a
metadata=Request{RequestLine
requestLine :: RequestLine
$sel:requestLine:Request :: Request -> RequestLine
requestLine,Headers
headers :: Headers
$sel:headers:Request :: Request -> Headers
headers},Chunks
body :: forall a. Bodied a -> Chunks
body :: Chunks
body} =
Int -> Builder -> Chunks -> Chunks
Builder.runOnto Int
256
( RequestLine -> Builder
builderRequestLine RequestLine
requestLine
forall a. Semigroup a => a -> a -> a
<>
SmallArray Header -> Builder
Header.builderSmallArray SmallArray Header
headersArray
forall a. Semigroup a => a -> a -> a
<>
CString -> Builder
Builder.cstring (forall a. Addr# -> Ptr a
Ptr Addr#
"Content-Length: "#)
forall a. Semigroup a => a -> a -> a
<>
Word64 -> Builder
Builder.word64Dec (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Chunks -> Int
Chunks.length Chunks
body))
forall a. Semigroup a => a -> a -> a
<>
Char -> Char -> Char -> Char -> Builder
Builder.ascii4 Char
'\r' Char
'\n' Char
'\r' Char
'\n'
) Chunks
body
where
headersArray :: SmallArray Header
headersArray = Headers -> SmallArray Header
Headers.toArray Headers
headers