mongrel2-handler 0.2.1 → 0.3.0

raw patch · 4 files changed

+31/−21 lines, 4 files

Files

mongrel2-handler.cabal +1/−1
src/Mongrel2.hs +7/−3
src/Mongrel2/Parser.hs +11/−10
src/Mongrel2/Types.hs +12/−7

mongrel2-handler.cabal view

@@ -1,5 +1,5 @@ Name:                mongrel2-handler-Version:             0.2.1+Version:             0.3.0 Synopsis:            Mongrel2 Handler Library Description:         Mongrel2 Handler Library.

src/Mongrel2.hs view

@@ -6,6 +6,7 @@        , receiveRequest        , sendReply        -- Re-exported+       , Connection(..)        , Request(..)        , UUID        , ClientID@@ -13,7 +14,7 @@  import Blaze.ByteString.Builder (Builder) import Data.Attoparsec-import Mongrel2.Types (Request(..))+import Mongrel2.Types (Connection(..), Request(..)) import Mongrel2.Parser (messageParser, UUID, ClientID) import Mongrel2.Response (mkResponse) import qualified System.ZMQ as ZMQ@@ -50,8 +51,11 @@         io $ ConnectedHandler s ps  -- | Receive a parsed request from the Mongrel2 server. Blocks until--- a message is received.-receiveRequest :: ConnectedHandler -> IO Request+-- a message is received. The Mongrel2 server will signal a client+-- disconnect by sending a Request with method @JSON@ and a request+-- body containing a JSON object with a key @type@ containing the value+-- @disconnect@. No response should be sent for such a request.+receiveRequest :: ConnectedHandler -> IO (Connection,Request) receiveRequest handler = do       msg <- ZMQ.receive (chPullSocket handler) []       -- Parse into a structured message.

src/Mongrel2/Parser.hs view

@@ -13,7 +13,7 @@ import Data.Text (Text) import Data.Word (Word8) import Mongrel2.Tnetstring (parseTnetstring1, TValue(..))-import Mongrel2.Types (Request(..), UUID, ClientID)+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@@ -35,7 +35,7 @@                                 ((w >= 48) && (w <= 57 )) ||   -- 0-9                                 (w == 45)                      -- Dash -messageParser :: Parser Request+messageParser :: Parser (Connection, Request) messageParser = do   uuid <- uuidParser   skipSpace@@ -45,12 +45,13 @@   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 $ Request path query rawPath method version (extractHeaders reqHdr) (extractBody rawBody) uuid clientId+  return (connection, Request path query rawPath method version (extractHeaders reqHdr) (extractBody rawBody))  unHeaders :: TValue -> Map ByteString TValue unHeaders (TDictionary m) = M.fromList m@@ -64,7 +65,7 @@ extractQuery hdrs =   case M.lookup "URI" hdrs of     Just (TString uriText) -> decodePath uriText-    _ -> error "Missing/invalid 'URI' in headers received from Mongrel2"+    _                      -> decodePath ""  extractMethod :: Map ByteString TValue -> Method extractMethod hdrs =@@ -72,15 +73,15 @@     Just (TString methodText) -> methodText     _ -> error "Missing/invalid 'METHOD' in headers received from Mongrel2" -extractVersion :: Map ByteString TValue -> HttpVersion+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") -> http09-    Just (TString "HTTP/1.0") -> http10-    Just (TString "HTTP/1.1") -> http11-    Just _                     -> error "Unrecognized HTTP version"-    Nothing -> error "Missing HTTP version in headers received from Mongrel2"+    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

src/Mongrel2/Types.hs view

@@ -1,5 +1,6 @@ module Mongrel2.Types        ( ClientID+       , Connection(..)        , Request(..)        , UUID        ) where@@ -16,9 +17,17 @@ -- | UUID for communicating with Mongrel2. type UUID = ByteString +-- | Connection information.+data Connection = Connection {+  -- | UUID of the connected Mongrel2 server.+  connServerUUID :: UUID,+  -- | ID of the connected client browser.+  connClientID :: ClientID+} deriving (Show)+ -- | Request information. data Request = Request {-  -- ^ Request path+  -- | Request path   reqPath :: [Text],   -- | Query part of the request   reqQuery :: Query,@@ -27,13 +36,9 @@   -- | Request method (GET, POST, etc.)   reqMethod :: Either Ascii StdMethod,   -- | HTTP version-  reqVersion :: HttpVersion,+  reqVersion :: Maybe HttpVersion,   -- | Request headers   reqHeaders :: RequestHeaders,   -- | Request body.-  reqBody :: ByteString,-  -- | UUID of the connected Mongrel2 server.-  reqServerUUID :: UUID,-  -- | ID of the connected client browser.-  reqClientID :: ClientID+  reqBody :: ByteString   } deriving (Show)