network-pgi (empty) → 0.0.1

raw patch · 5 files changed

+157/−0 lines, 5 filesdep +attoparsecdep +attoparsec-enumeratordep +basesetup-changed

Dependencies added: attoparsec, attoparsec-enumerator, base, bytestring, enumerator, tnet

Files

• LICENSE +13/−0
• Network/PGI.hs +94/−0
• Network/PGI/Handlers.hs +31/−0
• Setup.hs +2/−0
• network-pgi.cabal +17/−0

@@ -0,0 +1,13 @@+Copyright 2012 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,94 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Network.PGI+  (+    serve+  , Route+  , Handler+  ) where++import Prelude hiding (catch)++import TNET++import Control.Applicative ((<$>))+import Control.Exception (catch, SomeException)+import Control.Monad (forever)+import Data.Attoparsec.Enumerator+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.Enumerator (($$), run)+import Data.Enumerator.Binary (enumHandle)+import Data.Maybe (isJust)+import System.Exit+import System.IO++data PGIRequest = PGIRequest {+  pRequest   :: Maybe TValue,+  pRequestID :: Maybe String,+  pCommand   :: Maybe String,+  pRoute     :: Maybe String+  }+  deriving (Eq, Show)++instance TNET PGIRequest where+  toTNET _ = undefined+  fromTNET tval = let+    request   = tval .: "request"+    requestID = B8.unpack <$> tval .: "request_id"+    command   = B8.unpack <$> tval .: "command"+    route     = tval .: "route"+    in Just $ PGIRequest request requestID command route++type Route = String+type Handler = TValue -> IO TValue++serve :: [(Route, Handler)] -> IO ()+serve handlers = do+  hSetBuffering stdin NoBuffering+  serveLoop handlers++serveLoop :: [(Route, Handler)] -> IO ()+serveLoop handlers = forever $ do+  raw_request <- run (enumHandle 1 stdin $$ iterParser tnetParser)+  case raw_request of+    Left e -> exitSuccess+    Right raw -> do let request = fromTNET raw :: Maybe PGIRequest+                    case request of+                      Nothing -> errorTNET "Could not parse request"+                      Just req  ->+                        case pCommand req of+                          Just command -> handleCommand command+                          Nothing      -> if validRequest req+                                          then handleRequest handlers req+                                          else errorTNET "Invalid Request"++handleCommand :: String -> IO ()+handleCommand "init" = outputTNET okResponse+  where okResponse = dict [ "result" .= "ok" ]+handleCommand c      = errorTNET $ "Unsupported command: " ++ c++outputTNET :: TValue -> IO ()+outputTNET t = B.putStr (encode t) >> hFlush stdout++errorTNET :: String -> IO ()+errorTNET e = outputTNET errorMsg+  where errorMsg = dict ["dev_error" .= dict [ "message" .= e, "trace" .= "" ]]++validRequest :: PGIRequest -> Bool+validRequest req = and requiredFields+  where requiredFields = [isJust $ pRequest req, isJust $ pRoute req]++handleRequest :: [(Route, Handler)] -> PGIRequest -> IO ()+handleRequest handlers request =+  case lookup route handlers of+    Nothing -> errorTNET $ "Route not found: " ++ route+    Just handler ->+      catch (handler appRequest >>= outputTNETResponse)+            (\(e :: SomeException) -> errorTNET $ show e)+  where+    Just route = pRoute request+    Just appRequest = pRequest request++    outputTNETResponse r = outputTNET $+      dict [ "response" .= r ]

@@ -0,0 +1,31 @@+module Network.PGI.Handlers where++import Network.PGI+import TNET+import Control.Monad (liftM)++constHandler :: (TNET a) => a -> Handler+constHandler v = const (return tv)+  where tv = toTNET v++constHandlerM :: (TNET a) => IO a -> Handler+constHandlerM iv = const (liftM toTNET iv)++makeHandler :: (TNET a, TNET b) => (a -> b) -> Handler+makeHandler f raw_req =+  case fromTNET raw_req of+    Nothing -> decodeError raw_req+    Just req -> return . toTNET $ f req++makeHandlerM :: (TNET a, TNET b) => (a -> IO b) -> Handler+makeHandlerM f raw_req =+  case fromTNET raw_req of+    Nothing -> decodeError raw_req+    Just req -> liftM toTNET $ f req++bodyData :: (TNET a) => a -> TValue+bodyData v = dict [ "body_data" .= v ]++decodeError tval = error $ unlines [ "Request was not the right type: "+                                   , (show . encode) tval+                                   ]

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,17 @@+Name:          network-pgi+Version:       0.0.1+Synopsis:      Library for writing PGI applications+Description:+  Provides an API to create and serve PGI applications.+Author:        Harry Terkelsen+Maintainer:    het32@cornell.edu+Cabal-Version: >= 1.2+Build-Type:    Simple+Category:      Web+License:       OtherLicense+License-File:  LICENSE+library+  Exposed-Modules: Network.PGI, Network.PGI.Handlers+  Build-Depends:   base >= 4.0 && < 5.0, attoparsec >= 0.10, bytestring >= 0.9,+                   attoparsec-enumerator >= 0.3, enumerator >= 0.4,+                   tnet >= 0.0.1