MessageParser.hs

module Hack2.Handler.Mongrel2.MessageParser
       ( 
         messageParser
       ) where

import Data.Aeson (Value(..), json)
import Data.Attoparsec
import Data.Attoparsec.Char8 (decimal)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word8)
import Prelude hiding (take)
import qualified Data.Map as M
import Hack2.Handler.Mongrel2.Types



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

isColon :: Word8 -> Bool
isColon 0x3a = True
isColon _    = False

isComma :: Word8 -> Bool
isComma 0x2c = True
isComma _    = 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
                                  -- ||  (w == 95)                   -- _
                                  
                                  

netstringParser :: (Int -> Parser a) -> Parser a
netstringParser contentParser = do
  len <- decimal
  skip isColon
  str <- contentParser len
  return str

--   mongrel_send 2 / 238:{"PATH":"/","x-forwarded-for":"127.0.0.1","accept":"*/*","user-agent":"curl/7.19.7 (universal-apple-darwin10.0) libcurl/7.19.7 OpenSSL/0.9.8l zlib/1.2.3",
--    "host":"127.0.0.1:6767","METHOD":"GET","VERSION":"HTTP/1.1","URI":"/","PA
--     TTERN":"/"},0:,

-- def parse(msg):
--     sender, conn_id, path, rest = msg.split(' ', 3)
--     headers, rest = tnetstrings.parse(rest)
--     body, _ = tnetstrings.parse(rest)
-- 
--     if type(headers) is str:
--         headers = json.loads(headers)
-- 
--     return Request(sender, conn_id, path, headers, body)
    
messageParser :: Parser Request
messageParser = do
  uuid <- uuidParser
  skipSpace
  clientId <- decimal
  skipSpace
  path <- takeTill isSpace
  skipSpace
  reqHdr <- netstringParser $ \_ -> json
  skip isComma
  reqBody <- netstringParser take
  
  return $ Request 
    {
      requestUuid = uuid
    , requestClientId = clientId
    , requestPath = path
    , requestHeaders = reqHdr
    , requestBody = reqBody
    }

-- extractQuery :: Value -> ([Text], Query)
-- extractQuery (Object hdrs) =
--   case M.lookup "URI" hdrs of
--     Just (String uriText) -> decodePath $ encodeUtf8 uriText
--     _ -> fail "Missing/invalid 'URI' in headers received from Mongrel2"
-- extractQuery _ = fail "Invalid headers received from Mongrel2"