We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit d149b632 authored by Steffen Michels's avatar Steffen Michels

introduced WebService type as replament for tuple with handlers

parent 274b30f6
......@@ -183,13 +183,7 @@ background iworld
= iworld
// The iTasks engine consist of a set of HTTP WebService
engine :: publish -> [(!String -> Bool
,!Bool
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) ConnectionState *IWorld -> (!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
)] | Publishable publish
engine :: publish -> [WebService (Map InstanceNo (Queue UIChange)) (Map InstanceNo (Queue UIChange))] | Publishable publish
engine publishable = [taskUIService published, documentService, sdsService, staticResourceService [url \\ {PublishedTask|url} <- published]]
where
published = publishAll publishable
......
......@@ -2,7 +2,7 @@ definition module iTasks._Framework.SDSService
from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from iTasks._Framework.IWorld import :: IWorld
from iTasks._Framework.WebService import :: ConnectionState, :: WebSockState
from iTasks._Framework.WebService import :: ConnectionState, :: WebSockState, :: WebService
from iTasks._Framework.SDS import :: RWShared
from iTasks._Framework.Task import :: Task, :: InstanceNo
from iTasks._Framework.TaskState import :: TIUIState
......@@ -13,12 +13,7 @@ import iTasks._Framework.Generic
import Data.Maybe, Data.Error, Text.JSON
sdsService :: (!(String -> Bool)
,!Bool
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) *IWorld -> *(!HTTPResponse, !Maybe ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) ConnectionState *IWorld -> (!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
)
sdsService :: WebService (Map InstanceNo (Queue UIChange)) (Map InstanceNo (Queue UIChange))
readRemoteSDS :: !JSONNode !String !*IWorld -> *(!MaybeErrorString JSONNode, !*IWorld)
writeRemoteSDS :: !JSONNode !JSONNode !String !*IWorld -> *(!MaybeErrorString (), !*IWorld)
......
......@@ -4,7 +4,7 @@ import iTasks
from Internet.HTTP import :: HTTPRequest {req_method, req_path, req_data}, :: HTTPResponse(..), :: HTTPMethod(..)
from iTasks._Framework.IWorld import :: IWorld {exposedShares}
from iTasks._Framework.WebService import :: ConnectionState, :: WebSockState
from iTasks._Framework.WebService import :: ConnectionState, :: WebSockState, :: WebService(..)
from iTasks._Framework.TaskState import :: TIUIState
import iTasks._Framework.HtmlUtil, iTasks._Framework.DynamicUtil
......@@ -23,14 +23,13 @@ import Text.URI
import StdMisc, graph_to_sapl_string
import Data.Queue
sdsService :: (!(String -> Bool)
,!Bool
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) *IWorld -> *(!HTTPResponse, !Maybe ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
,!(HTTPRequest (Map InstanceNo (Queue UIChange)) ConnectionState *IWorld -> (!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld))
)
sdsService = (matchFun,True,reqFun,dataFun,disconnectFun)
sdsService :: WebService (Map InstanceNo (Queue UIChange)) (Map InstanceNo (Queue UIChange))
sdsService = { urlMatchPred = matchFun
, completeRequest = True
, onNewReq = reqFun
, onData = dataFun
, onDisconnect = disconnectFun
}
where
matchFun :: String -> Bool
matchFun reqUrl = case pathToSegments reqUrl of
......
......@@ -29,37 +29,19 @@ import iTasks._Framework.Generic
| WSClose String //A close frame was received
| WSPing String //A ping frame was received
httpServer :: !Int !Int ![ (!String -> Bool
,!Bool
,!(HTTPRequest r *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe w, !*IWorld))
,!(HTTPRequest r String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld))
,!(HTTPRequest r ConnectionState *IWorld -> (!Maybe w, !*IWorld))
)] (RWShared () r w) -> ConnectionTask | TC r & TC w
:: WebService r w =
{ urlMatchPred :: !(String -> Bool) // checks whether the URL is served by this service
, completeRequest :: !Bool // wait for complete request before start serving request
, onNewReq :: !(HTTPRequest r *IWorld-> *(!HTTPResponse,!Maybe ConnectionState, !Maybe w, !*IWorld)) // is called for each new request
, onData :: !(HTTPRequest r String ConnectionState *IWorld -> *(![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld)) // on new data from client
, onDisconnect :: !(HTTPRequest r ConnectionState *IWorld -> *(!Maybe w, !*IWorld)) // is called on disconnect
}
httpServer :: !Int !Int ![WebService r w] (RWShared () r w) -> ConnectionTask | TC r & TC w
:: ChangeQueues :== Map InstanceNo (Queue UIChange)
taskUIService :: ![PublishedTask] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest ChangeQueues *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues ConnectionState *IWorld -> (!Maybe ChangeQueues, !*IWorld))
)
documentService ::
(!(String -> Bool)
,!Bool
,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld))
)
staticResourceService :: [String] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld))
)
taskUIService :: ![PublishedTask] -> WebService ChangeQueues ChangeQueues
documentService :: WebService r w
staticResourceService :: [String] -> WebService r w
......@@ -129,22 +129,17 @@ where
wsockTextMsg :: String -> [String]
wsockTextMsg payload = [wsockMsgFrame WS_OP_TEXT True payload]
httpServer :: !Int !Int ![(!String -> Bool
,!Bool
,!(HTTPRequest r *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe w, !*IWorld))
,!(HTTPRequest r String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld))
,!(HTTPRequest r ConnectionState *IWorld -> (!Maybe w, !*IWorld))
)] (RWShared () r w) -> ConnectionTask | TC r & TC w
httpServer :: !Int !Int ![WebService r w] (RWShared () r w) -> ConnectionTask | TC r & TC w
httpServer port keepAliveTime requestProcessHandlers sds
= wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect} sds
= wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect} sds
where
onConnect host r iworld=:{IWorld|world,clocks}
= (Ok (NTIdle host clocks.timestamp),Nothing,[],False,{IWorld|iworld & world = world})
onData data connState=:(NTProcessingRequest request localState) r env
= case selectHandler request requestProcessHandlers of
Just (_,_,_,handler,_)
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = handler request r data localState env
Just {WebService | onData}
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = onData request r data localState env
| done && isKeepAlive request //Don't close the connection if we are done, but keepalive is enabled
= (Ok (NTIdle request.client_name clocks.timestamp), mbW, mbData, False,{IWorld|env & world = world})
| otherwise
......@@ -174,14 +169,14 @@ where
= case selectHandler rstate.HttpReqState.request requestProcessHandlers of
Nothing
= (Ok connState, Nothing, ["HTTP/1.1 404 Not Found\r\n\r\n"], True, iworld)
Just (_,completeRequest,newReqHandler,procReqHandler,_)
Just {completeRequest, onNewReq}
//Process a completed request, or as soon as the headers are done if the handler indicates so
| rstate.HttpReqState.data_done || (not completeRequest)
# request = if completeRequest (http_parseArguments rstate.HttpReqState.request) rstate.HttpReqState.request
//Determine if a persistent connection was requested
# keepalive = isKeepAlive request
// Create a response
# (response,mbLocalState,mbW,iworld) = newReqHandler request r iworld
# (response,mbLocalState,mbW,iworld) = onNewReq request r iworld
//Add keep alive header if necessary
# response = if keepalive {HTTPResponse|response & rsp_headers = [("Connection","Keep-Alive"):response.HTTPResponse.rsp_headers]} response
// Encode the response to the HTTP protocol format
......@@ -212,16 +207,16 @@ where
onDisconnect connState=:(NTProcessingRequest request localState) r env
= case selectHandler request requestProcessHandlers of
Nothing = (Ok connState, Nothing, env)
Just (_,_,_,_,connLostHandler)
# (mbW, env) = connLostHandler request r localState env
Nothing = (Ok connState, Nothing, env)
Just {WebService | onDisconnect}
# (mbW, env) = onDisconnect request r localState env
= (Ok connState, mbW, env)
onDisconnect connState r env = (Ok connState, Nothing, env)
selectHandler req [] = Nothing
selectHandler req [h=:(pred,_,_,_,_):hs]
| pred req.HTTPRequest.req_path = Just h
= selectHandler req hs
selectHandler req [h:hs]
| h.urlMatchPred req.HTTPRequest.req_path = Just h
= selectHandler req hs
isKeepAlive request = maybe (request.HTTPRequest.req_version == "HTTP/1.1") (\h -> (toLowerCase h == "keep-alive")) ('DM'.get "Connection" request.HTTPRequest.req_headers)
......@@ -238,14 +233,13 @@ where
:: ChangeQueues :== Map InstanceNo (Queue UIChange)
taskUIService :: ![PublishedTask] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest ChangeQueues *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues ConnectionState *IWorld -> (!Maybe ChangeQueues, !*IWorld))
)
taskUIService taskUrls = (matchFun [url \\ {PublishedTask|url} <-taskUrls],True,reqFun` taskUrls,dataFun,disconnectFun)
taskUIService :: ![PublishedTask] -> WebService ChangeQueues ChangeQueues
taskUIService taskUrls = { urlMatchPred = matchFun [url \\ {PublishedTask|url} <-taskUrls]
, completeRequest = True
, onNewReq = reqFun` taskUrls
, onData = dataFun
, onDisconnect = disconnectFun
}
where
matchFun :: [String] String -> Bool
matchFun matchUrls reqUrl = or [reqUrl == uiUrl matchUrl \\ matchUrl <- matchUrls]
......@@ -359,10 +353,13 @@ where
// A smarter scheme that checks up and downloads, based on the current session/task is needed to prevent
// unauthorized downloading of documents and DDOS uploading.
documentService :: (!(String -> Bool),!Bool,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld)))
documentService = (matchFun,True,reqFun,dataFun,lostFun)
documentService :: WebService r w
documentService = { urlMatchPred = matchFun
, completeRequest = True
, onNewReq = reqFun
, onData = dataFun
, onDisconnect = lostFun
}
where
matchFun path = case dropWhile ((==)"") (split "/" path) of
["upload"] = True // Upload of documents
......@@ -406,10 +403,13 @@ jsonResponse json
// 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...
staticResourceService :: [String] -> (!(String -> Bool),!Bool,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld)))
staticResourceService taskPaths = (const True,True,initFun,dataFun,lostFun)
staticResourceService :: [String] -> WebService r w
staticResourceService taskPaths = { urlMatchPred = const True
, completeRequest = True
, onNewReq = initFun
, onData = dataFun
, onDisconnect = lostFun
}
where
initFun req _ env
# (rsp,env) = handleStaticResourceRequest req env
......
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