Refactored main server loop, connections are now in iworld

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2942 63da3aa8-80fd-4f01-9db8-e6ea747a3da2

Server/iTasks/API/Core/Client/Tasklet.icl

@@ -97,7 +97,6 @@ where
 	taskFunc (EditEvent _ targetTaskId "finalize" jsonRes) taskRepOpts (TCBasic taskId ts _ _) iworld
 		| targetTaskId == taskId	
 			# res = fromJust (fromJSON (jsonRes))
-			# rep = TaskRep (appTweak (ViewPart, Nothing, [], [])) []
 			# result = DestroyedResult
 			= (result, printlnI "finalize" iworld)  
  

Server/iTasks/API/Core/CoreCombinators.icl

@@ -502,6 +502,7 @@ where
 		= markListEntryRemoved parId entryId iworld
 	remove _ _ iworld = iworld
 
+import StdDebug
 workOn :: !TaskId -> Task WorkOnStatus
 workOn (TaskId instanceNo taskNo) = Task eval
 where

Server/iTasks/API/Core/LayoutCombinators.dcl

@@ -3,7 +3,6 @@ definition module iTasks.API.Core.LayoutCombinators
 import iTasks.API.Core.SystemTypes
 from iTasks.API.Core.CoreCombinators import class tune
 
-from iTasks.Framework.Task import :: TaskCompositionType
 from iTasks.Framework.TaskState import :: TIMeta
 import iTasks.Framework.UIDefinition
 

Server/iTasks/API/Core/LayoutCombinators.icl

@@ -8,10 +8,10 @@ import iTasks.API.Core.SystemTypes, iTasks.API.Core.CoreCombinators
 from Data.Map import qualified put, get, del, newMap, toList
 from StdFunc import o, const
 
-from iTasks.Framework.Task import :: TaskCompositionType, :: TaskCompositionType(..), :: EventNo
+from iTasks.Framework.Task import :: EventNo
 from iTasks.Framework.TaskState import :: TIMeta(..), :: TIType(..), :: SessionInfo(..)
 
-derive gEq TaskCompositionType, UISide
+derive gEq UISide
 
 autoLayoutRules :: LayoutRules
 autoLayoutRules

Server/iTasks/Framework/Client/RunOnClient.icl

@@ -174,6 +174,7 @@ createClientIWorld serverURL currentInstance
 		  ,uiMessages			= 'Data.Map'.newMap
 		  ,shutdown				= False
           ,random               = genRandInt seed
+          ,loop                 = {done=[],todo=[]}
 		  ,world				= world
 		  ,resources			= Nothing
 		  ,onClient				= True

Server/iTasks/Framework/Engine.dcl

@@ -53,8 +53,8 @@ RELATIVE_LOCATIONS		:== [".": take 5 (iterate ((</>) "..") "..")]
 */
 startEngine :: a !*World -> *World | Publishable a
 
-// Backround process. TODO
-background :: !*IWorld -> (!Bool,!*IWorld)
+// Background process. TODO
+background :: !*IWorld -> *IWorld
 
 /**
 * Wraps a task together with a url to make it publishable by the engine

Server/iTasks/Framework/Engine.icl

@@ -45,7 +45,7 @@ startEngine publishable world
 	// mark all instance as outdated initially
 	# (maxNo,iworld)		= maxInstanceNo iworld
 	# iworld				= addOutdatedInstances [(instanceNo, Nothing) \\ instanceNo <- [1..maxNo]] iworld
-	# iworld				= startHTTPServer port keepalive (engine publishable) timeout background iworld
+	# iworld				= serve port (httpService port keepalive (engine publishable)) (BackgroundTask background) timeout iworld
 	= finalizeIWorld iworld
 where
 	infoline :: !String -> [String]
@@ -114,9 +114,7 @@ where
 	
 MAX_TIMEOUT :== 86400000 // one day
 
-background :: !*IWorld -> (!Bool,!*IWorld)
-background iworld=:{IWorld|shutdown=True}
-	= (True,iworld)
+background :: !*IWorld -> *IWorld
 background iworld
 	# iworld			= updateCurrentDateTime iworld
 	# (mbWork, iworld)	= dequeueWork iworld
@@ -140,7 +138,7 @@ background iworld
 			# (curTime, iworld) = currentTimestamp iworld
 			= (Just (toTimeout curTime time), iworld)
 			*/
