Async.TryCancelled doesn't work with Async.RunSynchronously - asynchronous

I try to create an agent that updates UI based on user interaction. If user clicks on a button, the GUI should be refreshed. The preparation of model takes a long time, so it is desirable that if user clicks on other button, the preparation is cancelled and the new one is started.
What I have so far:
open System.Threading
type private RefreshMsg =
| RefreshMsg of AsyncReplyChannel<CancellationTokenSource>
type RefresherAgent() =
let mutable cancel : CancellationTokenSource = null
let doSomeModelComputation i =
async {
printfn "start %A" i
do! Async.Sleep(1000)
printfn "middle %A" i
do! Async.Sleep(1000)
printfn "end %A" i
}
let mbox =
MailboxProcessor.Start(fun mbx ->
let rec loop () = async {
let! msg = mbx.Receive()
match msg with
| RefreshMsg(chnl) ->
let cancelSrc = new CancellationTokenSource()
chnl.Reply(cancelSrc)
let update = async {
do! doSomeModelComputation 1
do! doSomeModelComputation 2
//do! updateUI // not important now
}
let cupdate = Async.TryCancelled(update, (fun c -> printfn "refresh cancelled"))
Async.RunSynchronously(cupdate, -1, cancelSrc.Token)
printfn "loop()"
return! loop()
}
loop ())
do
mbox.Error.Add(fun exn -> printfn "Error in refresher: %A" exn)
member x.Refresh() =
if cancel <> null then
// I don't handle whether the previous computation finished
// I just cancel it; might be improved
cancel.Cancel()
cancel.Dispose()
cancel <- mbox.PostAndReply(fun reply -> RefreshMsg(reply))
printfn "x.Refresh end"
//sample
let agent = RefresherAgent()
agent.Refresh()
System.Threading.Thread.Sleep(1500)
agent.Refresh()
I return a CancellationTokenSource for each request and store it in a mutable variable (the x.Refresh() is thread safe, it is called on UI thread).
If Refresh() is called for the first time, the cancellation source is returned. If Refresh() is called for the second time, I call Cancel which should abort the async task that I run through Async.RunSynchronously.
However, an exception is raised. The output from my sample is
x.Refresh end
start 1
middle 1
end 1
refresh cancelled
Error in refresher: System.OperationCanceledException: The operation was canceled.
at Microsoft.FSharp.Control.AsyncBuilderImpl.commit[a](Result`1 res)
Now as I think about this, it might make sense, because the thread on which the agent runs, was interrputed, right? But, how do I achieve the desired behaviour?
I need to cancel async workflow inside the agent, so that the agent can continue consuming new messages. Why do I use the mailbox processor? Cause it is guaranteed that only one thread is trying to create UI model, so I save resources.
Let's suppose I create UI model by downloading data from several web services, that's why I use async call. When user changes a combo and select other option, I want to stop querying the webservices (= cancel the async calls) with old value and want to create new model base od web services call with new value.
Any suggestion that I can use instead of my solution and will solve my problem, is also welcome.

I have difficulties in trying to understand what you want to achieve. But maybe this does not matter - the error just says that the workflow you are executing with RunSynchronously was canceled (RunSynchronously will throw the exception) - so you can wrap this call into a try-match block and just ignore the OC-Exception
a better option might be to refactor your cupdate and to the try-match inside of this - you can even bring the in TryCancelled into it if you catch the OC-Exceptions directly ;)
let update =
async {
try
do! doSomeModelComputation 1
do! doSomeModelComputation 2
with
| :? OperationCanceledException ->
printfn "refresh cancelled"
}
Async.RunSynchronously(update, -1, cancelSrc.Token)
But I still don't get the part why you want this Synchronously

Related

MailboxProcessor first loop can't run if program immediately fails

I have a command running a SFTP check periodically and logging the result to a file.
let logPath = Path.Combine(config.["SharedFolder"],timestamp)
let sw = new StreamWriter(logPath,true)
//...
[<EntryPoint>]
let main argv =
try
sftpExample config.["SharedFolder"] config.["SFTPFolder"] 22 "usr" "pswd" |> ignore
with
| ex ->
ex.Message |> printerAgent.Post
printfn "%s" ex.Message // <- NOTICE THIS LINE
sw.Close()
sw.Dispose()
0
It loops over a MailboxProcessor
let printerAgent = MailboxProcessor.Start(fun inbox->
// the message processing function
let rec messageLoop() = async{
// read a message
let! msg = inbox.Receive()
// process a message
sw.WriteLine("{0}: {1}", DateTime.UtcNow.ToShortTimeString(), msg)
printfn "%s" msg
// loop to top
return! messageLoop()
}
// start the loop
messageLoop()
)
which is called to write the messages to the log
let sftpExample local host port username (password:string) =
async {
use client = new SftpClient(host, port, username, password)
client.Connect()
sprintf "Connected to %s\nroot dir list" host |> printerAgent.Post
do! downloadDir local client ""
sprintf "Done, disconnecting now" |> printerAgent.Post
client.Disconnect()
} |> Async.RunSynchronously
The file downloads are asynchronous, as well as the corresponding messages, but all appears to work well.
The problem is that - if, for some reasons, the sftp connection immediately fails, the MailboxProcessor has no time to log the exception message.
What I've tried to do - which is working indeed - was adding a printfn "%s" ex.Message before the end: I just wanted to know if someone envisions a better solution.
FYI, the full code is in this gist.
In fact, what you want is for the program to wait until the MailboxProcessor has finished handling all of its message queue before the program exits. Your printfn "%s" ex.Message seems to be working, but it's not guaranteed to work: if the MailboxProcessor had multiple items in its queue, the thread running the printfn function might finish before the MailboxProcessor's thread had had time to get through all of its messages.
The design I would recommend is to change the input of your printerAgent to be a DU like the following:
type printerAgentMsg =
| Message of string
| Shutdown
Then when you want the printer agent to finish sending its messages, use MailboxProcessor.PostAndReply (and note the usage example in the docs) in the main function and send it the Shutdown message. Remember that MailboxProcessor messages are queued: by the time it receives the Shutdown message, it will have already gone through the rest of the messages in the queue. So all it needs to do to handle the Shutdown message is to return a unit reply, and simply not call its loop again. And because you used PostAndReply rather than PostAndReplyAsync, the main function will block until the MailboxProcessor has finished doing all its work. (To avoid any chance of blocking forever, I'd recommend setting a timeout like 10 seconds in your PostAndReply call; the default timeout is -1, meaning wait forever).
EDIT: Here's an example (NOT tested, use at own risk) of what I mean:
type printerAgentMsg =
| Message of string
| Shutdown of AsyncReplyChannel<unit>
let printerAgent = MailboxProcessor.Start(fun inbox->
// the message processing function
let rec messageLoop() = async{
// read a message
let! msg = inbox.Receive()
// process a message
match msg with
| Message text ->
sw.WriteLine("{0}: {1}", DateTime.UtcNow.ToShortTimeString(), text)
printfn "%s" text
// loop to top
return! messageLoop()
| Shutdown replyChannel ->
replyChannel.Reply()
// We do NOT do return! messageLoop() here
}
// start the loop
messageLoop()
)
let logPath = Path.Combine(config.["SharedFolder"],timestamp)
let sw = new StreamWriter(logPath,true)
//...
[<EntryPoint>]
let main argv =
try
sftpExample config.["SharedFolder"] config.["SFTPFolder"] 22 "usr" "pswd" |> ignore
with
| ex ->
ex.Message |> Message |> printerAgent.Post
printfn "%s" ex.Message // <- NOTICE THIS LINE
printerAgent.PostAndReply( (fun replyChannel -> Shutdown replyChannel), 10000) // Timeout = 10000 ms = 10 seconds
sw.Close()
sw.Dispose()
Easiest solution would be to use normal (synchronous) function for logging instead of MailboxProcessor or use some logging framework and flush loggers in the end of the main function. If you want to keep using printingAgent you can implement "synchronous" mode like this:
type Msg =
| Log of string
| LogAndWait of string * AsyncReplyChannel<unit>
let printerAgent = MailboxProcessor.Start(fun inbox ->
let processLogMessage logMessage =
sw.WriteLine("{0}: {1}", DateTime.UtcNow.ToShortTimeString(), logMessage)
printfn "%s" logMessage
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Log logMessage ->
processLogMessage logMessage
| LogAndWait (logMessage, replyChannel) ->
processLogMessage logMessage
replyChannel.Reply()
return! messageLoop()
}
messageLoop()
)
Which you would then use either asynchronously
printerAgent.Post(Log "Message")
or synchronously
printerAgent.PostAndReply(fun channel -> LogAndWait("Message", channel))
You should use synchronous alternative when you log exception in the main function.

How to ensure Async.StartChild is started before continuing?

I am trying to await an event with timeout. I am abstracting this behind a function startAwaitEventWithTimeout. Currently my code looks like this (including some debug output messages):
let startAwaitEventWithTimeout timeoutMs event =
async {
Console.WriteLine("Starting AwaitEvent in eventAwaiter")
let! eventWaiter = Async.StartChild(Async.AwaitEvent event, timeoutMs)
try
Console.WriteLine("Awaiting event in eventAwaiter")
let! res = eventWaiter
return Ok res
with :? TimeoutException ->
return Error ()
} |> Async.StartChild
Here's a test:
let testEvent = Event<string>()
[<EntryPoint>]
let run _ =
async {
Console.WriteLine("Starting event awaiter in main")
let! eventAwaiter = testEvent.Publish |> startAwaitEventWithTimeout 1000
Console.WriteLine("Triggering event")
testEvent.Trigger "foo"
Console.WriteLine("Awaiting event awaiter in main")
let! result = eventAwaiter
match result with
| Ok str -> Console.WriteLine("ok: " + str)
| Error () -> Console.WriteLine("TIMEOUT")
} |> Async.RunSynchronously
0
Unfortunately, even though everything is "awaited" as far as I can see, it seems the run function proceeds to triggering the event before Async.AwaitEvent has had a chance to subscribe to the event. In short, here is the output I get:
Starting event awaiter in main
Starting AwaitEvent in eventAwaiter
Triggering event
Awaiting event awaiter in main
Awaiting event in eventAwaiter
TIMEOUT
Here is what I would expect:
Starting event awaiter in main
Starting AwaitEvent in eventAwaiter
Awaiting event in eventAwaiter <-- this is moved up
Triggering event
Awaiting event awaiter in main
ok foo
I can work around the problem by adding e.g. do! Async.Sleep 100 between calling startAwaitEventWithTimeout and triggering the event, but of course this is less than ideal.
Have I done something incorrectly, and is there any way I can reliably ensure that AwaitEvent has been called before I trigger the event?
(Side note: I am doing this because we are calling remote processes over TCP, and all communication from the remote is done via events.)
Probably I am missing some requirement but your code can easily be refactored using continuations and the error fixed by itself.
let testEvent = Event<unit>()
let run _ =
let ts = new CancellationTokenSource(TimeSpan.FromSeconds(float 1))
let rc r = Console.WriteLine("ok")
let ec _ = Console.WriteLine("exception")
let cc _ = Console.WriteLine("cancelled")
Async.StartWithContinuations((Async.AwaitEvent testEvent.Publish), rc , ec, cc, ts.Token )
testEvent.Trigger()
run()
Edit: If you have a specific requirement to use async workflows, you can convert it by using TaskCompletionSource in TPL.
let registerListener timeout event=
let tcs = TaskCompletionSource()
let ts = new CancellationTokenSource(TimeSpan.FromSeconds(timeout))
let er _ = tcs.SetResult (Error())
Async.StartWithContinuations(Async.AwaitEvent event, tcs.SetResult << Ok , er , er , ts.Token)
Async.AwaitTask tcs.Task
let run _ =
let testEvent = Event<int>()
async {
let listener = registerListener (float 1) testEvent.Publish
testEvent.Trigger 2
let! ta = listener
match ta with
| Ok n -> printfn "ok: %d" n
| Error () -> printfn "error"
} |> Async.RunSynchronously
run()
Note that even though it is far easier to understand than spawning/awaiting multiple child computations, most of this code is still boilerplate and I am sure there must far easier solutions for setting a simple timeout value.
I do not think that you experience a race condition because you are consistently firing the event before the child computation is even started. Let's change the set-up - like you did for testing - to include a delay before firing.
open System
open System.Threading
let e = Event<_>()
let sleeper timeToFire = async{
do! Async.Sleep timeToFire
e.Trigger() }
let waiter = async{
do! Async.AwaitEvent e.Publish
return Ok() }
let foo timeToFire timeOut = async{
Async.Start(sleeper timeToFire)
let! child = Async.StartChild(waiter, timeOut)
try return! child
with :? TimeoutException -> return Error() }
foo 500 1000 |> Async.RunSynchronously
// val it : Result<unit,unit> = Ok null
foo 1000 500 |> Async.RunSynchronously
// val it : Result<unit,unit> = Error null
A race condition will now appear if the delay to firing is equal to the timeout.

Why do I have to wrap an Async<T> into another async workflow and let! it?

I'm trying to understand async workflows in F# but I found one part that I really don't understand.
The following code works fine:
let asynWorkflow = async{
let! result = Stream.TryOpenAsync(partition) |> Async.AwaitTask
return result
}
let stream = Async.RunSynchronously asynWorkflow
|> fun openResult -> if openResult.Found then openResult.Stream else Stream(partition)
I define a async workflow where TryOpenAsync returns a Task<StreamOpenResult> type. I convert it to Async<StreamOpenResult> with Async.AwaitTask. (Side quest: "Await"Task? It doesn't await it just convert it, does it? I think it has nothing to do with Task.Wait or the await keyword). I "await" it with let! and return it.
To start the workflow I use RunSynchronously which should start the workflow and return the result (bind it). On the result I check if the Stream is Found or not.
But now to my first question. Why do I have to wrap the TryOpenAsync call in another async computation and let! ("await") it?
E.g. the following code does not work:
let asynWorkflow = Stream.TryOpenAsync(partition) |> Async.AwaitTask
let stream = Async.RunSynchronously asynWorkflow
|> fun openResult -> if openResult.Found then openResult.Stream else Stream(partition)
I thought the AwaitTask makes it an Async<T> and RunSynchronously should start it. Then use the result. What do I miss?
My second question is why is there any "Async.Let!" function available? Maybe because it does not work or better why doesn't it work with the following code?
let ``let!`` task = async{
let! result = task |> Async.AwaitTask
return result
}
let stream = Async.RunSynchronously ( ``let!`` (Stream.TryOpenAsync(partition)) )
|> fun openResult -> if openResult.Found then openResult.Stream else Stream(partition)
I just insert the TryOpenAsync as a parameter but it does not work. By saying does not work I mean the whole FSI will hang. So it has something to do with my async/"await".
--- Update:
Result of working code in FSI:
>
Real: 00:00:00.051, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0
val asynWorkflow : Async<StreamOpenResult>
val stream : Stream
Result of not working code in FSI:
>
And you cannot execute anything in the FSI anymore
--- Update 2
I'm using Streamstone. Here the C# example: https://github.com/yevhen/Streamstone/blob/master/Source/Example/Scenarios/S04_Write_to_stream.cs
and here the Stream.TryOpenAsync: https://github.com/yevhen/Streamstone/blob/master/Source/Streamstone/Stream.Api.cs#L192
I can't tell you why the second example doesn't work without knowing what Stream and partition are and how they work.
However, I want to take this opportunity to point out that the two examples are not strictly equivalent.
F# async is kind of like a "recipe" for what to do. When you write async { ... }, the resulting computation is just sitting there, not actually doing anything. It's more like declaring a function than like issuing a command. Only when you "start" it by calling something like Async.RunSynchronously or Async.Start does it actually run. A corollary is that you can start the same async workflow multiple times, and it's going to be a new workflow every time. Very similar to how IEnumerable works.
C# Task, on the other hand, is more like a "reference" to an async computation that is already running. The computation starts as soon as you call Stream.TryOpenAsync(partition), and it's impossible to obtain a Task instance before the task actually starts. You can await the resulting Task multiple times, but each await will not result in a fresh attempt to open a stream. Only the first await will actually wait for the task's completion, and every subsequent one will just return you the same remembered result.
In the async/reactive lingo, F# async is what you call "cold", while C# Task is referred to as "hot".
The second code block looks like it should work to me. It does run it if I provide dummy implementations for Stream and StreamOpenResult.
You should avoid using Async.RunSynchronously wherever possible because it defeats the purpose of async. Put all of this code within a larger async block and then you will have access to the StreamOpenResult:
async {
let! openResult = Stream.TryOpenAsync(partition) |> Async.AwaitTask
let stream = if openResult.Found then openResult.Stream else Stream(partition)
return () // now do something with the stream
}
You may need to put a Async.Start or Async.RunSynchronously at the very outer edge of your program to actually run it, but it's better if you have the async (or convert it to a Task) and pass it to some other code (e.g. a web framework) that can call it in a non-blocking manner.
Not that I want to answer your question with another question, but: why are you doing code like this anyway? That might help to understand it. Why not just:
let asyncWorkflow = async {
let! result = Stream.TryOpenAsync(partition) |> Async.AwaitTask
if result.Found then return openResult.Stream else return Stream(partition) }
There's little point in creating an async workflow only to immediately call RunSynchronously on it - it's similar to calling .Result on a Task - it just blocks the current thread until the workflow returns.

How run in background a blocking call in F#?

I need to call in the background a API that call a webservice. I don't wish to turn the (very complex) method to async, just say "do all this on the background".
But I'm lost in how do this with F#. This is what I have:
let task = async {
let result = SyncApi.syncData(login.url, login.zone, login.user, login.pwd) <-- THIS MUST RUN IN BACKGROUND...
match result with
|Some(msg) -> failwith msg
| None -> ()
}
task
|> Async.Catch
|> Async.RunSynchronously
|> fun x ->
match x with
| Choice1Of2 x -> rootPage.Navigation.PopToRootAsync(true) |> ignore
| Choice2Of2 ex -> showMsgError(ex.Message)
If you're looking for simple fire and forget style to start the API call an don't use the result on the current thread, Async.Start(task) might be what you're looking for. It takes the Async workflow, starts it on a thread pool and immediately returns so that your method can continue.
But seeing that you need the result to either change navigation or show an error message, you might need to call the SyncApi synchronously on the current thread and wait for its result.
Alternatively, if your application model allows it, you can do something like this:
(* Define the task including error handling. *)
let task = async {
let result = SyncApi.syncData(login.url, login.zone, login.user, login.pwd)
match result with
| Some msg ->
(* This may have to be posted back to the UI context.
Correct way depends on technology (Xamarin vs. WPF vs. MVC...) *)
showMsgError msg
| None -> ()
}
(* Fire and forget the async API call. *)
Async.Start(task)
(* Optimistically navigate away immediately,
while `task` may still be in progress. *)
rootPage.Navigation.PopToRootAsync(true) |> ignore
This will start the task on a thread pool, navigate away, but in case the async task failed, it will trigger the error message. However it assumes that your application can show the error message asynchronously for example as a popup, not only in the context of the page that started the task.

F# handling Task cancellation

I am struggling to understand why some code is never executed.
Consider this extension method:
type WebSocketListener with
member x.AsyncAcceptWebSocket = async {
try
let! client = Async.AwaitTask <| x.AcceptWebSocketAsync Async.DefaultCancellationToken
if(not (isNull client)) then
return Some client
else
return None
with
| :? System.Threading.Tasks.TaskCanceledException ->
| :? AggregateException ->
return None
}
I know that AcceptSocketAsync throws a TaskCanceledException when the cancellation token is canceled. I have checked in a C# application. The idea is to return None.
However, that never happens. If I put a breakpoint in the last return None or even in the if expression it never stops there when the cancellation token has been cancelled. And I know it is awaiting in the Async.AwaitTask because if before cancelling, other client connects, it works and it stops in the breakpoints.
I am a little bit lost, why is the exception lost?
Cancellation uses a special path in F# asyncs - Async.AwaitTask will re-route execution of cancelled task to the cancellation continuation. If you want different behavior - you can always do this by manually:
type WebSocketListener with
member x.AsyncAcceptWebSocket = async {
let! ct = Async.CancellationToken
return! Async.FromContinuations(fun (s, e, c) ->
x.AcceptWebSocketAsync(ct).ContinueWith(fun (t: System.Threading.Tasks.Task<_>) ->
if t.IsFaulted then e t.Exception
elif t.IsCanceled then s None // take success path in case of cancellation
else
match t.Result with
| null -> s None
| x -> s (Some x)
)
|> ignore
)
}

Resources