Commit fb0f4324 authored by Bas Lijnse's avatar Bas Lijnse

Removed RPC Handlers

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1136 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 1f5824f4
......@@ -15,7 +15,6 @@ import Http, HttpUtil
from HttpServer import :: HTTPServerControl(..), :: HTTPServerOption(..)
import Setup
import RPCHandlers
import ApplicationService, SessionService, WorkflowService, TaskService, UserService, DocumentService
import HtmlUtil
......@@ -37,13 +36,10 @@ engine mbConfig userFlows
where
handlers config
= [
//'old' handlers
((==) (config.serverPath +++ "/rpc/request"), handleSessionRequest config flows handleRPCListRequest)
,((==) (config.serverPath +++ "/rpc/response"), handleSessionRequest config flows handleRPCUpdates)
// Handler to stop the server nicely
((==) "/stop", handleStopRequest)
// Webservices
,(startsWith "/services", serviceDispatch config flows)
// Handler to stop the server nicely
,((==) "/stop", handleStopRequest)
,(\_ -> True, handleStaticResourceRequest config)
]
//Always add the workflows for administering the itask system
......
definition module RPCHandlers
/**
* Handles incomding requests and updates from the RPC Daemon
*/
from TSt import :: TSt
from Http import :: HTTPRequest, :: HTTPResponse
handleRPCListRequest :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCUpdates :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
implementation module RPCHandlers
import StdEnv
import Http, TSt, ProcessDB
import Text, JSON, Time, Util
import RPC
handleRPCListRequest :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCListRequest request tst
# (forest, tst) = ([],tst) //calculateTaskForest [] tst
# (rpcinfos, tst) = determineRPCItems forest tst
= ({http_emptyResponse & rsp_data = toString (toJSON rpcinfos)},tst)
determineRPCItems :: ![TaskTree] !*TSt -> ([RPCExecute],!*TSt)
determineRPCItems forest tst = (flatten [determineTreeRPCItems tree \\ tree <- forest],tst)
determineTreeRPCItems :: !TaskTree -> [RPCExecute]
determineTreeRPCItems (TTMainTask _ _ _ _ child) = determineTreeRPCItems child
determineTreeRPCItems (TTParallelTask ti tpi children) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTGroupedTask ti children _ _) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTSequenceTask ti children) = flatten [(determineTreeRPCItems child) \\ child <- children]
determineTreeRPCItems (TTRpcTask ti rpci) = [rpci]
determineTreeRPCItems _ = []
handleRPCUpdates :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCUpdates request tst
# (tree, tst) = calculateTaskTree procId SpineTree [] tst //TODO add updates
# tst = updateTimeStamps procId tst
= case tree of
(TTFinishedTask ti _) = finished tst
_ = success tst
where
taskId = http_getValue "_rpctaskid" request.arg_post "0"
taskNr = taskNrFromString taskId
procId = toString(last taskNr)
debug = http_getValue "_debug" request.arg_post "0" == "1"
finished tst = ({http_emptyResponse & rsp_data = "{ \"success\" : true, \"finished\" : true, \"error\" : \"\" }"}, tst)
success tst = ({http_emptyResponse & rsp_data = "{ \"success\" : true, \"finished\" : false, \"error\" : \"\" }"}, tst)
error msg tst = ({http_emptyResponse & rsp_data = "{ \"success\" : false, \"finished\" : true, \"error\" : \"" +++ msg +++ "\"}"}, tst)
updateTimeStamps :: !ProcessId !*TSt -> *TSt
updateTimeStamps pid tst
# (now,tst) = accWorldTSt time tst
= snd (updateProcessProperties pid (\p -> {p & systemProperties = {p.systemProperties & firstEvent = case p.systemProperties.firstEvent of Nothing = Just now; x = x
, latestExtEvent = Just now
}}) tst)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment