Commit 0430acd0 authored by ecrombag's avatar ecrombag

First version of Remote Procedure Calls. See Tests/RPCTest.icl for two small test examples.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@690 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 0f723a9c
......@@ -96,7 +96,7 @@ handleSessionRequest config flows handler request world
# world = finalizeTSt tst
= (response, world)
where
mkSessionFailureResponse to = "{\"success\" : false, \"error\" : \"" +++ (if to "Your session timed out" "Failed to load session") +++ "\"}"
mkSessionFailureResponse to = "{\"success\" : false, \"session\": false, \"error\" : \"" +++ (if to "Your session timed out" "Failed to load session") +++ "\"}"
initTSt :: !HTTPRequest !Config ![Workflow] !*World -> *TSt
initTSt request config flows world
......
......@@ -5,7 +5,8 @@ import Http, TSt
import Text, JSON, Time, Util
import RPC
derive JSONEncode RPCInfo, RPCCallType, RPCInterface, RPCMessageType, RPCProtocol, RPCHttpMethod, RPCParam
derive JSONEncode RPCExecute, RPCCallType, RPCInterface, RPCMessageType, RPCProtocol, RPCHttpMethod, RPCParam,
RPCParamValue, RPCOperation, RPCParameterType
handleRPCListRequest :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCListRequest request tst
......@@ -13,10 +14,10 @@ handleRPCListRequest request tst
# (rpcinfos, tst) = determineRPCItems forest tst
= ({http_emptyResponse & rsp_data = (toJSON rpcinfos)},tst)
determineRPCItems :: ![TaskTree] !*TSt -> ([RPCInfo],!*TSt)
determineRPCItems :: ![TaskTree] !*TSt -> ([RPCExecute],!*TSt)
determineRPCItems forest tst = (flatten [determineTreeRPCItems tree \\ tree <- forest],tst)
determineTreeRPCItems :: !TaskTree -> [RPCInfo]
determineTreeRPCItems :: !TaskTree -> [RPCExecute]
determineTreeRPCItems (TTMainTask ti mti children)
| (not ti.TaskInfo.active) || ti.TaskInfo.finished= []
| otherwise = flatten [(determineTreeRPCItems child) \\ child <- children]
......
......@@ -132,7 +132,7 @@ buildTaskPanel (TTInteractiveTask ti (Right upd))
buildTaskPanel (TTMonitorTask ti html)
= MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] html)}
buildTaskPanel (TTRpcTask ti rpc)
= MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCInfo.name, Text ": ", Text rpc.RPCInfo.status])}
= MonitorPanel {MonitorPanel | xtype = "itasks.task-monitor", id = "taskform-" +++ ti.TaskInfo.taskId, taskId = ti.TaskInfo.taskId, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status])}
buildTaskPanel (TTMainTask ti mti _)
= MainTaskPanel {MainTaskPanel | xtype = "itasks.task-waiting", taskId = ti.TaskInfo.taskId, properties = mti}
buildTaskPanel (TTSequenceTask ti tasks)
......
......@@ -18,8 +18,8 @@ from TSt import :: Task
, type :: RPCMessageType
}
:: RPCOperation = { name :: String
, parameters :: [RPCDescParam]
:: RPCOperation = { name :: String
, parameters :: [RPCParam]
, location :: String
, callType :: RPCCallType
}
......@@ -40,11 +40,27 @@ from TSt import :: Task
| SolicitResponse //Client <- Server & Client -> Server
| Notification //Client <- Server
:: RPCDescParam = { name :: String
, type :: RPCDescParamType
:: RPCParam = { name :: String
, type :: RPCParameterType
}
:: RPCCallParam :== ( String, String )
:: RPCParameterType = RPCString
| RPCBool
| RPCInt
| RPCReal
:: RPCDescParamType = RPCInt | RPCReal | RPCString
/*
The execution message sent to the daemon
*/
:: RPCExecute = { taskId :: String
, interface :: RPCInterface
, operation :: RPCOperation
, paramValues :: [RPCParamValue]
, status :: String
}
:: RPCParamValue = { name :: String
, serializedValue :: String
}
\ No newline at end of file
......@@ -235,7 +235,7 @@ mkMonitorTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
*
* @return The constructed RPC task
*/
mkRpcTask :: !String !RPCInfo !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
/**
......
......@@ -15,13 +15,14 @@ import code from "copy_graph_to_string_interface.obj";
:: TaskState = TSNew | TSActive | TSDone
:: RPCMessage =
{ success :: Bool
, resultChange :: Bool
, finished :: Bool
, status :: String
, result :: String
}
:: RPCMessage =
{ success :: Bool
, error :: Bool
, finished :: Bool
, result :: String
, status :: String
, errormsg :: String
}
derive gPrint TaskState
derive gParse TaskState
......@@ -313,27 +314,27 @@ where
mkMonitorTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTMonitorTask taskInfo []}
mkRpcTask :: !String !RPCInfo !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpci parsefun = Task taskname Nothing mkRpcTask`
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpce parsefun = Task taskname Nothing mkRpcTask`
where
mkRpcTask` tst=:{TSt | taskNr, taskInfo}
# rpci = {RPCInfo | rpci & taskId = taskNrToString taskNr}
# rpce = {RPCExecute | rpce & taskId = taskNrToString taskNr}
# (updates, tst) = getRpcUpdates tst
# (rpci, tst) = checkRpcStatus rpci tst
# (rpce, tst) = checkRpcStatus rpce tst
| length updates == 0
= applyRpcDefault {tst & activated = False, tree = TTRpcTask taskInfo rpci }
= applyRpcDefault {tst & activated = False, tree = TTRpcTask taskInfo rpce }
| otherwise
= applyRpcUpdates updates tst rpci parsefun
= applyRpcUpdates updates tst rpce parsefun
checkRpcStatus :: RPCInfo !*TSt -> (!RPCInfo, !*TSt)
checkRpcStatus rpci tst
checkRpcStatus :: RPCExecute !*TSt -> (!RPCExecute, !*TSt)
checkRpcStatus rpce tst
# (mbStatus, tst) = getTaskStore "status" tst
= case mbStatus of
Nothing
# tst = setTaskStore "status" "Pending" tst
= ({RPCInfo | rpci & status = "Pending"},tst)
= ({RPCExecute | rpce & status = "Pending"},tst)
Just s
= ({RPCInfo | rpci & status = s},tst)
= ({RPCExecute | rpce & status = s},tst)
getRpcUpdates :: !*TSt -> ([(String,String)],!*TSt)
getRpcUpdates tst=:{taskNr,request} = (updates request, tst)
......@@ -347,34 +348,38 @@ where
import StdDebug
/* Error handling needs to be implemented! */
applyRpcUpdates :: [(String,String)] !*TSt !RPCInfo !(String -> a) -> *(!a,!*TSt) | gUpdate{|*|} a
applyRpcUpdates [] tst rpci parsefun = applyRpcDefault tst
applyRpcUpdates [(n,v):xs] tst rpci parsefun
| n == "_rpcmessage"
applyRpcUpdates :: [(String,String)] !*TSt !RPCExecute !(String -> a) -> *(!a,!*TSt) | gUpdate{|*|} a
applyRpcUpdates [] tst rpce parsefun = applyRpcDefault tst
applyRpcUpdates [(n,v):xs] tst rpce parsefun
| n == "_rpcresult"
# (mbMsg) = fromJSON v
= case mbMsg of
Just msg = applyRpcMessage msg tst rpci parsefun
Nothing = abort("Cannot parse daemon message "+++v) //needs to be exception!
| otherwise = applyRpcUpdates xs tst rpci parsefun
Just msg = applyRpcMessage msg tst rpce parsefun
Nothing = abort("Cannot parse daemon message "+++v) //needs to be exception!
| otherwise = applyRpcUpdates xs tst rpce parsefun
where
applyRpcMessage msg tst rpci parsfun
# tst = (setTaskStore "status" msg.RPCMessage.status tst)
# tst = setStatus msg.RPCMessage.status tst
= case msg.RPCMessage.success of
True
# tst = checkFinished msg.RPCMessage.finished tst
| msg.RPCMessage.resultChange = (parsefun msg.RPCMessage.result, tst)
| otherwise = applyRpcDefault tst
# tst = checkFinished msg.RPCMessage.finished tst
= (parsefun msg.RPCMessage.result, tst)
False
# tst = {TSt | tst & activated = True}
= applyRpcDefault tst
# tst = {TSt | tst & activated = True}
= applyRpcDefault tst
checkFinished True tst = {TSt | tst & activated = True}
checkFinished False tst = {TSt | tst & activated = False}
setStatus status tst
| status <> "" = (setTaskStore "status" status tst)
| otherwise = tst
applyRpcDefault :: !*TSt -> *(!a,!*TSt) | gUpdate{|*|} a
applyRpcDefault tst=:{TSt|world}
# (def,wrld) = defaultValue world
= (def,{TSt | tst & world=wrld})
mkSequenceTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkSequenceTask taskname taskfun = Task taskname Nothing mkSequenceTask`
......
......@@ -17,7 +17,7 @@ from TUIDefinition import :: TUIDef, :: TUIUpdate
:: TaskTree = TTMainTask TaskInfo TaskProperties [TaskTree] //A task that is treated as a main chunk of work
| TTInteractiveTask TaskInfo (Either TUIDef [TUIUpdate]) //A task that can be worked on through a gui
| TTMonitorTask TaskInfo [HtmlTag] //A task that upon evaluation monitors a condition and may give status output
| TTRpcTask TaskInfo RPCInfo //A task that represents an rpc invocation
| TTRpcTask TaskInfo RPCExecute //A task that represents an rpc invocation
| TTSequenceTask TaskInfo [TaskTree] //A task that is composed of a number of sequentially executed subtasks
| TTParallelTask TaskInfo TaskCombination [TaskTree] //A task that is composed of a number of parallel executed subtasks
| TTFinishedTask TaskInfo //A completed task
......@@ -58,19 +58,7 @@ from TUIDefinition import :: TUIDef, :: TUIUpdate
| TPStuck //Worker is stuck and needs assistence
| TPWaiting //Worker is waiting, not actively working on the task
| TPReject //Worker does not want to continue working on the task
/*
The actual call to a service
*/
:: RPCInfo = { taskId :: TaskId
, name :: String
, interface :: RPCInterface
, location :: String
, parameters :: [RPCCallParam]
, callType :: RPCCallType
, status :: String //Status message
}
/**
* Finds the sub tree with the given task number
*/
......
......@@ -4,28 +4,68 @@ import iTasks
import TaskTree
import Base64
import JSON
import GeoDomain
from StdFunc import o
from TSt import mkRpcTask
rpcStub2 :: Task String
rpcStub2 = mkRpcTask "Ls Command"
{ RPCExecute
| taskId = ""
, interface = { protocol = System
, type = Plain
}
, operation = { name = "Ls command"
, parameters = []
, location = "ls"
, callType = RequestResponse
}
, paramValues = [{name = "a", serializedValue = ""},{name = "l", serializedValue = ""}]
, status = ""
}
base64Decode
rpcStub :: Real Real -> Task String
rpcStub lat lng = mkRpcTask
rpcStub :: Map -> Task String
rpcStub map
# (lat,lng) = extractCoords map
= mkRpcTask
"Fetch Ocean Name"
{ RPCInfo
| name = "Geoweb Ocean Names"
, location = "http://ws.geonames.org/oceanJSON"
{ RPCExecute
| taskId = ""
, interface = { protocol = HTTP GET
, type = JSONRPC
, type = JSONRPC
}
, operation = { name = "Geoweb Ocean Names"
, parameters = [{RPCParam
|name = "lat"
,type = RPCReal},
{RPCParam
|name = "lng"
,type = RPCReal}]
, location = "http://ws.geonames.org/oceanJSON"
, callType = RequestResponse
}
, parameters = [("lat", toJSON lat),("lon", toJSON lng)]
, callType = Notification
, paramValues = [{name = "lat"
,serializedValue = toJSON lat},
{name = "lng"
,serializedValue = toJSON lng}]
, status = ""
, taskId = ""
}
base64Decode
extractCoords :: Map -> (Real,Real)
extractCoords map =: {markers}
# head = hd(markers)
= head.MapMarker.position
rpcTestTask :: Task Void
rpcTestTask =
enterInformation "Lattitude" >>= \lat -> enterInformation "Longitude" >>= \lng -> (rpcStub lat lng) >>= showMessage
enterInformation "Click an ocean" >>= rpcStub >>= showMessage
rpcTestTask2 :: Task Void
rpcTestTask2 = rpcStub2 >>= showMessage
Start :: *World -> *World
Start world = startEngine [workflow "RPC Test" rpcTestTask ] world
\ No newline at end of file
Start world = startEngine [workflow "Fetch Ocean Name" rpcTestTask, workflow "Do 'ls'-command" rpcTestTask2 ] world
\ No newline at end of file
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