{-# OPTIONS_HADDOCK prune #-}

-- |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(..)
    , requestP
    )
    where

import           Network.HTTP.Lucu.Headers
import           Network.HTTP.Lucu.HttpVersion
import           Network.HTTP.Lucu.Parser
import           Network.HTTP.Lucu.Parser.Http
import           Network.URI

-- |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 !String
              deriving (Eq, Show)

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

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


requestP :: Parser Request
requestP = do _                      <- many 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 = ( let methods = [ ("OPTIONS", OPTIONS)
                          , ("GET"    , GET    )
                          , ("HEAD"   , HEAD   )
                          , ("POST"   , POST   )
                          , ("PUT"    , PUT    )
                          , ("DELETE" , DELETE )
                          , ("TRACE"  , TRACE  )
                          , ("CONNECT", CONNECT)
                          ]
            in choice $ map (\ (str, mth)
                                 -> string str >> return mth) methods )
          <|>
          fmap ExtensionMethod token


uriP :: Parser URI
uriP = do str <- many1 $ satisfy (\ c -> not (isCtl c || c == ' '))
          case parseURIReference str of
            Nothing  -> failP
            Just uri -> return uri