Commit 7d89c7a7 authored by Haye Böhm's avatar Haye Böhm

Add connectionId parameter to onConnect

parent a290e9ff
Pipeline #13883 failed with stage
in 1 minute and 56 seconds
......@@ -40,8 +40,8 @@ authServer port = tcplisten port True authServerShare {ConnectionHandlers
, onDisconnect = onDisconnect
} -|| (process authServerShare) @! ()
where
onConnect :: String AuthShare -> (MaybeErrorString AuthServerState, Maybe AuthShare, [String], Bool)
onConnect host share
onConnect :: ConnectionId String AuthShare -> (MaybeErrorString AuthServerState, Maybe AuthShare, [String], Bool)
onConnect connId host share
# clientId = share.lastId + 1
= ( Ok {AuthServerState| id = clientId, buffer = "" }
, Just { share & lastId = clientId, clients = share.clients ++ [{Communication| id = clientId, requests = [], responses = []}] }
......@@ -139,8 +139,8 @@ where
[resp:_] -> return (fromJSON (fromString (base64Decode resp)))
_ -> return Nothing
onConnect :: String () -> (MaybeErrorString ([String], String, Bool), Maybe (), [String], Bool)
onConnect host store
onConnect :: ConnectionId String () -> (MaybeErrorString ([String], String, Bool), Maybe (), [String], Bool)
onConnect connId host store
= (Ok ([], "", False), Just store, [request +++ "\n"], False)
onData :: String ([String], String,Bool) () -> (MaybeErrorString ([String], String, Bool), Maybe (), [String], Bool)
......
......@@ -5,6 +5,6 @@ import iTasks.SDS.Definition
:: Remote_Task = E. a: Remote_Task (Task a) TaskAttributes Int & iTask a | Remote_Taks_NotUsed
:: Remote_Share = E. sds r w: Remote_Share (sds () r w) & RWShared sds & iTask r & iTask w | Remote_Share_NotUsed
:: Remote_Share = E. sds r w: Remote_Share (sds () r w) & RWShared sds & iTask r & iTask w | Remote_Share_NotUsed
:: Remote_TaskValue = E. a: Remote_TaskValue (TaskValue a) & iTask a | Remote_TaskValue_NotUsed
......@@ -63,7 +63,7 @@ where
= tcplisten port False (currentTimespec |*< io)
{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
onConnect client_name (now,io)
onConnect connId client_name (now,io)
= (Ok (Idle client_name now), Nothing, [], False)
onData data l=:(Idle client_name last) (now,io)
......@@ -192,7 +192,7 @@ where
//VERY SIMPLE HTTP 1.1 Request
req = toString method +++ " " +++ path +++ " HTTP/1.1\r\nHost:"+++uriRegName+++"\r\nConnection: close\r\n\r\n"+++data
onConnect _ _
onConnect _ _ _
= (Ok (Left []),Nothing,[req],False)
onData data (Left acc) _
= (Ok (Left (acc ++ [data])),Nothing,[],False)
......
......@@ -24,7 +24,7 @@ derive JSONEncode SDSNotifyRequest, RemoteNotifyOptions
createRequestString req = serializeToBase64 req
onConnect reqq _ _
onConnect _ reqq _ _
# rs = createRequestString reqq
= (Ok (Left []), Nothing, [ rs +++ "\n"], False)
......@@ -80,7 +80,7 @@ where
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onConnect _ _ = (Ok (Left []), Nothing, [toString {HTTPRequest|req & req_headers = 'DM'.put "Connection" "Close" req.HTTPRequest.req_headers}], False)
onConnect _ _ _ = (Ok (Left []), Nothing, [toString {HTTPRequest|req & req_headers = 'DM'.put "Connection" "Close" req.HTTPRequest.req_headers}], False)
onData data (Left acc) _ = (Ok (Left (acc ++ [data])), Nothing, [], False)
......
......@@ -90,8 +90,8 @@ instanceServer port domain = tcplisten port True instanceServerShared {Connectio
, onDisconnect = onDisconnect
} -|| (instanceClient` "127.0.0.1" port domain True) -|| (process instanceServerShared) @! ()
where
onConnect :: String InstanceServerShare -> (MaybeErrorString InstanceServerState, Maybe InstanceServerShare, [String], Bool)
onConnect host share=:{InstanceServerShare|lastId,clients}
onConnect :: ConnectionId String InstanceServerShare -> (MaybeErrorString InstanceServerState, Maybe InstanceServerShare, [String], Bool)
onConnect connId host share=:{InstanceServerShare|lastId,clients}
= ( Ok {InstanceServerState| id = -1, buffer = "" }, Nothing, [], False)
onData :: String InstanceServerState InstanceServerShare -> (MaybeErrorString InstanceServerState, Maybe InstanceServerShare, [String], Bool)
......@@ -486,8 +486,8 @@ where
} @! Nothing)
-||- (viewInformation () [] () >>* [OnAction (Action "reset") (always (return Nothing))])
onConnect :: String String ClientShare -> (MaybeErrorString ClientState, Maybe ClientShare, [String], Bool)
onConnect helloMessage host store
onConnect :: String ConnectionId String ClientShare -> (MaybeErrorString ClientState, Maybe ClientShare, [String], Bool)
onConnect helloMessage connId host store
= (Ok "", Just store, [helloMessage +++ "\n"] ++ [(toString nr) +++ "#!#" +++ resp +++ "\n" \\ (nr,resp) <- store.out], False)
onData :: String ClientState ClientShare -> (MaybeErrorString ClientState, Maybe ClientShare, [String], Bool)
......
......@@ -51,24 +51,24 @@ where
, onDisconnect = onDisconnect
}
onConnect :: String String *IWorld -> *(!MaybeErrorString String, Maybe w, ![String], !Bool, !*IWorld)
onConnect clientName sdsValue iworld = (Ok clientName, Nothing, [], False, iworld)
onConnect :: ConnectionId String String *IWorld -> *(!MaybeErrorString String, Maybe w, ![String], !Bool, !*IWorld)
onConnect connId clientName sdsValue iworld = (Ok clientName, Nothing, [], False, iworld)
onData :: {#Symbol} !String String r *IWorld -> *(!MaybeErrorString String, Maybe w, ![String], !Bool, !*IWorld)
onData symbols receivedData state sdsValue iworld
= case deserializeFromBase64 receivedData symbols of
(SDSReadRequest sds p) = case readSDS sds p EmptyContext Nothing (sdsIdentity sds) iworld of
(Error (_, e), iworld) = (Error e, Nothing, [], True, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Got read" (Ok state, Nothing, [serializeToBase64 v], True, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Got read" (Ok state, Nothing, [serializeToBase64 v +++ "\n"], True, iworld)
(SDSRegisterRequest sds p reqSDSId taskId port) = case readSDS sds p (RemoteTaskContext taskId "test" port) (Just taskId) reqSDSId iworld of
(Error (_, e), iworld) = (Error e, Nothing, [], True, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Got register" (Ok state, Nothing, [serializeToBase64 v], True, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Got register" (Ok state, Nothing, [serializeToBase64 v +++ "\n"], True, iworld)
(SDSWriteRequest sds p val) = case writeSDS sds p EmptyContext val iworld of
(Error (_, e), iworld) = (Error e, Nothing, [], True, iworld)
(Ok (WriteResult notify _), iworld) = trace_n "Got write" (Ok state, Nothing, [serializeToBase64 ()], True, queueNotifyEvents (sdsIdentity sds) notify iworld)
(Ok (WriteResult notify _), iworld) = trace_n "Got write" (Ok state, Nothing, [serializeToBase64 () +++ "\n"], True, queueNotifyEvents (sdsIdentity sds) notify iworld)
(SDSModifyRequest sds p f) = case modifySDS f sds p EmptyContext iworld of
(Error (_, e), iworld) = (Error e, Nothing, [], True, iworld)
(Ok (ModifyResult r w _), iworld) = trace_n "Got modify" (Ok state, Nothing, [serializeToBase64 (r,w)], True, iworld)
(Ok (ModifyResult r w _), iworld) = trace_n "Got modify" (Ok state, Nothing, [serializeToBase64 (r,w) +++ "\n"], True, iworld)
(SDSRefreshRequest taskId sdsId)
# iworld = (queueRefresh [(taskId, "Notification for remote write of " +++ sdsId)] iworld)
= (Ok state, Nothing, ["Refresh queued"], True, iworld)
......
......@@ -10,6 +10,7 @@ from iTasks.WF.Tasks.IO import :: ConnectionHandlers
from iTasks.Internal.TaskState import :: TaskTree
import iTasks.SDS.Definition
from iTasks.UI.Definition import :: UIChange
from iTasks.Internal.IWorld import :: ConnectionId
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Data.CircularStack import :: CircularStack
......@@ -28,7 +29,7 @@ derive gEq Task
//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))
{ onConnect :: !(ConnectionId 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))
......
......@@ -46,8 +46,8 @@ wrapConnectionTask :: (ConnectionHandlers l r w) (sds () r w) -> ConnectionTask
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
# (mbl, mbw, out, close) = onConnect host r
onConnect` connId host (r :: r^) env
# (mbl, mbw, out, close) = onConnect connId host r
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onData` data (l :: l^) (r :: r^) env
......@@ -70,8 +70,8 @@ wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> Con
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
# (mbl, mbw, out, close, env) = onConnect host r env
onConnect` connId host (r :: r^) env
# (mbl, mbw, out, close, env) = onConnect connId host r env
= (toDyn <$> mbl, toDyn <$> mbw, out, close, env)
onData` data (l :: l^) (r :: r^) env
......
......@@ -174,7 +174,7 @@ process i chList iworld=:{ioTasks={done,todo=[ListenerInstance lopts listener:to
# ioStates = 'DM'.put lopts.ListenerInstanceOpts.taskId (IOException (snd (fromError mbr))) ioStates
# world = closeRChannel listener world
= process (i+1) chList {iworld & ioTasks={done=done,todo=todo}, ioStates = ioStates, world=world}
# (mbConState,mbw,out,close,iworld) = handlers.ConnectionHandlersIWorld.onConnect (toString ip) (directResult (fromOk mbr)) iworld
# (mbConState,mbw,out,close,iworld) = handlers.ConnectionHandlersIWorld.onConnect (lopts.nextConnectionId + 1) (toString ip) (directResult (fromOk mbr)) iworld
# iworld = if (instanceNo > 0) (queueRefresh [(taskId,"New TCP connection for instance "<+++instanceNo)] iworld) iworld
# (mbSdsErr, iworld=:{ioTasks={done,todo},world}) = writeShareIfNeeded sds mbw iworld
| mbConState =:(Error _)
......@@ -458,8 +458,8 @@ where
Nothing = (Error ("Failed to connect to host " +++ host), {iworld & world = world})
Just channel = (Ok (ip, channel), {iworld & world = world})
onInitHandler :: !IPAddress !Dynamic !*IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onInitHandler ip r iworld = handlers.ConnectionHandlersIWorld.onConnect (toString ip) r iworld
onInitHandler :: ConnectionId !IPAddress !Dynamic !*IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onInitHandler connId ip r iworld = handlers.ConnectionHandlersIWorld.onConnect connId (toString ip) r iworld
mkIOTaskInstance :: ConnectionId !IPAddress !*TCP_DuplexChannel -> *IOTaskInstance
mkIOTaskInstance connectionId ip channel
......@@ -470,11 +470,11 @@ addIOTask :: !TaskId
!(sds () Dynamic Dynamic)
!(*IWorld -> (!MaybeErrorString (!initInfo, !.ioChannels), !*IWorld))
!(IOTaskOperations .ioChannels readData closeInfo)
!(initInfo Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(ConnectionId initInfo Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(ConnectionId initInfo .ioChannels -> *IOTaskInstance)
!*IWorld
-> (!MaybeError TaskException (ConnectionId, Dynamic), !*IWorld) | Readable sds
addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld
addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld=:{ioStates}
# (mbInitRes, iworld) = init iworld
= case mbInitRes of
Error e = (Error (exception e), iworld)
......@@ -482,8 +482,9 @@ addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld
// Read share
# (mbr, iworld) = 'SDS'.read sds EmptyContext iworld
| isError mbr = (liftError mbr, iworld)
# newConnectionId = connId taskId ioStates
// Evaluate onInit handler
# (mbl, mbw, out, close, iworld) = onInitHandler initInfo (directResult (fromOk mbr)) iworld
# (mbl, mbw, out, close, iworld) = onInitHandler newConnectionId initInfo (directResult (fromOk mbr)) iworld
// Check initialization of local state
= case mbl of
Error e = (Error (exception e), iworld)
......@@ -503,6 +504,10 @@ addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld
# ioStates = 'DM'.put taskId connectionMap ioStates
# {done, todo} = iworld.ioTasks
= (Ok (connectionId, l), {iworld & ioStates = ioStates, ioTasks = {done = [mkIOTaskInstance connectionId initInfo ioChannels : done], todo = todo}})
where
connId taskId ioStates = case 'DM'.get taskId ioStates of
Nothing = 0
(Just (IOActive connectionMap)) = inc ('DL'.maximum ('DM'.keys connectionMap))
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
......
......@@ -17,6 +17,7 @@ import iTasks.Extensions.DateTime
import iTasks.Internal.Tonic.AbsSyn
import iTasks.Internal.Tonic.Types
import iTasks.Internal.Tonic.Images
from iTasks.Internal.IWorld import :: ConnectionId
:: ViewerSettings =
{ recording :: Bool
......@@ -313,9 +314,9 @@ acceptTonicTraces tonicShare
, onDisconnect = onDisconnect
}
where
onConnect :: String TMessageStore
onConnect :: ConnectionId String TMessageStore
-> (MaybeErrorString ServerState, Maybe TMessageStore, [String], Bool)
onConnect host olderMessages
onConnect connId host olderMessages
= ( Ok { oldData = ""
, clientIp = host}
, Just olderMessages
......
......@@ -133,7 +133,7 @@ httpServer :: !Int !Timespec ![WebService r w] (sds () r w) -> ConnectionTask |
httpServer port keepAliveTime requestProcessHandlers sds
= wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect} sds
where
onConnect host r iworld=:{IWorld|world,clock}
onConnect connId host r iworld=:{IWorld|world,clock}
= (Ok (NTIdle host clock),Nothing,[],False,{IWorld|iworld & world = world})
onData data connState=:(NTProcessingRequest request localState) r env
......
......@@ -5,13 +5,14 @@ definition module iTasks.WF.Tasks.IO
*/
import iTasks.WF.Definition
import iTasks.SDS.Definition
from iTasks.Internal.IWorld import :: ConnectionId
from iTasks.UI.Prompt import class toPrompt
from System.FilePath import :: FilePath
from System.Process import :: ProcessPtyOptions
from Data.Error import :: MaybeError, :: MaybeErrorString
:: ConnectionHandlers l r w =
{ onConnect :: !(String r -> (!MaybeErrorString l, Maybe w, ![String], !Bool))
{ onConnect :: !(ConnectionId 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 ))
......
......@@ -22,13 +22,6 @@ import Text, Text.GenJSON, StdString, StdInt, StdBool, StdList, StdTuple, Data.T
import qualified Data.Map as DM
import qualified Data.Set as DS
:: ConnectionHandlers l r 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 ))
}
:: ExitCode = ExitCode !Int
:: ExternalProcessHandlers l r w =
{ onStartup :: !( r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
......
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