{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}

module Http.Request
  ( Request(..)
  , RequestLine(..)
    -- * Encode Request
  , builder
  , toChunks
  , toChunksOnto
    -- * Encode Request with Body
  , 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

-- | The request line and the request headers.
data Request = Request
  { Request -> RequestLine
requestLine :: !RequestLine
  , Request -> Headers
headers :: !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)

-- | An HTTP request line
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

-- | This adds the Content-Length header. It must not already
-- be present.
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