{-# LANGUAGE DuplicateRecordFields #-}

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 (ByteArray (ByteArray))
import Data.Text (Text)
import Data.Word (Word16)
import Http.Headers (Headers)

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

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

data StatusLine = StatusLine
  { StatusLine -> Word16
statusCode :: !Word16
  , StatusLine -> Text
statusReason :: {-# UNPACK #-} !Text
  }
  deriving (StatusLine -> StatusLine -> Bool
(StatusLine -> StatusLine -> Bool)
-> (StatusLine -> StatusLine -> Bool) -> Eq StatusLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusLine -> StatusLine -> Bool
== :: StatusLine -> StatusLine -> Bool
$c/= :: StatusLine -> StatusLine -> Bool
/= :: StatusLine -> StatusLine -> Bool
Eq, Int -> StatusLine -> ShowS
[StatusLine] -> ShowS
StatusLine -> String
(Int -> StatusLine -> ShowS)
-> (StatusLine -> String)
-> ([StatusLine] -> ShowS)
-> Show StatusLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusLine -> ShowS
showsPrec :: Int -> StatusLine -> ShowS
$cshow :: StatusLine -> String
show :: StatusLine -> String
$cshowList :: [StatusLine] -> ShowS
showList :: [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 s. Parser () s Response) -> Bytes -> Maybe Response
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
Parser.parseBytesMaybe (Int -> Parser () s Response
forall s. Int -> Parser () s Response
parserResponse Int
n Parser () s Response -> Parser () s () -> Parser () s Response
forall a b. Parser () s a -> Parser () s b -> Parser () s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Parser () s ()
forall e s. e -> Parser e s ()
Parser.endOfInput ()) Bytes
b

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

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