How to ensure Async.StartChild is started before continuing? - asynchronous

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.

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.

F# events not working inside Async workflow

I want to do a Post-Fire-Reply to an agent. Basically the agent triggers an event then replies to the caller. However I either keep getting a timeout error or the events do not fire correctly. I tried doing Post-Fire, that stopped the timeout errors but the events do not fire.
let evt = new Event<int>()
let stream = evt.Publish
type Agent<'T> = MailboxProcessor<'T>
type Fire = Fire of int
let agent = Agent.Start(fun inbox ->
let rec loop() = async {
let! msg = inbox.Receive()
let (Fire i) = msg
evt.Trigger i }
loop())
let on i fn =
stream
|> Observable.filter (fun x -> x = i)
|> Observable.filter (fun x -> x <> 1)
|> Observable.subscribe (fun x -> fn x)
let rec collatz n =
printfn "%d" n
on n (fun i ->
if (i % 2 = 0) then collatz (i/2)
else collatz (3*n + 1)) |> ignore
agent.Post (Fire n) // this does not work
// evt.Trigger n // this does works
collatz 13
This is a simple experiment that repeatedly creates a function to find the next number in the Collatz series and then calls itself to return the value until it reaches 1.
What seems to happen is that the trigger only fires once. I tried experimenting with every combination of Async.RunSynchronously / Async.Start / StartChild / SynchronizationContext that I could think of but no progress. I found a blog similar to what I am doing but that didn't help me neither
EDIT
Thank you Fyodor Soikin for pointing out my oversight. The original problem still remains in that I wish to both fire events and reply with a result, but get a timeout.
let evt = new Event<int>()
let stream = evt.Publish
type Agent<'T> = MailboxProcessor<'T>
type Command =
| Fire of int
| Get of int * AsyncReplyChannel<int>
let agent = Agent.Start(fun inbox ->
let rec loop() = async {
let! msg = inbox.Receive()
match msg with
| Fire i -> evt.Trigger i
| Get (i,ch) ->
evt.Trigger i
ch.Reply(i)
return! loop() }
loop())
let on i fn =
stream
|> Observable.filter (fun x -> x = i)
|> Observable.filter (fun x -> x <> 1)
|> Observable.subscribe (fun x -> fn x)
let rec collatz n =
printfn "%d" n
on n (fun i ->
if (i % 2 = 0) then collatz (i/2)
else collatz (3*n + 1)) |> ignore
agent.PostAndReply (fun ch -> (Get (n, ch))) |> ignore // timeout
agent.PostAndAsyncReply (fun ch -> (Get (n, ch))) |> Async.Ignore |> Async.Start // works but I need the result
agent.PostAndAsyncReply (fun ch -> (Get (n, ch))) |> Async.RunSynchronously |> ignore // timeout
collatz 13
Your loop function doesn't loop. It receives the first message, triggers the event, and then just... exits. Never attempts to receive a second message.
You need to make that function work continuously: process the first message, then go right back to receive the next one, then go receive the next one, and so on. Like this:
let agent = Agent.Start(fun inbox ->
let rec loop() = async {
let! msg = inbox.Receive()
let (Fire i) = msg
evt.Trigger i
return! loop() }
loop())
Edit
Since you've reached your limit on questions, I will answer your edit here.
The reason you're getting timeouts in your second snippet is that you have a deadlock in your code. Let's trace the execution to see that.
THREAD 1: The agent is started.
THREAD 2: The first collatz call.
THREAD 2: The first collatz call posts a message to the agent.
THREAD 1: The agent receives the message.
THREAD 1: The agent triggers the event.
THREAD 1: As a result of the event, the second collatz call happens.
THREAD 1: The second collatz call posts a message to the agent.
THREAD 1: The second collatz call starts waiting for the agent to respond.
And this is where the execution ends. The agent cannot respond at this point (in fact, it cannot even receive the next message!), because its instruction pointer is still inside evt.Trigger. The evt.Trigger call hasn't yet returned, so the loop function hasn't yet recursed, so the inbox.Receive function hasn't yet been called, so the second message is still waiting in the agent's queue.
So you get yourself a classic deadlock: collatz is waiting for the agent to receive its message, but the agent is waiting for collatz to finish handling the event.
The simplest, dumbest solution to this would be to just trigger the event asynchronously:
async { evt.Trigger i } |> Async.Start
This will make sure that the event handler is executed not "right there", but asynchronously, possibly on a different thread. This will in turn allow the agent not to wait for the event to be processed before it can continue its own execution loop.
In general though, when dealing with multithreading and asynchrony, one should never call unknown code directly. The agent should never directly call evt.Trigger, or anything else that it doesn't control, because that code might be waiting on the agent itself (which is what happened in your case), thus introducing the deadlock.

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

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

