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

Libraries/iTasks/Framework/Engine.icl

@@ -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

Libraries/iTasks/Framework/Handlers/RPCHandlers.icl

@@ -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]

Libraries/iTasks/Framework/Handlers/WorkTabHandler.icl

@@ -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)

Libraries/iTasks/Framework/RPC.dcl

@@ -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

Libraries/iTasks/Framework/TSt.dcl

@@ -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
 
 
 /**

Libraries/iTasks/Framework/TSt.icl

@@ -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`

Libraries/iTasks/Framework/TaskTree.dcl

@@ -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
 */

Tests/RPCTest.icl

@@ -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