module Mongrel2.Parser
       ( ClientID
       , UUID
       , messageParser
       ) where

import Data.Attoparsec
import Data.Attoparsec.Char8 (decimal)
import Data.ByteString (ByteString, uncons)
import Data.CaseInsensitive (CI)
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Word (Word8)
import Mongrel2.Tnetstring (parseTnetstring1, TValue(..))
import Mongrel2.Types (ClientID, Connection(..), Request(..), UUID)
import Network.HTTP.Types (HttpVersion, Method, Query, RequestHeaders, decodePath, http09, http10, http11, parseMethod)
import Prelude hiding (take)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map as M

-- Predicates for parsing.
isSpace :: Word8 -> Bool
isSpace 0x20 = True
isSpace _    = False

-- Skip spaces.
skipSpace :: Parser ()
skipSpace = skipWhile isSpace

-- Parse a UUID.
uuidParser :: Parser ByteString
uuidParser = takeWhile1 $ \w -> ((w >= 65) && (w <= 90 )) ||   -- A-Z
                                ((w >= 97) && (w <= 122)) ||   -- a-z
                                ((w >= 48) && (w <= 57 )) ||   -- 0-9
                                (w == 45)                      -- Dash

messageParser :: Parser (Connection, Request)
messageParser = do
  uuid <- uuidParser
  skipSpace
  clientId <- decimal
  skipSpace
  rawPath <- takeTill isSpace
  skipSpace
  rawReqHdr <- parseTnetstring1
  rawBody <- parseTnetstring1
  let connection = Connection uuid clientId
  -- Touchups to conform better with Http-types.
  let reqHdr = unHeaders rawReqHdr
  let method = parseMethod $ extractMethod reqHdr
  let version = extractVersion reqHdr
  let (path,query) = extractQuery reqHdr
  return (connection, Request path query rawPath method version (extractHeaders reqHdr) (extractBody rawBody))

unHeaders :: TValue -> Map ByteString TValue
unHeaders (TDictionary m) = M.fromList m
unHeaders _               = error "Invalid headers received from Mongrel2"

extractBody :: TValue -> ByteString
extractBody (TString body) = body
extractBody _              = error "Invalid body received from Mongrel2"

extractQuery :: Map ByteString TValue -> ([Text], Query)
extractQuery hdrs =
  case M.lookup "URI" hdrs of
    Just (TString uriText) -> decodePath uriText
    _                      -> decodePath ""

extractMethod :: Map ByteString TValue -> Method
extractMethod hdrs =
  case M.lookup "METHOD" hdrs of
    Just (TString methodText) -> methodText
    _ -> error "Missing/invalid 'METHOD' in headers received from Mongrel2"

extractVersion :: Map ByteString TValue -> Maybe HttpVersion
extractVersion hdrs =
  -- TODO: This really should be done in a more general way.
  case M.lookup "VERSION" hdrs of
    Just (TString "HTTP/0.9") -> Just http09
    Just (TString "HTTP/1.0") -> Just http10
    Just (TString "HTTP/1.1") -> Just $ http11
    Just _                    -> error "Unrecognized HTTP version"
    Nothing                   -> Nothing

extractHeaders :: Map ByteString TValue -> RequestHeaders
extractHeaders hdrs = catMaybes $ map extractHdr $ M.toList hdrs

extractHdr :: (ByteString, TValue) -> Maybe (CI ByteString, ByteString)
extractHdr (t, TString v) = handleHdr t v
extractHdr _              = Nothing

handleHdr :: ByteString -> ByteString -> Maybe (CI ByteString, ByteString)
handleHdr k v =
  case uncons k of
    Just (c, _) | (c >= 65 && c <= 90) -> Nothing
    _                                  -> Just (CI.mk k, v)