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

Commit 3ed29460 authored by Steffen Michels's avatar Steffen Michels

started to separate whileConnected handler into onData & onShareChange handlers

parent 039821fc
......@@ -719,12 +719,13 @@ externalProcessExample =
forever (enterInformation "Enter data to send to StdIn" [] >>= \data -> set (Just (data +++ "\n")) sds)
)
where
handlers = { onStartup = \_ -> (Ok "", Nothing, [], False)
, whileRunning = whileRunning
, onExit = \_ l _ -> (Ok l, Nothing)
handlers = { onStartup = \ _ -> (Ok "", Nothing, [], False)
, onOutData = onData
, onErrData = onData
, onShareChange = \ l _ -> (Ok l, Nothing, [], False)
, onExit = \_ l _ -> (Ok l, Nothing)
}
whileRunning (Just (_, data)) l mbOutput = (Ok (l +++ data +++ "\n"), Just Nothing, maybeToList mbOutput, False)
whileRunning Nothing l mbOutput = (Ok l, Just Nothing, maybeToList mbOutput, False)
onData data l mbOutput = (Ok (l +++ data +++ "\n"), Just Nothing, maybeToList mbOutput, False)
//* Customizing interaction with views
......
......@@ -113,7 +113,7 @@ where
callHTTP :: !HTTPMethod !URI !String !(HTTPResponse -> (MaybeErrorString a)) -> Task a | iTask a
callHTTP method url=:{URI|uriScheme,uriRegName=Just uriRegName,uriPort,uriPath,uriQuery,uriFragment} data parseFun
= tcpconnect uriRegName port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect}
= tcpconnect uriRegName port (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
@? taskResult
where
port = fromMaybe 80 uriPort
......@@ -123,11 +123,10 @@ where
onConnect _ _
= (Ok (Left []),Nothing,[req],False)
whileConnected (Just data) (Left acc) _
onData data (Left acc) _
= (Ok (Left (acc ++ [data])),Nothing,[],False)
whileConnected Nothing acc _
onShareChange acc _
= (Ok acc,Nothing,[],False)
onDisconnect (Left acc) _
= case parseResponse (concat acc) of
Nothing = (Error "Invalid response",Nothing)
......
......@@ -186,7 +186,7 @@ background iworld
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)) (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !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
......
......@@ -16,7 +16,7 @@ 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)) (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !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))
)
......
......@@ -26,7 +26,7 @@ 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)) (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !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))
)
......@@ -75,8 +75,8 @@ where
plainResponse string
= {okResponse & rsp_headers = [("Content-Type","text/plain")], rsp_data = string}
dataFun :: !HTTPRequest (Map InstanceNo (Queue UIChange)) !(Maybe {#Char}) !ConnectionState !*IWorld -> (![{#Char}], !Bool, !ConnectionState,!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld)
dataFun req _ mbData instanceNo iworld = ([], True, instanceNo, Nothing, iworld)
dataFun :: !HTTPRequest (Map InstanceNo (Queue UIChange)) !String !ConnectionState !*IWorld -> (![{#Char}], !Bool, !ConnectionState,!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld)
dataFun req _ data instanceNo iworld = ([], True, instanceNo, Nothing, iworld)
disconnectFun :: !HTTPRequest (Map InstanceNo (Queue UIChange)) !ConnectionState !*IWorld -> (!Maybe (Map InstanceNo (Queue UIChange)), !*IWorld)
disconnectFun _ _ _ iworld = (Nothing,iworld)
......
......@@ -67,27 +67,31 @@ defaultTonicOpts :: TonicOpts
//Definition of low-level network interaction
:: ConnectionHandlers l r w =
{ onConnect :: !(String r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, whileConnected :: !((Maybe String) l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, onDisconnect :: !( l r -> (!MaybeErrorString l, Maybe w ))
{ onConnect :: !(String r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, onData :: !(String l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, onShareChange :: !( l r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, onDisconnect :: !( l r -> (!MaybeErrorString l, Maybe w ))
}
//Version of connection handlers with IWorld side-effects that is still necessary for built-in framework handlers
:: ConnectionHandlersIWorld l r w =
{ onConnect :: !(String r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, whileConnected :: !((Maybe String) l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onDisconnect :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, !*IWorld))
{ onConnect :: !(String r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onData :: !(String l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onShareChange :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onTick :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onDisconnect :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, !*IWorld))
}
//Low-level task that handles external processes
:: ExternalProcessTask = ExternalProcessTask !(ExternalProcessHandlers Dynamic Dynamic Dynamic) !(RWShared () Dynamic Dynamic)
:: ProcessOutChannel = StdOut | StdErr
:: ExitCode = ExitCode !Int
:: ExternalProcessHandlers l r w =
{ onStartup :: !( r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, whileRunning :: !((Maybe (!ProcessOutChannel, !String)) l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
{ onStartup :: !( r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onOutData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onErrData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onShareChange :: !( l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
}
//Background computation tasks
......
......@@ -78,74 +78,77 @@ extendCallTrace taskId repOpts=:{TaskEvalOpts|tonicOpts = {callTrace = xs}}
_ = {repOpts & tonicOpts = {repOpts.tonicOpts & callTrace = 'DCS'.push taskId repOpts.tonicOpts.callTrace}}
wrapConnectionTask :: (ConnectionHandlers l r w) (RWShared () r w) -> ConnectionTask | TC l & TC r & TC w
wrapConnectionTask {ConnectionHandlers|onConnect,whileConnected,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,whileConnected=whileConnected`,onDisconnect=onDisconnect`} (toDynamic sds)
wrapConnectionTask {ConnectionHandlers|onConnect,onData,onShareChange,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
where
onConnect` host (r :: r^) env = case onConnect host r of
(Ok l, mbw, out, close) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), out, close, env)
Nothing = (Ok (dynamic l :: l^), Nothing, out, close, env)
(Error e, mbw, out, close) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), out, close, env)
Nothing = (Error e, Nothing, out, close, env)
whileConnected` mbIn (l :: l^) (r :: r^) env = case whileConnected mbIn l r of
(Ok l, mbw, out, close) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), out, close, env)
Nothing = (Ok (dynamic l :: l^), Nothing, out, close, env)
(Error e, mbw, out, close) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), out, close, env)
Nothing = (Error e, Nothing, out, close, env)
onDisconnect` (l :: l^) (r :: r^) env = case onDisconnect l r of
(Ok l, mbw) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), env)
Nothing = (Ok (dynamic l :: l^), Nothing, env)
(Error e, mbw) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), env)
Nothing = (Error e, Nothing, env)
onConnect` host (r :: r^) env
# (mbl, mbw, out, close) = onConnect host r
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onData` data (l :: l^) (r :: r^) env
# (mbl, mbw, out, close) = onData data l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onShareChange` (l :: l^) (r :: r^) env
# (mbl, mbw, out, close) = onShareChange l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
// do nothing
onTick` l _ env
= (Ok l, Nothing, [], False, env)
onDisconnect` (l :: l^) (r :: r^) env
# (mbl, mbw) = onDisconnect l r
= (toDyn <$> mbl, toDyn <$> mbw, env)
wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (RWShared () r w) -> ConnectionTask | TC l & TC r & TC w
wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,whileConnected,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,whileConnected=whileConnected`,onDisconnect=onDisconnect`} (toDynamic sds)
wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,onData,onShareChange,onTick,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
where
onConnect` host (r :: r^) env = case onConnect host r env of
(Ok l, mbw, out, close, env) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), out, close, env)
Nothing = (Ok (dynamic l :: l^), Nothing, out, close, env)
(Error e, mbw, out, close, env) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), out, close, env)
Nothing = (Error e, Nothing, out, close, env)
whileConnected` mbIn (l :: l^) (r :: r^) env = case whileConnected mbIn l r env of
(Ok l, mbw, out, close, env) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), out, close, env)
Nothing = (Ok (dynamic l :: l^), Nothing, out, close, env)
(Error e, mbw, out, close, env) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), out, close, env)
Nothing = (Error e, Nothing, out, close, env)
onDisconnect` (l :: l^) (r :: r^) env = case onDisconnect l r env of
(Ok l, mbw, env) = case mbw of
Just w = (Ok (dynamic l :: l^), Just (dynamic w :: w^), env)
Nothing = (Ok (dynamic l :: l^), Nothing, env)
(Error e, mbw, env) = case mbw of
Just w = (Error e, Just (dynamic w :: w^), env)
Nothing = (Error e, Nothing, env)
onConnect` host (r :: r^) env
# (mbl, mbw, out, close, env) = onConnect host r env
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onData` data (l :: l^) (r :: r^) env
# (mbl, mbw, out, close, env) = onData data l r env
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onShareChange` (l :: l^) (r :: r^) env
# (mbl, mbw, out, close, env) = onShareChange l r env
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onTick` (l :: l^) (r :: r^) env
# (mbl, mbw, out, close, env) = onTick l r env
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onDisconnect` (l :: l^) (r :: r^) env
# (mbl, mbw, env) = onDisconnect l r env
= (toDyn <$> mbl, toDyn <$> mbw, env)
wrapExternalProcTask :: !(ExternalProcessHandlers l r w) !(RWShared () r w) -> ExternalProcessTask | TC l & TC r & TC w & iTask l
wrapExternalProcTask {onStartup, whileRunning, onExit} sds
= ExternalProcessTask {onStartup = onStartup`, whileRunning = whileRunning`, onExit = onExit`} (toDynamic sds)
wrapExternalProcTask {onStartup, onOutData, onErrData, onShareChange, onExit} sds = ExternalProcessTask
{onStartup = onStartup`, onOutData = onOutData`, onErrData = onErrData`, onShareChange = onShareChange`, onExit = onExit`}
(toDynamic sds)
where
onStartup` (r :: r^) = (toDyn <$> mbl, toDyn <$> mbw, out, close)
where
(mbl, mbw, out, close) = onStartup r
whileRunning` mbData (l :: l^) (r :: r^) = (toDyn <$> mbl, toDyn <$> mbw, out, close)
where
(mbl, mbw, out, close) = whileRunning mbData l r
onExit` eCode (l :: l^) (r :: r^) = (toDyn <$> mbl, toDyn <$> mbw)
where
(mbl, mbw) = onExit eCode l r
onStartup` (r :: r^)
# (mbl, mbw, out, close) = onStartup r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onOutData` data (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onOutData data l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onErrData` data (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onErrData data l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onShareChange` (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onShareChange l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onExit` eCode (l :: l^) (r :: r^)
# (mbl, mbw) = onExit eCode l r
= (toDyn <$> mbl, toDyn <$> mbw)
mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
mkInstantTask iworldfun = Task (evalOnce iworldfun)
......
This diff is collapsed.
......@@ -301,9 +301,10 @@ acceptAndViewTonicTraces
acceptTonicTraces :: !(Shared TMessageStore) -> Task [ServerState]
acceptTonicTraces tonicShare
= tcplisten 9000 True tonicShare { ConnectionHandlers
| onConnect = onConnect
, whileConnected = whileConnected
, onDisconnect = onDisconnect
| onConnect = onConnect
, onData = undef
, onShareChange = undef
, onDisconnect = onDisconnect
}
where
onConnect :: String TMessageStore
......
......@@ -29,12 +29,12 @@ 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 (Maybe {#Char}) 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 ![ (!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
:: ChangeQueues :== Map InstanceNo (Queue UIChange)
......@@ -43,7 +43,7 @@ taskUIService :: ![PublishedTask] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest ChangeQueues *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues String ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues ConnectionState *IWorld -> (!Maybe ChangeQueues, !*IWorld))
)
......@@ -51,7 +51,7 @@ documentService ::
(!(String -> Bool)
,!Bool
,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r (Maybe {#Char}) loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld))
)
......@@ -59,7 +59,7 @@ staticResourceService :: [String] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r (Maybe {#Char}) loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r String loc *IWorld -> (![{#Char}], !Bool, loc, Maybe w ,!*IWorld))
,!(HTTPRequest r loc *IWorld -> (!Maybe w,!*IWorld))
)
......@@ -130,30 +130,28 @@ 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 (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld))
,!(HTTPRequest r ConnectionState *IWorld -> (!Maybe w, !*IWorld))
)] (RWShared () r w) -> ConnectionTask | TC r & TC w
,!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 port keepAliveTime requestProcessHandlers sds
= wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, whileConnected=whileConnected, 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})
whileConnected mbData connState=:(NTProcessingRequest request localState) r env
//Select handler based on request path
= case selectHandler request requestProcessHandlers of
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 mbData localState env
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = handler 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
= (Ok (NTProcessingRequest request localState), mbW, mbData,done,{IWorld|env & world = world})
Nothing
= (Ok connState, Nothing, ["HTTP/1.1 400 Bad Request\r\n\r\n"], True, env)
whileConnected (Just data) connState r iworld=:{IWorld|clocks}//(connState is either Idle or ReadingRequest)
onData data connState r iworld=:{IWorld|clocks}//(connState is either Idle or ReadingRequest)
# rstate = case connState of
(NTIdle client_name _)
//Add new data to the request
......@@ -200,11 +198,14 @@ where
= (Ok (NTReadingRequest rstate), Nothing, [], False, iworld)
//Close idle connections if the keepalive time has passed
whileConnected Nothing connState=:(NTIdle ip (Timestamp t)) r iworld=:{IWorld|clocks={timestamp=Timestamp now}}
onTick connState=:(NTIdle ip (Timestamp t)) r iworld=:{IWorld|clocks={timestamp=Timestamp now}}
= (Ok connState, Nothing, [], now >= t + keepAliveTime, iworld)
//Do nothing if no data arrives for now
whileConnected Nothing connState r iworld = (Ok connState,Nothing,[],False,iworld)
onTick connState r iworld = (Ok connState,Nothing,[],False,iworld)
// TODO: add corresponding handler to 'httpServer'
onShareChange connState _ iworld = (Ok connState,Nothing,[],False,iworld)
//If we were processing a request and were interupted we need to
//select the appropriate handler to wrap up
......@@ -241,7 +242,7 @@ taskUIService :: ![PublishedTask] ->
(!(String -> Bool)
,!Bool
,!(HTTPRequest ChangeQueues *IWorld -> (!HTTPResponse,!Maybe ConnectionState, !Maybe ChangeQueues, !*IWorld))
,!(HTTPRequest ChangeQueues (Maybe {#Char}) ConnectionState *IWorld -> (![{#Char}], !Bool, !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)
......@@ -267,7 +268,7 @@ where
| otherwise
= (errorResponse "Requested service format not available for this task", Nothing, Nothing, iworld)
dataFun req output (Just data) (state,instances) iworld
dataFun req output data (state,instances) iworld
# (state,result) = wsockAddData state data
= case result of //TODO: Process multiple events
[WSClose msg:_]
......@@ -308,7 +309,7 @@ where
= ([wsockPongMsg msg],False,(state,instances),Nothing,iworld)
_ = ([],False,(state,instances),Nothing,iworld)
dataFun req output Nothing (state,instances) iworld
/*dataFun req output Nothing (state,instances) iworld
//Check for UI updates for all attached instances
# (changes, output) = dequeueOutput instances output
= case changes of //Ignore empty updates
......@@ -317,7 +318,7 @@ where
# (_,iworld) = updateInstanceLastIO instances iworld
# msgs = [wsockTextMsg (toString (JSONObject [("instance",JSONInt instanceNo)
,("change",encodeUIChange change)])) \\ (instanceNo,change) <- changes]
= (flatten msgs,False, (state,instances),Just output,iworld)
= (flatten msgs,False, (state,instances),Just output,iworld)*/
disconnectFun _ _ (state,instances) iworld = (Nothing, snd (updateInstanceDisconnect instances iworld))
disconnectFun _ _ _ iworld = (Nothing, iworld)
......@@ -354,7 +355,7 @@ where
// unauthorized downloading of documents and DDOS uploading.
documentService :: (!(String -> Bool),!Bool,!(HTTPRequest r *IWorld -> (HTTPResponse, Maybe loc, Maybe w ,*IWorld))
,!(HTTPRequest r (Maybe {#Char}) loc *IWorld -> (![{#Char}], !Bool, 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)
where
......@@ -401,7 +402,7 @@ jsonResponse json
// 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 (Maybe {#Char}) loc *IWorld -> (![{#Char}], !Bool, 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)
where
......
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