F# handling Task cancellation - asynchronous

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
)
}

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.

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.

Async.TryCancelled doesn't work with Async.RunSynchronously

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

Unexpected behavior with exception handling in async, possible bug?

I have stumbled upon a problem when calling a nested Async which happens to be null. An exception is raised but it can't be catched with any of the normal exception handling methods Async workflows provide.
The following is a simple test which reproduces the problem:
[<Test>]
let ``Nested async is null with try-with``() =
let g(): Async<unit> = Unchecked.defaultof<Async<unit>>
let f = async {
try
do! g()
with e ->
printf "%A" e
}
f |> Async.RunSynchronously |> ignore
which results in the follwing exception:
System.NullReferenceException : Object reference not set to an instance of an object.
at Microsoft.FSharp.Control.AsyncBuilderImpl.bindA#714.Invoke(AsyncParams`1 args)
at <StartupCode$FSharp-Core>.$Control.loop#413-40(Trampoline this, FSharpFunc`2 action)
at Microsoft.FSharp.Control.Trampoline.ExecuteAction(FSharpFunc`2 firstAction)
at Microsoft.FSharp.Control.TrampolineHolder.Protect(FSharpFunc`2 firstAction)
at Microsoft.FSharp.Control.AsyncBuilderImpl.startAsync(CancellationToken cancellationToken, FSharpFunc`2 cont, FSharpFunc`2 econt, FSharpFunc`2 ccont, FSharpAsync`1 p)
at Microsoft.FSharp.Control.CancellationTokenOps.starter#1121-1.Invoke(CancellationToken cancellationToken, FSharpFunc`2 cont, FSharpFunc`2 econt, FSharpFunc`2 ccont, FSharpAsync`1 p)
at Microsoft.FSharp.Control.CancellationTokenOps.RunSynchronously(CancellationToken token, FSharpAsync`1 computation, FSharpOption`1 timeout)
at Microsoft.FSharp.Control.FSharpAsync.RunSynchronously(FSharpAsync`1 computation, FSharpOption`1 timeout, FSharpOption`1 cancellationToken)
at Prioinfo.Urkund.DocCheck3.Core2.Tests.AsyncTests.Nested async is null with try-with() in SystemTests.fs: line 345
I really think the exception should be caught in this case, or is this really the expected behavior? (I'm using Visual Studio 2010 Sp1 for the record)
Also, Async.Catch and Async.StartWithContinuations exhibits the same problem as demonstrated by these test cases:
[<Test>]
let ``Nested async is null with Async.Catch``() =
let g(): Async<unit> = Unchecked.defaultof<Async<unit>>
let f = async {
do! g()
}
f |> Async.Catch |> Async.RunSynchronously |> ignore
[<Test>]
let ``Nested async is null with StartWithContinuations``() =
let g(): Async<unit> = Unchecked.defaultof<Async<unit>>
let f = async {
do! g()
}
Async.StartWithContinuations(f
, fun _ -> ()
, fun e -> printfn "%A" e
, fun _ -> ())
It seems the exception is raised within the bind-method in the workflow builder and my guess is that as a result the normal error handling code is bypassed. It looks like a bug in the implementation of async workflows to me since I haven't found anything in the documentation or elsewhere which suggest that this is the intended behavior.
It is pretty easy to work around in most cases I think so it's not a huge problem for me at least but it is a bit unsettling since it means that you can't completely trust the async exception handling mechanism to be able to capture all exceptions.
Edit:
After giving it some thought I agree with kvb. Null asyncs should not really exist in normal code and could really only be produced if you do something you probably shouldn't (such as using Unchecked.defaultOf) or use reflection to produce the values (in my case it was a mocking framework involved). Thus it's not really a bug but more of an edge case.
I don't think it's a bug. As the name indicates Unchecked.defaultof<_> does not check that the values it produces are valid, and Async<unit> does not support null as a proper value (e.g. see the message if you try to use let x : Async<unit> = null). Async.Catch and the like are intended to catch exceptions thrown within asynchronous computations, not exceptions caused by sneaking behind the compiler's back and creating invalid asynchronous computations.
I fully agree with kvb - when you initialize a value using Unchecked.defaultOf, it means that the behaviour of using the value may be undefined, so this cannot be treated as bug. In practice, you don't have to worry about it, because you should never get null values of Async<'T> type.
To add some more details, the exception cannot be handled, because the translation looks as follows:
async.TryWith
( async.Bind ( Unchecked.defaultof<_>,
fun v -> async { printfn "continued" } ),
fun e -> printfn "%A" e)
The exception is thrown from the Bind method before the workflow returned by Bind is started (it happens after you call RunSynchronously, because the workflow is wrapped using Delay, but it happens outside of the workflow execution). If you want to handle this kinds of exceptions (arising from incorrectly constructed workflows), you can write a version of TryWith that runs the workflow and handles exceptions thrown outside of the execution:
let TryWith(work, handler) =
Async.FromContinuations(fun (cont, econt, ccont) ->
try
async { let! res = work in cont res }
|> Async.StartImmediate
with e ->
async { let! res = handler e in cont res }
|> Async.StartImmediate )
Then you can handle exceptions like this:
let g(): Async<unit> = Unchecked.defaultof<Async<unit>>
let f =
TryWith
( (async { do! g() }),
(fun e -> async { printfn "error %A" e }))
f |> Async.RunSynchronously

Resources