Monadic Retry logic w/ F# and async?

I've found this snippet:
http://fssnip.net/8o
But I'm working not only with retriable functions, but also with asynchronous such, and I was wondering how I make this type properly. I have a tiny piece of retryAsync monad that I'd like to use as a replacement for async computations, but that contains retry logic, and I'm wondering how I combine them?
type AsyncRetryBuilder(retries) =
member x.Return a = a // Enable 'return'
member x.ReturnFrom a = x.Run a
member x.Delay f = f // Gets wrapped body and returns it (as it is)
// so that the body is passed to 'Run'
member x.Bind expr f = async {
let! tmp = expr
return tmp
}
member x.Zero = failwith "Zero"
member x.Run (f : unit -> Async<_>) : _ =
let rec loop = function
| 0, Some(ex) -> raise ex
| n, _ ->
try
async { let! v = f()
return v }
with ex -> loop (n-1, Some(ex))
loop(retries, None)
let asyncRetry = AsyncRetryBuilder(4)
Consuming code is like this:
module Queue =
let desc (nm : NamespaceManager) name = asyncRetry {
let! exists = Async.FromBeginEnd(name, nm.BeginQueueExists, nm.EndQueueExists)
let beginCreate = nm.BeginCreateQueue : string * AsyncCallback * obj -> IAsyncResult
return! if exists then Async.FromBeginEnd(name, nm.BeginGetQueue, nm.EndGetQueue)
else Async.FromBeginEnd(name, beginCreate, nm.EndCreateQueue)
}
let recv (client : MessageReceiver) timeout =
let bRecv = client.BeginReceive : TimeSpan * AsyncCallback * obj -> IAsyncResult
asyncRetry {
let! res = Async.FromBeginEnd(timeout, bRecv, client.EndReceive)
return res }
Error is:
This expression was expected to have type Async<'a> but here has type 'b -> Async<'c>
Your Bind operation behaves like a normal Bind operation of async, so your code is mostly a re-implementation (or wrapper) over async. However, your Return does not have the right type (it should be 'T -> Async<'T>) and your Delay is also different than normal Delay of async. In general, you should start with Bind and Return - using Run is a bit tricky, because Run is used to wrap the entire foo { .. } block and so it does not give you the usual nice composability.
The F# specification and a free chapter 12 from Real-World Functional Programming both show the usual types that you should follow when implementing these operations, so I won't repeat that here.
The main issue with your approach is that you're trying to retry the computation only in Run, but the retry builder that you're referring to attempts to retry each individual operation called using let!. Your approach may be sufficient, but if that's the case, you can just implement a function that tries to run normal Async<'T> and retries:
let RetryRun count (work:Async<'T>) = async {
try
// Try to run the work
return! work
with e ->
// Retry if the count is larger than 0, otherwise fail
if count > 0 then return! RetryRun (count - 1) work
else return raise e }
If you actually want to implement a computation builder that will implicitly try to retry every single asynchronous operation, then you can write something like the following (it is just a sketch, but it should point you in the right direction):
// We're working with normal Async<'T> and
// attempt to retry it until it succeeds, so
// the computation has type Async<'T>
type RetryAsyncBuilder() =
member x.ReturnFrom(comp) = comp // Just return the computation
member x.Return(v) = async { return v } // Return value inside async
member x.Delay(f) = async { return! f() } // Wrap function inside async
member x.Bind(work, f) =
async {
try
// Try to call the input workflow
let! v = work
// If it succeeds, try to do the rest of the work
return! f v
with e ->
// In case of exception, call Bind to try again
return! x.Bind(work, f) }

Resources