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"