{-# 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
  { statusLine :: !StatusLine
  , headers :: !Headers
  } deriving (Show)

data StatusLine = StatusLine
  { statusCode :: !Word16
  , statusReason :: {-# UNPACK #-} !Text
  } deriving (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 !n !b =
  Parser.parseBytesMaybe (parserResponse n <* Parser.endOfInput ()) b

parserResponse ::
     Int -- ^ Maximum number of headers
  -> Parser () s Response
parserResponse !n = do
  statusLine <- parserStatusLine
  headers0 <- Header.parserSmallArray n
  let !headers = Headers.fromArray headers0
  pure Response{statusLine,headers}

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

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