Commit e204a6c4 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'onDestroy-io' into 'master'

Add ondestroy handler for tcp connections

See merge request !240
parents 8d5dfc3f 7fec2334
Pipeline #20529 passed with stage
in 4 minutes and 44 seconds
......@@ -212,7 +212,7 @@ where
syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared sds ([m],Bool,[m],Bool)) -> Task () | iTask m & RWShared sds
syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
= tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect} @! ()
= tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])} @! ()
where
onConnect _ _ (received,receiveStopped,send,sendStopped)
= (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
......
......@@ -15,6 +15,7 @@ deviceRequest request close
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy= \s->(Ok s, [])
}
>>= \{DeviceRequestState|result} -> return result
where
......
......@@ -38,6 +38,7 @@ authServer port = tcplisten port True authServerShare {ConnectionHandlers
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy = \s->(Ok s, [])
} -|| (process authServerShare) @! ()
where
onConnect :: ConnectionId String AuthShare -> (MaybeErrorString AuthServerState, Maybe AuthShare, [String], Bool)
......@@ -134,6 +135,7 @@ where
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy = \s->(Ok s, [])
}) @? taskResult)
>>- \(resps,_) -> case resps of
[resp:_] -> return (fromJSON (fromString (base64Decode resp)))
......
......@@ -4,7 +4,7 @@ import Text
sendEmail :: ![EmailOpt] !String !String !String !String -> Task ()
sendEmail opts subject body sender recipient
= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect}
= tcpconnect server port (constShare ()) {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
@! ()
where
server = getServerOpt opts
......
......@@ -62,7 +62,7 @@ serveWebService port handler
where
manageConnections io
= tcplisten port False (currentTimespec |*< io)
{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
onConnect connId client_name (now,io)
= (Ok (Idle client_name now), Nothing, [], False)
......@@ -185,7 +185,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,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
= tcpconnect uriRegName port (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
@? taskResult
where
port = fromMaybe 80 uriPort
......
......@@ -31,6 +31,8 @@ onData data (Left acc) _ = (Ok (Left (acc ++ [data])), Nothing, [], False)
onShareChange acc _ = (Ok acc, Nothing, [], False)
onDestroy s = (Ok s, [])
queueSDSRequest :: !(SDSRequest p r w) !String !Int !TaskId !{#Symbol} !*IWorld -> (!MaybeError TaskException ConnectionId, !*IWorld) | TC r
queueSDSRequest req host port taskId symbols iworld
= case addConnection taskId host port connectionTask iworld of
......@@ -43,7 +45,8 @@ where
handlers _ = {ConnectionHandlers| onConnect = onConnect req,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy = onDestroy}
onDisconnect (Left acc) _
# textResponse = concat acc
......@@ -61,7 +64,8 @@ where
handlers _ = {ConnectionHandlers| onConnect = onConnect req,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy=onDestroy}
onDisconnect (Left acc) _
# textResponse = concat acc
......@@ -79,7 +83,8 @@ where
handlers req = {ConnectionHandlers| onConnect = onConnect req,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy = onDestroy}
onDisconnect (Left acc) _
# textResponse = concat acc
......@@ -98,7 +103,8 @@ where
handlers req = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy = onDestroy}
onConnect _ _ _
# req = createRequest p
......@@ -127,7 +133,8 @@ where
handlers = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy = onDestroy}
onConnect connId _ _ = (Ok (Nothing, []), Nothing, [createMessage p +++ "\n"], False)
......@@ -160,6 +167,7 @@ where
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy = onDestroy
}
onConnect connId _ _
# req = toWriteRequest p w
......@@ -191,7 +199,8 @@ where
handlers = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onDisconnect = onDisconnect,
onDestroy = onDestroy}
onConnect connId _ _ = (Ok (Left ""), Nothing, [toWriteMessage p w +++ "\n"], False)
......
......@@ -88,6 +88,7 @@ instanceServer port domain = tcplisten port True instanceServerShared {Connectio
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy= \s->(Ok s, [])
} -|| (instanceClient` "127.0.0.1" port domain True) -|| (process instanceServerShared) @! ()
where
onConnect :: ConnectionId String InstanceServerShare -> (MaybeErrorString InstanceServerState, Maybe InstanceServerShare, [String], Bool)
......@@ -472,6 +473,7 @@ where
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy = \s->(Ok s, [])
} @! Nothing)
-||- (viewInformation () [] () >>* [OnAction (Action "reset") (always (return Nothing))])
......
......@@ -66,6 +66,7 @@ where
, onShareChange = onShareChange
, onTick = onTick
, onDisconnect = onDisconnect
, onDestroy = \s iw->(Ok s, [], iw)
}
reevaluateShares :: !{#Symbol} !TaskId ![(ConnectionId, (Bool, String, String))] *IWorld -> (MaybeErrorString [(ConnectionId, (Bool, String, String))], *IWorld)
......
......@@ -34,6 +34,7 @@ derive gEq Task
, 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))
, onDestroy :: !( l *IWorld -> *(!MaybeErrorString l, ![String], !*IWorld))
}
/**
......
......@@ -45,8 +45,8 @@ where
error = "Creating default task functions is impossible"
wrapConnectionTask :: (ConnectionHandlers l r w) (sds () r w) -> ConnectionTask | TC l & TC r & TC w & RWShared sds
wrapConnectionTask ch=:{ConnectionHandlers|onConnect,onData,onShareChange,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
wrapConnectionTask ch=:{ConnectionHandlers|onConnect,onData,onShareChange,onDisconnect,onDestroy} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`,onDestroy=onDestroy`} (toDynamic sds)
where
onConnect` connId host (r :: r^) env
# (mbl, mbw, out, close) = onConnect connId host r
......@@ -71,10 +71,14 @@ where
# (mbl, mbw) = onDisconnect l r
= (toDyn <$> mbl, toDyn <$> mbw, env)
onDisconnect` l r env = abort ("onDisconnect does not match with type l=" +++ toString (typeCodeOfDynamic l) +++ ", r=" +++ toString (typeCodeOfDynamic r))
onDestroy` (l :: l^) env
# (mbl, out) = onDestroy l
= (toDyn <$> mbl, out, env)
onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> ConnectionTask | TC l & TC r & TC w & RWShared sds
wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,onData,onShareChange,onTick,onDisconnect} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`} (toDynamic sds)
wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect,onData,onShareChange,onTick,onDisconnect,onDestroy} sds
= ConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect`,onData=onData`,onShareChange=onShareChange`,onTick=onTick`,onDisconnect=onDisconnect`,onDestroy=onDestroy`} (toDynamic sds)
where
onConnect` connId host (r :: r^) env
# (mbl, mbw, out, close, env) = onConnect connId host r env
......@@ -102,6 +106,10 @@ where
# (mbl, mbw, env) = onDisconnect l r env
= (toDyn <$> mbl, toDyn <$> mbw, env)
onDisconnect` l r env = abort ("onDisconnect does not match with type l=" +++ toString (typeCodeOfDynamic l) +++ ", r=" +++ toString (typeCodeOfDynamic r))
onDestroy` (l :: l^) env
# (mbl, out, env) = onDestroy l env
= (toDyn <$> mbl, out, env)
onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
mkInstantTask iworldfun = Task (evalOnce iworldfun)
......
......@@ -226,13 +226,16 @@ process i chList iworld=:{ioTasks={done, todo=[ConnectionInstance opts duplexCha
# iworld = processIOTask
i chList opts.ConnectionInstanceOpts.taskId opts.ConnectionInstanceOpts.connectionId
opts.ConnectionInstanceOpts.removeOnClose sds tcpConnectionIOOps
(\_ -> handlers.ConnectionHandlersIWorld.onDisconnect) handlers.ConnectionHandlersIWorld.onData
handlers.ConnectionHandlersIWorld.onShareChange handlers.ConnectionHandlersIWorld.onTick (ConnectionInstance opts) duplexChannel iworld
(\_ -> handlers.ConnectionHandlersIWorld.onDisconnect)
handlers.ConnectionHandlersIWorld.onData
handlers.ConnectionHandlersIWorld.onShareChange
handlers.ConnectionHandlersIWorld.onTick
handlers.ConnectionHandlersIWorld.onDestroy
(ConnectionInstance opts) duplexChannel iworld
= process (i+1) chList iworld
where
(ConnectionTask handlers sds) = opts.ConnectionInstanceOpts.connectionTask
process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
= (process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}})
......@@ -286,15 +289,16 @@ processIOTask :: !Int
!(readData Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic *IWorld -> (!MaybeErrorString Dynamic, ![String], !*IWorld))
!(.ioChannels -> *IOTaskInstance)
!.ioChannels
!*IWorld
-> *IWorld
processIOTask i chList taskId connectionId removeOnClose sds ioOps onCloseHandler onDataHandler
onShareChangeHandler onTickHandler mkIOTaskInstance ioChannels iworld=:{ioStates}
onShareChangeHandler onTickHandler onDestroyHandler mkIOTaskInstance ioChannels iworld=:{ioStates}
# (TaskId instanceNo _) = taskId
= case get taskId ioStates of
Just (IOActive taskStates)
# (TaskId instanceNo _) = taskId
// get task state
# mbTaskState = get connectionId taskStates
| isNothing mbTaskState
......@@ -377,6 +381,18 @@ processIOTask i chList taskId connectionId removeOnClose sds ioOps onCloseHandle
# {done, todo} = iworld.ioTasks
= {iworld & ioStates = ioStates, ioTasks = {done = [mkIOTaskInstance ioChannels : done], todo = todo}}
Just (IODestroyed taskStates)
// get task state one last time
# mbTaskState = get connectionId taskStates
| isNothing mbTaskState
# iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException "Missing IO task state for task ") ioStates
= ioOps.closeIO (ioChannels, {iworld & ioStates = ioStates})
# (Just (taskState, _)) = mbTaskState
//Ondestroy handler
# (mbTaskState, out, iworld) = onDestroyHandler taskState iworld
| mbTaskState =: (Error _) = taskStateException mbTaskState instanceNo ioStates ioOps.closeIO (ioChannels, iworld)
// write data
# (ioChannels, iworld) = foldl (flip ioOps.writeData) (ioChannels, iworld) out
# iworld = ioOps.closeIO (ioChannels, iworld)
//Remove the state for this connection
//If this is the last connection for this task, we can clean up.
......
......@@ -313,6 +313,7 @@ acceptTonicTraces tonicShare
, onData = onData
, onShareChange = onShareChange
, onDisconnect = onDisconnect
, onDestroy = onDestroy
}
where
onConnect :: ConnectionId String TMessageStore
......@@ -353,3 +354,4 @@ acceptTonicTraces tonicShare
onDisconnect st lines
= (Ok st, Just lines)
onDestroy st = (Ok st, [])
......@@ -131,7 +131,7 @@ wsockTextMsg payload = [wsockMsgFrame WS_OP_TEXT True payload]
httpServer :: !Int !Timespec ![WebService r w] (sds () r w) -> ConnectionTask | TC r & TC w & RWShared sds
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, onDestroy=onDestroy} sds
where
onConnect connId host r iworld=:{IWorld|world,clock}
= (Ok (NTIdle host clock),Nothing,[],False,{IWorld|iworld & world = world})
......@@ -235,6 +235,8 @@ where
= (Ok connState, mbW, env)
onDisconnect connState r env = (Ok connState, Nothing, env)
onDestroy s iw = (Ok s, [], iw)
selectHandler req [] = Nothing
selectHandler req [h:hs]
| h.urlMatchPred req.HTTPRequest.req_path = Just h
......
......@@ -13,9 +13,10 @@ from Data.Error import :: MaybeError, :: MaybeErrorString
:: ConnectionHandlers l r w =
{ onConnect :: !(ConnectionId String r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
, onData :: !( String l 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 ))
, onDisconnect :: !( l r -> (!MaybeErrorString l, Maybe w ))
, onDestroy :: !( l -> (!MaybeErrorString l, ![String] ))
}
/**
......
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