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 ]