-	= (False,iworld)
+	= iworld
 
 // The iTasks engine consist of a set of HTTP request handlers
 engine :: publish -> [(!String -> Bool
@@ -223,6 +221,7 @@ initIWorld sdkDir world
 	  ,workQueue			= []
 	  ,uiMessages           = newMap
 	  ,shutdown				= False
+      ,loop                 = {done = [], todo = []}
 	  ,world				= world
       ,resources            = Nothing
       ,random               = genRandInt seed
@@ -260,6 +259,7 @@ finalizeIWorld iworld=:{IWorld|world} = world
 // Request handler which serves static resources from the application directory,
 // or a system wide default directory if it is not found locally.
 // This request handler is used for serving system wide javascript, css, images, etc...
+
 handleStaticResourceRequest :: !HTTPRequest *IWorld -> (!HTTPResponse,!*IWorld)
 handleStaticResourceRequest req iworld=:{IWorld|systemDirectories={publicWebDirectories}}
     = serveStaticResource req publicWebDirectories iworld
@@ -281,6 +281,22 @@ where
 	filePath path	= ((replaceSubString "/" {pathSeparator}) o (replaceSubString ".." "")) path
 	mimeType path	= extensionToMimeType (takeExtension path)
 
+simpleHTTPResponse ::
+	(!(String -> Bool),HTTPRequest *IWorld -> (!HTTPResponse,*IWorld))
+	->
+	(!(String -> Bool),!Bool,!(HTTPRequest *IWorld -> (HTTPResponse, Maybe loc,*IWorld))
+							,!(HTTPRequest (Maybe {#Char}) loc *IWorld -> (!Maybe {#Char}, !Bool, loc, !*IWorld))
+							,!(HTTPRequest loc *IWorld -> *IWorld))
+simpleHTTPResponse (pred,responseFun) = (pred,True,initFun,dataFun,lostFun)
+where
+	initFun req env
+		# (rsp,env) = responseFun req env
+		= (rsp,Nothing,env)
+		
+	dataFun _ _ s env = (Nothing,True,s,env)
+	lostFun _ s env = env
+
+
 publish :: String ServiceFormat (HTTPRequest -> Task a) -> PublishedTask | iTask a
 publish url format task = {url = url, task = TaskWrapper task, defaultFormat = format}
 

Server/iTasks/Framework/IWorld.dcl

@@ -12,7 +12,7 @@ from iTasks.Framework.TaskState			import :: TaskListEntry
 from Text.JSON				import :: JSONNode
 from StdFile			import class FileSystem		
 from Data.SharedDataSource		import class registerSDSDependency, class registerSDSChangeDetection, class reportSDSChange, :: CheckRes(..), :: BasicShareId, :: Hash
-from iTasks.Framework.TaskServer	import class HttpServerEnv
+from iTasks.Framework.Task import :: NetTaskState, :: NetTask, :: BackgroundTask
 from Data.SharedDataSource import :: RWShared
 from iTasks.Framework.Shared import :: ReadWriteShared, :: Shared
 
@@ -21,6 +21,7 @@ from Sapl.Linker.LazyLinker import :: LoaderState
 from Sapl.Linker.SaplLinkerShared import :: LineType, :: FuncTypeMap
 from Sapl.Target.Flavour import :: Flavour
 from Sapl.SaplParser import :: ParserState
+from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq
 
 :: *IWorld		=	{ application			:: !String									// The name of the application	
 					, build					:: !String									// The date/time identifier of the application's build
@@ -57,6 +58,7 @@ from Sapl.SaplParser import :: ParserState
 
 					, shutdown				:: !Bool									// Flag that signals the server function to shut down
                     , random                :: [Int]                                    // Infinite random stream
+                    , loop                  :: !*MainLoop                               // The mainloop
 					, world					:: !*World									// The outside world
 
                     //Experimental database connection cache
@@ -71,6 +73,16 @@ from Sapl.SaplParser import :: ParserState
     , publicWebDirectories  :: ![FilePath]                              // List of directories that contain files that are served publicly by the iTask webserver
     }
 
+:: *MainLoop =
+    { done :: !*[MainLoopInstance]
+    , todo :: !*[MainLoopInstance]
+    }
+
+:: *MainLoopInstance
+    = ListenerInstance !Int !*TCP_Listener !NetTask
+    | ConnectionInstance !IPAddress !*TCP_DuplexChannel !NetTask !NetTaskState
+    | BackgroundInstance !BackgroundTask
+
 :: *Resource = Resource | .. //Extensible resource type for caching database connections etc...
 
 updateCurrentDateTime :: !*IWorld -> *IWorld
@@ -96,8 +108,6 @@ getUIMessages		:: !InstanceNo                  !*IWorld -> (![UIMessage],!*IWorl
 
 instance FileSystem IWorld
 
-instance HttpServerEnv IWorld
-
 instance registerSDSDependency		InstanceNo	IWorld
 instance registerSDSChangeDetection				IWorld
 instance reportSDSChange			InstanceNo	IWorld

Server/iTasks/Framework/IWorld.icl

@@ -11,7 +11,7 @@ from iTasks.Framework.UIDiff		import :: UIUpdate
 
 from StdFile import class FileSystem(..)
 from StdFile import instance FileSystem World
-from iTasks.Framework.TaskServer import class HttpServerEnv(..)
+//from iTasks.Framework.TaskServer import class HttpServerEnv(..)
 
 from Data.List import splitWith
 from Data.SharedDataSource	import class registerSDSDependency, class registerSDSChangeDetection, class reportSDSChange, :: CheckRes(..), :: BasicShareId, :: Hash
@@ -130,12 +130,6 @@ where
 		# (ok,file,world) = sfopen filename mode world
 		= (ok,file,{IWorld|iworld & world = world})
 
-instance HttpServerEnv IWorld
-where
-	serverTime iworld=:{IWorld|world}
-		# (ts,world) = time world
-		= (ts,{IWorld|iworld & world = world})
-
 instance registerSDSDependency InstanceNo IWorld
 where
 	registerSDSDependency sdsId instanceNo iworld

Server/iTasks/Framework/Task.dcl

@@ -50,15 +50,28 @@ derive gEq				Task
 					
 //Task representation for web service format
 :: TaskServiceRep	:== [TaskPart]
+:: TaskPart			:== (!String, !JSONNode)		//Task id, value
 
-//Summary of the composition structure of tasks (used as input for layouting)
-:: TaskCompositionType
-	= ViewPart
-	| SingleTask
-	| SequentialComposition
-	| ParallelComposition
 
-:: TaskPart			:== (!String, !JSONNode)		//Task id, value
+//Low level specific tasks that handle network connections
+from Internet.HTTP import :: HTTPRequest
+from iTasks.Framework.Engine import :: ConnectionType
+
+:: NetTask = NetTask !((Maybe String) NetTaskState *IWorld -> *(!Maybe String, !Bool, !NetTaskState, !*IWorld))
+:: BackgroundTask = BackgroundTask !(*IWorld -> *IWorld)
+
+:: NetTaskState
+    = NTIdle String Timestamp
+    | NTReadingRequest NTHttpReqState
+	| NTProcessingRequest HTTPRequest ConnectionType
+
+:: NTHttpReqState =
+    { request       :: HTTPRequest
+    , method_done   :: Bool
+    , headers_done  :: Bool
+    , data_done     :: Bool
+    , error         :: Bool
+    }
 
 /**
 * 'downgrades' an event to a refresh, but keeps the client given event number

Server/iTasks/Framework/TaskServer.dcl

@@ -6,34 +6,15 @@ from TCPIP				import class ChannelEnv, :: IPAddress, :: Timeout
 from Internet.HTTP		import :: HTTPRequest, :: HTTPResponse
 from System.Time				import :: Timestamp
 from iTasks.Framework.IWorld	import :: IWorld
-// Core server
-startServer :: !Int 
-				(IPAddress *env -> (loc,*env)) ((Maybe {#Char}) loc *env -> *(Maybe {#Char},!Bool, !loc, !*env)) (loc *env -> *env)
-				(*env -> (!Maybe Timeout,!*env)) (*env -> (!Bool,!*env)) !*env -> *env | ChannelEnv env
+from iTasks.Framework.Task      import :: NetTask, :: BackgroundTask
+from iTasks.Framework.Engine    import :: ConnectionType
 
-// HTTP Server
-class HttpServerEnv env
-where
-    serverTime :: *env -> (!Timestamp,!*env)
+//Core task server loop
+serve :: !Int !NetTask !BackgroundTask (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
 
-instance HttpServerEnv World
-
-startHTTPServer :: !Int !Int
-						[(!(String -> Bool)
-						 ,!Bool
-						 ,!(HTTPRequest *env -> (!HTTPResponse,!Maybe loc,!*env))
-						 ,!(HTTPRequest (Maybe {#Char}) loc *env -> (!Maybe {#Char}, !Bool, loc, !*env))
-						 ,!(HTTPRequest loc *env -> *env)
-						 )] (*env -> (!Maybe Timeout,!*env)) (*env -> (!Bool,!*env)) !*env -> *env | ChannelEnv env & HttpServerEnv env
-
-// Task Server
-
-// Temporary util
-simpleHTTPResponse ::
-	(!(String -> Bool),HTTPRequest *env -> (!HTTPResponse,*env))
-	->
-	(!(String -> Bool),!Bool,!(HTTPRequest *env -> (HTTPResponse, Maybe loc,*env))
-							,!(HTTPRequest (Maybe {#Char}) loc *env -> (!Maybe {#Char}, !Bool, loc, !*env))
-							,!(HTTPRequest loc *env -> *env))
-
-instance ChannelEnv IWorld
+httpService :: !Int !Int ![(!String -> Bool
+				,!Bool
+				,!(HTTPRequest *IWorld -> (!HTTPResponse,!Maybe ConnectionType, !*IWorld))
+				,!(HTTPRequest (Maybe {#Char}) ConnectionType *IWorld -> (!Maybe {#Char}, !Bool, !ConnectionType, !*IWorld))
+				,!(HTTPRequest ConnectionType *IWorld -> *IWorld)
+				)] -> NetTask

Server/iTasks/Framework/TaskState.icl

@@ -4,7 +4,7 @@ import Text.JSON
 import iTasks.Framework.UIDefinition
 
 from iTasks					import JSONEncode, JSONDecode
-from iTasks.Framework.Task	import :: Event, :: TaskTime, :: TaskResult(..), :: TaskInfo(..), :: TaskRep(..), :: TaskServiceRep, :: TaskPart, :: TaskCompositionType, :: EventNo
+from iTasks.Framework.Task	import :: Event, :: TaskTime, :: TaskResult(..), :: TaskInfo(..), :: TaskRep(..), :: TaskServiceRep, :: TaskPart, :: EventNo
 import iTasks.API.Core.SystemTypes
 
 derive JSONEncode TIMeta, TIType, SessionInfo, TIReduct, TaskTree, TaskListEntry, TaskListEntryState, TaskResult, TaskRep, TaskInfo
@@ -18,7 +18,7 @@ derive JSONEncode UIMenuButtonOpts, UIButtonOpts, UIPanelOpts, UIFieldSetOpts, U
 derive JSONEncode UISize, UIBound, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
 derive JSONEncode UITaskletOpts, UIEditletOpts
 
-derive JSONDecode TaskCompositionType
+//derive JSONDecode TaskCompositionType
 derive JSONDecode UIDef, UIAction, UIViewport, UIWindow, UIControl, UIFSizeOpts, UISizeOpts, UIHSizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
 derive JSONDecode UIControlStack, UISubUI, UISubUIStack
 derive JSONDecode UIProgressOpts, UISliderOpts, UIGridOpts, UITreeOpts, UIIconOpts, UILabelOpts, UITreeNode

Server/iTasks/Framework/TaskStore.icl

@@ -10,7 +10,7 @@ from Data.SharedDataSource import qualified read, write, mapReadWriteError
 import iTasks.Framework.SerializationGraphCopy //TODO: Make switchable from within iTasks module
 
 //Derives required for storage of UI definitions
-derive JSONEncode TaskResult, TaskInfo, TaskRep, TaskCompositionType
+derive JSONEncode TaskResult, TaskInfo, TaskRep
 derive JSONEncode UIDef, UIAction, UIViewport, UIWindow, UIControl, UIFSizeOpts, UISizeOpts, UIHSizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
 derive JSONEncode UIProgressOpts, UISliderOpts, UIGridOpts, UITreeOpts, UIIconOpts, UILabelOpts, UITreeNode
 derive JSONEncode UIControlStack, UISubUI, UISubUIStack
@@ -18,7 +18,7 @@ derive JSONEncode UIMenuButtonOpts, UIButtonOpts, UIPanelOpts, UIFieldSetOpts, U
 derive JSONEncode UISize, UIBound, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
 derive JSONEncode UITaskletOpts, UIEditletOpts
 
-derive JSONDecode TaskResult, TaskInfo, TaskRep, TaskCompositionType
+derive JSONDecode TaskResult, TaskInfo, TaskRep
 derive JSONDecode UIDef, UIAction, UIViewport, UIWindow, UIControl, UIFSizeOpts, UISizeOpts, UIHSizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
 derive JSONDecode UIProgressOpts, UISliderOpts, UIGridOpts, UITreeOpts, UIIconOpts, UILabelOpts, UITreeNode
 derive JSONDecode UIControlStack, UISubUI, UISubUIStack