{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  , ViewPatterns
  #-}
-- |Definition of things related on HTTP request.
--
-- In general you don't have to use this module directly.
module Network.HTTP.Lucu.Request
    ( Method(..)
    , Request(..)
    , reqHasBody
    , requestP
    )
    where
import Control.Applicative
import Control.Monad.Unicode
import Data.Ascii (Ascii)
import Data.Attoparsec.Char8
import qualified Data.ByteString.Char8 as C8
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Parser.Http
import Network.URI
import Prelude.Unicode

-- |This is the definition of HTTP request methods, which shouldn't
-- require any description.
data Method = OPTIONS
            | GET
            | HEAD
            | POST
            | PUT
            | DELETE
            | TRACE
            | CONNECT
            | ExtensionMethod !Ascii
              deriving (Eq, Show)

-- |This is the definition of HTTP reqest.
data Request
    = Request {
        reqMethod  ∷ !Method
      , reqURI     ∷ !URI
      , reqVersion ∷ !HttpVersion
      , reqHeaders ∷ !Headers
      }
    deriving (Eq, Show)

instance HasHeaders Request where
    getHeaders = reqHeaders
    setHeaders req hdr = req { reqHeaders = hdr }

-- |Returns 'True' iff the 'Request' must have an entity body.
reqHasBody ∷ Request → Bool
reqHasBody (reqMethod → m)
    = m ≡ POST ∨ m ≡ PUT

requestP ∷ Parser Request
requestP = do skipMany crlf
              (method, uri, version) ← requestLineP
              headers                ← headersP
              return Request {
                           reqMethod  = method
                         , reqURI     = uri
                         , reqVersion = version
                         , reqHeaders = headers
                         }

requestLineP ∷ Parser (Method, URI, HttpVersion)
requestLineP = do method ← methodP
                  sp
                  uri    ← uriP
                  sp
                  ver    ← httpVersionP
                  crlf
                  return (method, uri, ver)

methodP ∷ Parser Method
methodP = choice
          [ string "OPTIONS" ≫ return OPTIONS
          , string "GET"     ≫ return GET
          , string "HEAD"    ≫ return HEAD
          , string "POST"    ≫ return POST
          , string "PUT"     ≫ return PUT
          , string "DELETE"  ≫ return DELETE
          , string "TRACE"   ≫ return TRACE
          , string "CONNECT" ≫ return CONNECT
          , ExtensionMethod <$> token
          ]

uriP ∷ Parser URI
uriP = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
          let str = C8.unpack bs
          case parseURIReference str of
            Nothing  -> fail ("Unparsable URI: " ⧺ str)
            Just uri -> return uri