Commit 4b6d86d7 authored by Bas Lijnse's avatar Bas Lijnse

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
parent 65c31fa4
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
This diff is collapsed.
......@@ -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
......
......@@ -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
......
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