mongrel2-handler (empty) → 0.1.0
raw patch · 6 files changed
+196/−0 lines, 6 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, blaze-builder, blaze-textual, bytestring, containers, http-types, text, zeromq-haskell
Files
- LICENSE +19/−0
- Setup.hs +2/−0
- mongrel2-handler.cabal +30/−0
- src/Mongrel2/Parser.hs +80/−0
- src/Mongrel2/Response.hs +50/−0
- src/Mongrel2/Types.hs +15/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2011 Bardur Arantsson++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mongrel2-handler.cabal view
@@ -0,0 +1,30 @@+Name: mongrel2-handler+Version: 0.1.0+Synopsis: Mongrel2 Handler Library+Description: Mongrel2 Handler Library.+License: MIT+License-file: LICENSE+Category: Web+Cabal-version: >=1.6.0.1+Build-type: Simple+Author: Bardur Arantsson+Maintainer: Bardur Arantsson <bardur@scientician.net>+Stability: Unstable++Library+ Build-Depends: base >= 4.0 && <5+ , aeson >= 0.3 && <0.4+ , attoparsec >= 0.8.5.0 && < 0.9+ , blaze-builder >= 0.3 && < 0.4+ , blaze-textual >= 0.1 && < 0.2+ , bytestring >= 0.9.0.1+ , containers >= 0.3 && < 0.5+ , http-types >= 0.6 && < 0.7+ , text >= 0.11 && < 0.12+ , zeromq-haskell >= 0.6 && < 0.7+ Extensions: OverloadedStrings+ Ghc-options: -Wall -fno-warn-unused-matches+ Hs-source-dirs: src+ Exposed-modules: Mongrel2.Parser+ Mongrel2.Response+ Mongrel2.Types
+ src/Mongrel2/Parser.hs view
@@ -0,0 +1,80 @@+module Mongrel2.Parser+ ( ClientID+ , Message+ , Path+ , RequestHeaders+ , RequestBody+ , UUID+ , 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 Mongrel2.Types (UUID, ClientID)+import Network.HTTP.Types (Query, decodePath)+import Prelude hiding (take)+import qualified Data.Map as M++type Path = ByteString++type RequestHeaders = Value++type RequestBody = ByteString++type Message = (UUID, ClientID, Path, RequestHeaders, RequestBody, ([Text], Query))++-- 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++netstringParser :: (Int -> Parser a) -> Parser a+netstringParser contentParser = do+ len <- decimal+ skip isColon+ str <- contentParser len+ return str++messageParser :: Parser Message+messageParser = do+ uuid <- uuidParser+ skipSpace+ clientId <- decimal+ skipSpace+ path <- takeTill isSpace+ skipSpace+ reqHdr <- netstringParser $ \_ -> json+ skip isComma+ reqBody <- netstringParser take+ return (uuid,clientId,path,reqHdr,reqBody,extractQuery reqHdr)++extractQuery :: Value -> ([Text], Query)+extractQuery (Object hdrs) =+ case M.lookup "URI" hdrs of+ Just (String uriText) -> decodePath $ encodeUtf8 uriText+ _ -> error "Missing/invalid 'URI' in headers received from Mongrel2"+extractQuery _ = error "Invalid headers received from Mongrel2"
+ src/Mongrel2/Response.hs view
@@ -0,0 +1,50 @@+module Mongrel2.Response+ ( Response+ , mkResponse+ ) where++import Blaze.ByteString.Builder (Builder, toByteString, fromByteString)+import Blaze.Text.Int (integral)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 ()+import Data.List (intersperse)+import Data.Monoid+import Mongrel2.Types (ClientID, UUID)+import qualified Data.ByteString as S++-- | Raw response type.+type Response = ByteString++-- | Build a single space.+buildSpace :: Builder+buildSpace = fromByteString " "++-- | Build a UUID.+buildUUID :: UUID -> Builder+buildUUID = fromByteString++-- | Build a netstring from a builder.+buildNetstring :: Builder -> Builder+buildNetstring b =+ -- TODO: Is it possible to find the length without "forcing" the Builder?+ mconcat [ integral $ S.length s+ , fromByteString ":"+ , fromByteString s+ ]+ where+ s = toByteString b++-- | Build client ID list.+buildClientIDList :: [ClientID] -> Builder+buildClientIDList cids =+ mconcat $ intersperse buildSpace $ map integral cids++-- | Build a response from a server UUID, a list of+-- client IDs and a response body builder.+mkResponse :: UUID -> [ClientID] -> Builder -> Response+mkResponse uuid clientIDs bodyBuilder =+ toByteString $ mconcat [ buildUUID uuid+ , buildSpace+ , buildNetstring $ buildClientIDList clientIDs+ , fromByteString ", "+ , bodyBuilder ]
+ src/Mongrel2/Types.hs view
@@ -0,0 +1,15 @@+module Mongrel2.Types+ ( ClientID+ , UUID+ ) where++import Data.ByteString (ByteString)+import Data.Int (Int64)++-- | Client identifier from Mongrel2. This identifies the currently+-- connected client uniquely.+type ClientID = Int64++-- | UUID for communicating with Mongrel2.+type UUID = ByteString+