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

module Http.Response
  ( Response(..)
  , StatusLine(..)
  , decode
  ) where

import Control.Monad (when)
import Data.Bytes (Bytes)
import Data.Bytes.Parser (Parser)
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (SmallArray,ByteArray(ByteArray))
import Data.Word (Word8,Word16)
import Data.Text (Text)
import Http.Header (Header)
import Http.Headers (Headers)

import qualified Data.Text.Internal as Text
import qualified Data.Text.Array
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Http.Header as Header
import qualified Http.Headers as Headers

-- | The response status line and the response headers.
data Response = Response
  { Response -> StatusLine
statusLine :: !StatusLine
  , Response -> Headers
headers :: !Headers
  } deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

data StatusLine = StatusLine
  { StatusLine -> Word16
statusCode :: !Word16
  , StatusLine -> Text
statusReason :: {-# UNPACK #-} !Text
  } deriving (Int -> StatusLine -> ShowS
[StatusLine] -> ShowS
StatusLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusLine] -> ShowS
$cshowList :: [StatusLine] -> ShowS
show :: StatusLine -> String
$cshow :: StatusLine -> String
showsPrec :: Int -> StatusLine -> ShowS
$cshowsPrec :: Int -> StatusLine -> ShowS
Show)

-- | Decode the response status line and the response headers. Fails if
-- any extraneous input is present after the double CRLF sequence that
-- ends the headers.
decode :: Int -> Bytes -> Maybe Response
decode :: Int -> Bytes -> Maybe Response
decode !Int
n !Bytes
b =
  forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
Parser.parseBytesMaybe (forall s. Int -> Parser () s Response
parserResponse Int
n forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s. e -> Parser e s ()
Parser.endOfInput ()) Bytes
b

parserResponse ::
     Int -- ^ Maximum number of headers
  -> Parser () s Response
parserResponse :: forall s. Int -> Parser () s Response
parserResponse !Int
n = do
  StatusLine
statusLine <- forall s. Parser () s StatusLine
parserStatusLine
  SmallArray Header
headers0 <- forall s. Int -> Parser () s (SmallArray Header)
Header.parserSmallArray Int
n
  let !headers :: Headers
headers = SmallArray Header -> Headers
Headers.fromArray SmallArray Header
headers0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Response{StatusLine
statusLine :: StatusLine
$sel:statusLine:Response :: StatusLine
statusLine,Headers
headers :: Headers
$sel:headers:Response :: Headers
headers}

-- Consumes the trailing CRLF
parserStatusLine :: Parser () s StatusLine
parserStatusLine :: forall s. Parser () s StatusLine
parserStatusLine = do
  forall e s.
e -> Char -> Char -> Char -> Char -> Char -> Parser e s ()
Latin.char5 () Char
'H' Char
'T' Char
'T' Char
'P' Char
'/'
  Word8
versionMajor <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
versionMajor forall a. Eq a => a -> a -> Bool
/= Word8
1) (forall e s a. e -> Parser e s a
Parser.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'.'
  Word8
versionMinor <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
versionMinor forall a. Eq a => a -> a -> Bool
/= Word8
1) (forall e s a. e -> Parser e s a
Parser.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
  Word16
statusCode <- forall e s. e -> Parser e s Word16
Latin.decWord16 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
statusCode forall a. Ord a => a -> a -> Bool
>= Word16
1000) (forall e s a. e -> Parser e s a
Parser.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
  -- RFC 7230: reason-phrase = *( HTAB / SP / VCHAR / obs-text )
  Bytes
statusReason <- forall e s. (Word8 -> Bool) -> Parser e s Bytes
Parser.takeWhile forall a b. (a -> b) -> a -> b
$ \Word8
c ->
    (Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
0x7e)
    Bool -> Bool -> Bool
||
    (Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x09)
  forall e s. e -> Char -> Char -> Parser e s ()
Latin.char2 () Char
'\r' Char
'\n'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusLine{Word16
statusCode :: Word16
$sel:statusCode:StatusLine :: Word16
statusCode,$sel:statusReason:StatusLine :: Text
statusReason=Bytes -> Text
unsafeBytesToText Bytes
statusReason}

unsafeBytesToText :: Bytes -> Text
{-# inline unsafeBytesToText #-}
unsafeBytesToText :: Bytes -> Text
unsafeBytesToText (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) =
  Array -> Int -> Int -> Text
Text.Text (ByteArray# -> Array
Data.Text.Array.ByteArray ByteArray#
arr) Int
off Int
len