Commit 9f6af756 authored by Haye Böhm's avatar Haye Böhm

Add more tracing, remove all request information when finished

parent 82467507
Pipeline #14020 passed with stage
in 14 minutes and 7 seconds
......@@ -53,7 +53,6 @@ where
, publish "/SDSSelect" (const sdsSelectTest)
, publish "/SDSSelectRemote" (const sdsSelectRemoteTest)
, publish "/all" (\_. viewAll)
, publish "/host" (const hostShares)
, publish "/doubleRemote" (const doubleRemoteTest)]
sdsSelectRemoteTest = ((enterInformation "Enter the value to be SET for SDSSelect" [] >>= \v. set v (sdsFocus 0 selectShare))
......@@ -148,17 +147,12 @@ where
-&&- viewSharedInformation "Value of intShare" [] intShare)
@! ())
hostShares = enterInformation "Please enter the share host port" []
>>= \port. sdsServiceTask port
doubleRemoteTest = ((enterInformation "Enter the value to be SET for double remote" [] >>= \v. set v doubleRemote >>= viewInformation "Set value" [])
-&&-
//(get doubleRemote >>= viewInformation "View the value gotten for double remote by GET" []))
//-&&-
(enterInformation "Enter the new value for the number" [] >>= \n. upd (\_. n) doubleRemote) >>= viewInformation "Updated value" [])
//-&&-
//(viewSharedInformation "View value by viewSharedInformation" [] doubleRemote))
@! ()
doubleRemoteTest
# setV = enterInformation "Enter the value to be SET for double remote" [] >>= \v. set v doubleRemote >>= viewInformation "Set value" []
# getV = get doubleRemote >>= viewInformation "View the value gotten for double remote by GET" []
# updV = enterInformation "Enter the new value for the number" [] >>= \n. upd (\_. n) doubleRemote >>= viewInformation "Updated value" []
//# shaV = viewSharedInformation "View value by viewSharedInformation" [] doubleRemote
= (setV -&&- getV -&&- updV) @! ()
// ======= Definitions required for defining a remote service =======
// TODO: Create HTTP request by focussing the parameter
......
......@@ -69,6 +69,7 @@ instance Startable (a,b) | Startable a & Startable b
, autoLayout :: Bool
, timeout :: Maybe Int // The timeout
, distributed :: Bool
, sdsPort :: Int
, webDirPath :: FilePath // Location of public files that are served by the iTask webserver
, storeDirPath :: FilePath // Location of the application's persistent data files
, tempDirPath :: FilePath // Location for temporary files used in tasks
......
......@@ -59,18 +59,19 @@ doTasksWithOptions initFun startable world
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (destroyIWorld iworld)
# iworld = serve startupTasks (tcpTasks options.serverPort options.keepaliveTime)
# iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime)
engineTasks (timeout options.timeout) iworld
= destroyIWorld iworld
where
webTasks = [t \\ WebTask t <- toStartable startable]
startupTasks = [t \\ StartupTask t <- toStartable startable]
startupTasks {distributed, sdsPort} = [t \\ StartupTask t <- toStartable startable]
++ (if distributed [case onStartup (sdsServiceTask sdsPort) of StartupTask t = t;] [])
hasWebTasks = not (webTasks =: [])
initSymbolsShare False _ iworld = (Ok (), iworld)
initSymbolsShare True appName iworld = case storeSymbols appName iworld of
(Error (e, s), iworld) = (Error s, iworld)
(Ok symbols, iworld) = (Ok (), {iworld & world = show ["Read number of symbols: " +++ toString symbols] iworld.world})
(Ok noSymbols, iworld) = (Ok (), {iworld & world = show ["Read number of symbols: " +++ toString noSymbols] iworld.world})
//Only run a webserver if there are tasks that are started through the web
tcpTasks serverPort keepaliveTime
......@@ -117,7 +118,7 @@ where
[ Option ['?'] ["help"] (NoArg $ const Nothing)
"Display this message"
, Option ['p'] ["port"] (ReqArg (\p->fmap \o->{o & serverPort=toInt p}) "PORT")
("Specify the HTTP port (default: " +++ toString defaults.serverPort)
("Specify the HTTP port (default: " +++ toString defaults.serverPort +++ ")")
, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
......@@ -142,6 +143,8 @@ where
("Specify the folder containing the sapl files\ndefault: " +++ defaults.saplDirPath)
, Option [] ["distributed"] (NoArg (fmap \o->{o & distributed=True}))
"Enable distributed mode (populate the symbols share)"
, Option ['s'] ["sdsPort"] (ReqArg (\p->fmap \o->{o & sdsPort=toInt p}) "SDSPORT")
("Specify the SDS port (default: " +++ toString defaults.sdsPort +++ ")")
]
onStartup :: (Task a) -> StartableTask | iTask a
......@@ -216,6 +219,7 @@ defaultEngineOptions world
, persistTasks = False
, autoLayout = True
, distributed = False
, sdsPort = 9090
, timeout = Just 500
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
......@@ -244,7 +248,7 @@ determineAppPath world
cmpFileTime (_,Ok {FileInfo | lastModifiedTime = x})
(_,Ok {FileInfo | lastModifiedTime = y}) = timeGm x > timeGm y
//By default, we use the modification time of the applaction executable as version id
//By default, we use the modification time of the application executable as version id
determineAppVersion :: !FilePath!*World -> (!String,!*World)
determineAppVersion appPath world
# (res,world) = getFileInfo appPath world
......
......@@ -35,6 +35,12 @@ onData data (Left acc) _ = trace_n ("SDS onData: " +++ data) (Ok (Left (acc ++ [
onShareChange acc _ = (Ok acc, Nothing, [], False)
rtt (SDSReadRequest _ _) = "SDSReadRequest"
rtt (SDSRegisterRequest _ _ _ _ _) = "SDSRegisterRequest"
rtt (SDSWriteRequest _ _ _) = "SDSWriteRequest"
rtt (SDSModifyRequest _ _ _) = "SDSModifyRequest"
rtt (SDSRefreshRequest _ _) = "SDSRefreshRequest"
queueSDSRequest :: !(SDSRequest p r w) !String !Int !TaskId !{#Symbol} !*IWorld -> (!MaybeError TaskException !ConnectionId, !*IWorld) | TC r
queueSDSRequest req host port taskId symbols env = case addConnection taskId host port connectionTask env of
(Error e, env) = (Error e, env)
......@@ -62,7 +68,7 @@ queueModifyRequest req=:(SDSModifyRequest p r w) host port taskId symbols env =
where
connectionTask = wrapConnectionTask (handlers req) unitShare
handlers :: (SDSRequest p r w) -> ConnectionHandlers (Either [String] (r, w)) () () | TC r
handlers :: (SDSRequest p r w) -> ConnectionHandlers (Either [String] (r, w)) () () | TC r & TC w
handlers _ = {ConnectionHandlers| onConnect = onConnect req,
onData = onData,
onShareChange = onShareChange,
......@@ -109,7 +115,7 @@ queueRead rsds=:(SDSRemoteSource sds {SDSShareOptions|domain, port}) p taskId re
# (request, env) = buildRequest register env
= queueSDSRequest request domain port taskId symbols env
where
buildRequest True env=:{options}= (SDSRegisterRequest sds p reqSDSId taskId options.serverPort, env)
buildRequest True env=:{options}= (SDSRegisterRequest sds p reqSDSId taskId options.sdsPort, env)
buildRequest False env = (SDSReadRequest sds p, env)
queueRemoteRefresh :: !SDSIdentity [SDSNotifyRequest] !*IWorld -> *IWorld
......
......@@ -132,6 +132,7 @@ createClientIWorld serverURL currentInstance
, autoLayout = True
, timeout = Just 100
, distributed = False
, sdsPort = 9090
, webDirPath = locundef "webDirectory"
, storeDirPath = locundef "dataDirectory"
, tempDirPath = locundef "tempDirectory"
......
......@@ -28,7 +28,7 @@ import StdDebug, StdMisc
:: SDSEvaluations :== Map ConnectionId (Bool, String, String)
sdsServiceTask :: Int -> Task ()
sdsServiceTask port = Task eval
sdsServiceTask port = catchAll (Task eval) (\m. trace_n ("Exception in SDS Service task: " +++ m) (treturn ()))
where
share :: SDSLens () SDSEvaluations SDSEvaluations
share = (sharedStore "sdsServiceTaskShare" 'Map'.newMap)
......@@ -38,7 +38,7 @@ where
(Ok (ReadResult symbols _), iworld) = (readSymbols symbols, iworld)
# (mbError, iworld) = addListener taskId port True (wrapIWorldConnectionTask (handlers symbols taskId) share) iworld
| mbError=:(Error _) = (ExceptionResult (fromError mbError), iworld)
| not (trace_tn "Initialized SDSService") = undef
| not (trace_tn ("SDS server listening on " +++ toString port)) = undef
= (ValueResult (Value () False) {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} (ReplaceUI (ui UIEmpty)) (TCBasic taskId ts (DeferredJSONNode JSONNull) False), iworld)
eval (RefreshEvent taskIds cause) evalOpts tree=:(TCBasic taskId ts data bla) iworld
......@@ -102,18 +102,20 @@ where
// Not yet completed evaluating the sds, do nothing.
Just (False, _, result) = trace_n ("Share change for " +++ host +++ ":" +++ toString connId +++ ": Not done") (Ok state, Nothing, [], False, iworld)
// We have completed evaluating the SDS, send the result to the client.
Just (True, _, result) = trace_n ("Share change for " +++ host +++ ":" +++ toString connId +++ ": Replying with [" +++ result +++ "\n]") (Ok state, Nothing, [result +++ "\n"], True, iworld)
Just (True, _, result) = trace_n ("Share change for " +++ host +++ ":" +++ toString connId +++ ": Replying with [" +++ result +++ "\n]") (Ok state, Just ('Map'.del connId sdsValue), [result +++ "\n"], True, iworld)
onTick :: !SDSServiceState !SDSEvaluations !*IWorld -> *(!MaybeErrorString SDSServiceState, Maybe SDSEvaluations, ![String], !Bool, !*IWorld)
onTick state sdsValue iworld = (Ok state, Nothing, [], False, iworld)
onDisconnect :: !SDSServiceState !SDSEvaluations !*IWorld -> *(!MaybeErrorString SDSServiceState, Maybe SDSEvaluations, !*IWorld)
onDisconnect state=:(SDSProcessing host connId _) sdsValue iworld = trace_n ("Disconnecting " +++ host +++ ":" +++ toString connId) (Ok state, Nothing, iworld)
onDisconnect state=:(SDSProcessing host connId _) sdsValue iworld = trace_n ("Disconnecting " +++ host +++ ":" +++ toString connId) (Ok state, Just ('Map'.del connId sdsValue), iworld)
// Left: Done
// Right: Still need to do work..
performRequest :: !{#Symbol} !TaskId !String !String !*IWorld -> !(MaybeErrorString !(Either !String !String), !*IWorld)
performRequest symbols taskId host request iworld = case deserializeFromBase64 request symbols of
performRequest symbols taskId host request iworld
| newlines (fromString request) > 1 = abort ("Multiple requests: " +++ request)
= case deserializeFromBase64 request symbols of
(SDSReadRequest sds p)
# ioStates = iworld.IWorld.ioStates
| not (trace_tn ("performRequest " +++ ioStateString ioStates)) = undef
......@@ -121,7 +123,7 @@ where
(Error (_, e), iworld) = (Error e, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Done reading" (Ok (Left (serializeToBase64 v)), iworld)
(Ok (AsyncRead sds), iworld) = trace_n "Async read" (Ok (Right (serializeToBase64 (SDSReadRequest sds p))), iworld))
(SDSRegisterRequest sds p reqSDSId taskId port) = trace_n "Got register" (case readSDS sds p (RemoteTaskContext taskId host port) (Just taskId) reqSDSId iworld of
(SDSRegisterRequest sds p reqSDSId reqTaskId port) = trace_n "Got register" (case readSDS sds p (RemoteTaskContext reqTaskId host port) (Just taskId) reqSDSId iworld of
(Error (_, e), iworld) = (Error e, iworld)
(Ok (ReadResult v _), iworld) = trace_n "Done registering" (Ok (Left (serializeToBase64 v)), iworld)
(Ok (AsyncRead sds), iworld) = trace_n "Async register" (Ok (Right (serializeToBase64 (SDSRegisterRequest sds p reqSDSId taskId port))), iworld))
......@@ -133,4 +135,8 @@ where
(Error (_, e), iworld) = (Error e, iworld)
(Ok (ModifyResult r w _), iworld) = trace_n "Done modifying" (Ok (Left (serializeToBase64 (r,w))), iworld)
(Ok (AsyncModify sds f), iworld) = trace_n "Async modify" (Ok (Right (serializeToBase64 (SDSModifyRequest sds p f))), iworld))
(SDSRefreshRequest taskId sdsId) = trace_n "Got refresh" (Ok (Left "Refresh queued"), queueRefresh [(taskId, "Notification for remote write of " +++ sdsId)] iworld)
\ No newline at end of file
(SDSRefreshRequest taskId sdsId) = trace_n ("Got refresh for " +++ toSingleLineText taskId +++ sdsId) (Ok (Left "Refresh queued"), queueRefresh [(taskId, "Notification for remote write of " +++ sdsId)] iworld)
where
newlines [] = 0
newlines ['\n':xs] = inc (newlines xs)
newlines [x: xs] = newlines xs
\ No newline at end of file
......@@ -522,6 +522,8 @@ where
connId taskId ioStates = case 'DM'.get taskId ioStates of
Nothing = 0
(Just (IOActive connectionMap)) = inc ('DL'.maximum ('DM'.keys connectionMap))
(Just (IOException s)) = trace_n ("EXCEPTION: " +++ s) 0
(Just (IODestroyed connectionMap)) = inc ('DL'.maximum ('DM'.keys connectionMap))
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
......
......@@ -97,17 +97,17 @@ upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
upd fun shared = Task (eval fun shared)
where
eval :: (r -> w) (sds () r w) Event TaskEvalOpts TaskTree *IWorld -> (TaskResult w, !*IWorld) | iTask r & iTask w & RWShared sds
eval fun shared event _ tree=:(TCDestroy _) w = (DestroyedResult, w)
eval fun shared event _ tree=:(TCDestroy _) w = trace_n "upd destroyed" (DestroyedResult, w)
eval fun shared event _ tree=:(TCInit taskId ts) iworld=:{sdsEvalStates}
# evalInfo = {lastEvent=ts,removedTasks=[],refreshSensitive=False}
= case 'SDS'.modify fun shared ('SDS'.TaskContext taskId) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
(Ok (ModifyResult r w _), iworld) = (ValueResult (Value w True) evalInfo (rep event) (TCStable taskId ts (DeferredJSON w)), iworld)
(Error (d, s), iworld) = trace_n ("upd init exception" +++ s) (ExceptionResult (d, s), iworld)
(Ok (ModifyResult r w _), iworld) = trace_n "upd init result" (ValueResult (Value w True) evalInfo (rep event) (TCStable taskId ts (DeferredJSON w)), iworld)
(Ok (AsyncModify sds _), iworld)
# ui = ReplaceUI (uia UIProgressBar (textAttr "Getting data"))
# tree = TCAwait Modify taskId ts (TCInit taskId ts)
# sdsEvalStates = 'DM'.put taskId (dynamicResult ('SDS'.modify fun sds ('SDS'.TaskContext taskId))) sdsEvalStates
= (ValueResult NoValue evalInfo ui tree, {iworld & sdsEvalStates = sdsEvalStates})
= trace_n "upd init async" (ValueResult NoValue evalInfo ui tree, {iworld & sdsEvalStates = sdsEvalStates})
eval fun shared event _ tree=:(TCAwait Modify taskId ts subtree) iworld=:{sdsEvalStates} = case 'DM'.get taskId sdsEvalStates of
Nothing = (ExceptionResult (exception ("No SDS state found for task " +++ toString taskId)), iworld)
......
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