I am using F# mailBoxProcessor to asynchronously process messages received from multiple network ends.
The code works as expected until I added function call getTreasuryYield after inbox.receive().
It gets stuck every time at inbox.receive() after running for a few seconds.
GetTreasuryYield is a quite slow method since it involves database and IO operations, but I
still do not understand how it gets stuck.
Any HELP will be appreciated.
let start rvSetting (agent:Agent<Message>) messageSelector=
try
TIBCO.Rendezvous.Environment.Open()
let _transport = new NetTransport(rvSetting.rvService, rvSetting.rvNetwork, rvSetting.rvDaemon)
let _listener = new Listener(TIBCO.Rendezvous.Queue.Default, _transport, rvSetting.rvSubject, null)
_listener.MessageReceived.Add(fun args->
printfn "before sent"
if messageSelector(args.Message) then
printfn "Message sent to agent: %A" args.Message
agent.Post(args.Message))
let rec dispatch() =
async{
try
TIBCO.Rendezvous.Queue.Default.Dispatch()
return! dispatch()
with
| e -> _log.Error(e.ToString())
}
Async.Start(dispatch())
with
|e -> printfn "%A" e.Message
_log.Error(e.Message)
let agent = new Agent<Message>(fun inbox ->
let rec loop() =
async{
let! (m : Message) = inbox.Receive()
// This line causes the problem
printfn "%A" (getTreasuryYieldFromMessage m)
Async.Start(treasuryAction m)
return! loop()
}
loop())
agent.Error.Add raise
[<EntryPoint>]
let main argv =
//start rvCorporate agent (fun x -> true)
agent.Start()
start rvTreasury agent treasurySelector
Console.ReadLine() |> ignore
0
Related
Building on a snippet and answer, would it be possible to return results to the caller from the throttling queue? I've tried PostAndAsyncReply to receive reply on a channel but it's throwing an error if I pipe it with Enqueue. Here's the code.
Appreciate a F# core vanilla based solution around Queue or Mailbox design patterns.
Question
The question is to be able to call functions asynchronously based on the throttle (max 3 at a time), passing each item from the array, wait on the whole queue/array until it's finished while collecting all the results and then return the results to the caller. (Return the results to the caller is what's pending in here)
Callee Code
// Message type used by the agent - contains queueing
// of work items and notification of completion
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
/// Represents an agent that runs operations in concurrently. When the number
/// of concurrent operations exceeds 'limit', they are queued and processed later
let throttlingAgent limit =
MailboxProcessor.Start(fun inbox ->
async {
// The agent body is not executing in parallel,
// so we can safely use mutable queue & counter
let queue = System.Collections.Generic.Queue<Async<unit>>()
let running = ref 0
while true do
// Enqueue new work items or decrement the counter
// of how many tasks are running in the background
let! msg = inbox.Receive()
match msg with
| Completed -> decr running
| Enqueue w -> queue.Enqueue(w)
// If we have less than limit & there is some work to
// do, then start the work in the background!
while running.Value < limit && queue.Count > 0 do
let work = queue.Dequeue()
incr running
do! // When the work completes, send 'Completed'
// back to the agent to free a slot
async {
do! work
inbox.Post(Completed)
}
|> Async.StartChild
|> Async.Ignore
})
let requestDetailAsync (url: string) : Async<Result<string, Error>> =
async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? WebException as e ->
return Error {Code = "500"; Message = "Internal Server Error"; Status = HttpStatusCode.InternalServerError}
}
let requestMasterAsync() : Async<Result<System.Collections.Concurrent.ConcurrentBag<_>, Error>> =
async {
let urls = [|
"http://www.example.com/1";
"http://www.example.com/2";
"http://www.example.com/3";
"http://www.example.com/4";
"http://www.example.com/5";
"http://www.example.com/6";
"http://www.example.com/7";
"http://www.example.com/8";
"http://www.example.com/9";
"http://www.example.com/10";
|]
let results = System.Collections.Concurrent.ConcurrentBag<_>()
let agent = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> Enqueue
|> agent.Post
return Ok results
}
Caller Code
[<TestMethod>]
member this.TestRequestMasterAsync() =
match Entity.requestMasterAsync() |> Async.RunSynchronously with
| Ok result -> Console.WriteLine result
| Error error -> Console.WriteLine error
You could use Hopac.Streams for that. With such tool it is pretty trivial:
open Hopac
open Hopac.Stream
open System
let requestDetailAsync url = async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? Exception as e ->
return Error e
}
let requestMasterAsync() : Stream<Result<string,exn>> =
[| "http://www.example.com/1"
"http://www.example.com/2"
"http://www.example.com/3"
"http://www.example.com/4"
"http://www.example.com/5"
"http://www.example.com/6"
"http://www.example.com/7"
"http://www.example.com/8"
"http://www.example.com/9"
"http://www.example.com/10" |]
|> Stream.ofSeq
|> Stream.mapPipelinedJob 3 (requestDetailAsync >> Job.fromAsync)
requestMasterAsync()
|> Stream.iterFun (printfn "%A")
|> queue //prints all results asynchronously
let allResults : Result<string,exn> list =
requestMasterAsync()
|> Stream.foldFun (fun results cur -> cur::results ) []
|> run //fold stream into list synchronously
ADDED
In case you want to use only vanilla FSharp.Core with mailboxes only try this:
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
let inline (>>=) x f = async.Bind(x, f)
let inline (>>-) x f = async.Bind(x, f >> async.Return)
let throttlingAgent limit =
let agent = MailboxProcessor.Start(fun inbox ->
let queue = System.Collections.Generic.Queue<Async<unit>>()
let startWork work =
work
>>- fun _ -> inbox.Post Completed
|> Async.StartChild |> Async.Ignore
let rec loop curWorkers =
inbox.Receive()
>>= function
| Completed when queue.Count > 0 ->
queue.Dequeue() |> startWork
>>= fun _ -> loop curWorkers
| Completed ->
loop (curWorkers - 1)
| Enqueue w when curWorkers < limit ->
w |> startWork
>>= fun _ -> loop (curWorkers + 1)
| Enqueue w ->
queue.Enqueue w
loop curWorkers
loop 0)
Enqueue >> agent.Post
It is pretty much the same logic, but slightly optimized to not use queue if there is free worker capacity (just start job and don't bother with queue/dequeue).
throttlingAgent is a function int -> Async<unit> -> unit
Because we don't want client to bother with our internal ThrottlingAgentMessage type.
use like this:
let throttler = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> throttler
Is it possible to wait on the mailboxprocessor, following code works in F# interactive but is there a way to wait on it in an application or a unit test?
[<TestMethod>]
member this.TestMailboxProcessor() =
let mailboxProcessor = MailboxProcessor<string>.Start(fun inbox ->
async {
while true do
let! msg = inbox.Receive()
printfn "agent got message %s" msg // too late, UnitTest exits
}
)
mailboxProcessor.Post "ping"
Console.WriteLine "message posted" // I see this in the console
Assert.IsTrue(true)
It's not possible in exactly this scenario, but you can define your message type to include an AsyncReplyChannel<'t>, which then allows you to use MailboxProcessor.PostAndReply instead of Post. This way the calling code can (either synchronously or asynchronously) wait for a response value, or at least an indication that the processing is done.
Your modified source code may look like this:
[<TestMethod>]
member this.TestMailboxProcessor() =
let mailboxProcessor =
MailboxProcessor<string * AsyncReplyChannel<unit>>.Start(fun inbox ->
async {
while true do
let! msg, replyChannel = inbox.Receive()
printfn "agent got message %s" msg
(*
Reply takes a value of the generic param of
AsyncReplyChannel<'t>, in this case just a unit
*)
replyChannel.Reply()
}
)
(*
You can't create an AsyncReplyChannel<'t> value, but this does it for you.
Also always, always use timeouts when awaiting message replies.
*)
mailboxProcessor.PostAndReply(
(fun replyChannel -> "ping", replyChannel),
timeout = 1000)
(* This gets printed only after the message has been posted and processed *)
Console.WriteLine "message posted"
Assert.IsTrue(true)
MailboxProcessors are a bit tricky topic though, so make sure you always use timeouts, otherwise in case of errors in your code, or exceptions killing the message loop, your code would hang forever. Not good in tests, even worse in production.
You should use PostAndAsyncReply or PostAndReply (blocking version)
let replyAgent = MailboxProcessor.Start(fun inbox ->
let rec loop() =
async {
let! (replyChannel: AsyncReplyChannel<_>), msg = inbox.Receive()
replyChannel.Reply (sprintf "replied for message: %A" msg)
return! loop()
}
loop() )
let reply = replyAgent.PostAndReply(fun replCh -> replCh, "Hi")
printfn "%s" reply //prints "replied for message: Hi"
I've written this f# echo server:
open System.Net
open System.Net.Sockets
open System.IO
open System
open System.Text
open System.Collections.Generic
let addr = IPAddress.Parse("127.0.0.1")
let listener = new TcpListener(addr, 2000)
listener.Start()
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
if not(line=null) then
match line with
|"quit"->
sr.Close()
sw.Close()
c.Close()
|_ ->
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
else
sr.Close()
sw.Close()
c.Close()
}
let loop()=async {
while true do
let c=listener.AcceptTcpClient()
let d = c.GetStream()
let sr = new StreamReader(d)
let sw = new StreamWriter(d)
sw.AutoFlush<-true
Async.Start(loop2(c,sr,sw))
}
Async.RunSynchronously(loop())
This program can do:
echo the client's message
when client said 'left',return 'right'
when client said 'quit',close the connection
but when I run the programming,when a client sent 'left',get 'right',and sent 'quit',i got this exception:
not handled exception: System.ObjectDisposedException: (con't write
to closed) TextWriter。 in
Microsoft.FSharp.Control.CancellationTokenOps.Start#1192-1.Invoke(Exception
e) in .$Control.loop#419-40(Trampoline this,
FSharpFunc2 action) in
Microsoft.FSharp.Control.Trampoline.ExecuteAction(FSharpFunc2
firstAction) in
Microsoft.FSharp.Control.TrampolineHolder.Protect(FSharpFunc`2
firstAction) in
.$Control.-ctor#476-1.Invoke(Object state) in
System.Threading.QueueUserWorkItemCallback.WaitCallback_Context(Object
state) in
System.Threading.ExecutionContext.RunInternal(ExecutionContext
executionContext, ContextCallback callback, Object state,
BooleanpreserveSyncCtx) in
System.Threading.ExecutionContext.Run(ExecutionContext
executionContext, ContextCallback callback, Object state, Boolean
preserveSyncCtx) in
System.Threading.QueueUserWorkItemCallback.System.Threading.IThreadPoolWorkItem.ExecuteWorkItem()
in System.Threading.ThreadPoolWorkQueue.Dispatch() in
System.Threading._ThreadPoolWaitCallback.PerformWaitCallback() . .
.(press any key to continue)
Screenshot of program in action
Screenshot of exception
how can i fix this problem?
The problem is that, unlike what you might expect from its namesake in imperative languages, return in a computation expression doesn't short-circuit. So once the return! in the if line.Equals("right") returns, ie. after the socket has been closed, the code after the if block is run and tries to write to the closed socket. The fix is to put those two lines in an else:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
As an additional style tip, this whole body can be implemented as a match:
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
match line with
| null | "quit" ->
sr.Close()
sw.Close()
c.Close()
| "left" ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
| _ ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
}
The problem in your code is here:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
If a "left" is received, it writes "right" and then executes nested loop2s until a "quit" is received. Then, after all of that is complete, it tries to write line and execute more nested loop2s. Of course, by this point, you have disposed of the connection, hence the exception.
It seems like writing line should be in an else block, which would prevent the error:
if line.Equals("left") then
sw.WriteLine("right")
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
Of course, you can also integrate this check with your pattern match. The example below will handle the null checking and each string option all in one structure.
let line = Option.ofObj <| sr.ReadLine()
match line with
|None
|Some("quit") ->
sr.Close()
sw.Close()
|Some("left") ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
|Some(line) ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
Note that your async block is completely useless because you have simply used blocking functions such as AcceptTcpClient(), ReadLine() and WriteLine(). Putting these functions inside an async block does not magically make them asynchronous. If you want to work asynchronously, it has to be async all the way down.
I'm guessing your objective here is to asynchronously accept clients as they arrive, handling each client asynchronously within a different function.
Most of the .NET API in this area is written in terms of Task<'T> rather than the F#-specific async<'T>, so I would recommend creating some helper functions:
let writeLineAsync (sw:StreamWriter) (text : string) =
sw.WriteLineAsync(text).ContinueWith(fun t -> ())
|> Async.AwaitTask
let readLineAsync (sr:StreamReader) =
sr.ReadLineAsync()
|> Async.AwaitTask
let acceptClientAsync (l : TcpListener) =
l.AcceptTcpClientAsync()
|> Async.AwaitTask
Then you can create a properly asynchronous version:
let rec handleClient (c:TcpClient) (sr:StreamReader) (sw:StreamWriter) =
async {
let! line = readLineAsync sr
match Option.ofObj(line) with
|None
|Some("quit")->
sr.Close()
sw.Close()
|Some("left") ->
do! writeLineAsync sw "right"
return! loop2(c,sr,sw)
|Some(line) ->
do! writeLineAsync sw line
return! loop2(c,sr,sw)
}
let loop() =
async {
let! c = acceptClientAsync listener
let sr = new StreamReader(c.GetStream())
let sw = new StreamWriter(c.GetStream())
sw.AutoFlush <- true
do! handleClient c sr sw |> Async.StartChild |> Async.Ignore
return! loop()
}
Background.
I am trying to figure out MailboxProcessor. The idea is to use it as a some kind of state machine and pass arguments around between the states and then quit. Some parts are going to have async communication so I made a Sleep there.
It's a console application, making a Post does nothing because main thread quits and kills everything behind it. I am making a PostAndReply in main.
Also, I have tried without
let sleepWorkflow = async
, doesn't make any difference.
Questions.
(I am probably doing something wrong)
Go24 is not async. Changing RunSynchronously to StartImmediate makes no visible difference. The end should be somewhere below GetMe instead. At the same time Done is printed after Fetch. Isn't the control supposed t be returned to the main thread on sleep?
Go24, wait
go24 1, end
Fetch 1
Done
GetMe
...
Run time is terrible slow. Without delay in Fetch it's about 10s (stopwatch). I thought F# threads are lightweight and should use threadpool.
According to debugger it takes appr 1s to create every and it looks like real threads.
Also, changing to [1..100] will "pause" the program for 100s, according to ProcessExplorer 100 threads are created during that time and only then everything is printed. I would actually prefer fewer threads and slow increase.
Code.
Program.fs
[<EntryPoint>]
let main argv =
let a = Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch 1
let b = Mailbox.MessageBasedCounter.GetMe
let task i = async {
//Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch i
return a
}
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let x =
[1..10]
|> Seq.map task
|> Async.Parallel
|> Async.RunSynchronously
stopWatch.Stop()
printfn "%f" stopWatch.Elapsed.TotalMilliseconds
printfn "a: %A" a
printfn "b: %A" b
printfn "x: %A" x
0 // return an integer exit code
Mailbox.fs
module Mailbox
#nowarn "40"
type parserMsg =
| Go24 of int
| Done
| Fetch of int * AsyncReplyChannel<string>
| GetMe of AsyncReplyChannel<string>
type MessageBasedCounter () =
/// Create the agent
static let agent = MailboxProcessor.Start(fun inbox ->
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
let sleepWorkflow = async{
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone() // POST Done.
printfn "go24 %d, end" n
return! messageLoop()
}
Async.RunSynchronously sleepWorkflow
| Fetch (i, repl) ->
let sync = async{
printfn "Fetch %d" i
do! Async.Sleep 1000
repl.Reply( "Reply Fetch " + i.ToString() ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| GetMe (repl) ->
let sync = async{
printfn "GetMe"
repl.Reply( "GetMe" ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| Done ->
let sync = async{
printfn "Done"
return! messageLoop()
}
Async.RunSynchronously sync
}
// start the loop
messageLoop()
)
// public interface to hide the implementation
static member DoDone () = agent.Post( Done )
static member DoGo24 (i:int) = agent.Post( Go24(i) )
static member DoFetch (i:int) = agent.PostAndReply( fun reply -> Fetch(i, reply) )
static member GetMe = agent.PostAndReply( GetMe )
I'm not necessarily sure that this is the main problem, but the nested asyncs and Async.RunSynchrously in the agent code look suspicious.
You do not need to create a nested async - you can just call asynchronous operations in the body of the match clauses directly:
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n
return! messageLoop()
| Fetch (i, repl) ->
(...)
Aside from that, it is important to understand that the agent has exactly one instance of the body computation running. So, if you block the body of the agent, all other operations will be queued.
If you want to start some task (like the synchronous operations) in the background and resume the agent immediately, you can use Async.Start inside the body (but be sure to call the main loop recursively in the main part of the body):
| Go24 n ->
// Create work item that will run in the background
let work = async {
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n }
// Queue the work in a thread pool to be processed
Async.Start(work)
// Continue the message loop, waiting for other messages
return! messageLoop()
I can't work out why the following code is hanging at the call to GetTotal. I don't seem to be able to debug inside the MailboxProcessor, so it's hard to see what's going on.
module Aggregator
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore
It seems to work fine when using an identical MailboxProcessor directly, rather than wrapping in the Aggregator class.
The problem is that you did not start the agent. You can either call Start after you create the agent:
let myAgent = (...)
do myAgent.Start()
Alternatively, you can create the agent using MailboxProcessor<'T>.Start instead of calling the constructor (I usually prefer this option, because it looks more functional):
let myAgent = MailboxProcessor<Message<'T, 'TState>>.Start(fun inbox -> (...) )
I suppose that you couldn't debug the agent, because the code inside agent wasn't actually running. I tried adding printfn "Msg: %A" message right after the call to Receive inside the agent (to print incoming messages for debugging) and I noticed that, after calling Aggregate, no messages were actually received by the agent... (It only blocked after calling GetTotal, which avaits reply)
As a side-note, I would probably turn GetTotal into a method, so you'd call GetTotal(). Properties are re-evaluated each time you access them, so your code does the same thing, but best practices don't recommend using properties that do complex work.
You forgot to start the mailbox:
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
member m.Start() = myAgent.Start()
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Start()
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore