Load Testing (@lefthandedgoat)

gistfile1.fs

open System.Net
open Microsoft.FSharp.Control.WebExtensions
open System.Diagnostics
open System

let fetch name (url:string) =    
    printfn "fetching %s" name
    let uri = new System.Uri(url)
    use webClient = new WebClient()
    let stopwatch = Stopwatch()
    stopwatch.Start()
    let html = webClient.DownloadString(uri)
    stopwatch.Stop()
    stopwatch.Elapsed.Milliseconds

let random = Random()

let microsoft () = fetch "Microsoft.com" "http://localhost:52101"
let msdn () = fetch "MSDN" "http://localhost:52101"
let bing () = fetch "Bing" "http://localhost:52101"
let duckduckgo () = fetch "Duck Duck Go" "http://localhost:52101"
let yahoo () = fetch "Yahoo" "http://localhost:52101"
let google () = fetch "Google" "http://localhost:52101"

type work =   
    | Die   
    | Goto of (unit -> int)
    | Sleep of int * int
    | Done

type report =
    | Stats of int
    | Instructions of AsyncReplyChannel<int>
    | Die    

type worker = { id : int; worker : MailboxProcessor<work> }

type manage =
    | Enlist of worker
    | Go
    | Done of int
    | Die

type result = { milliseconds : int }

let doWork (w : MailboxProcessor<work>) =
    w.Post(Sleep(100,200))
    w.Post(Goto(microsoft))
    w.Post(Sleep(1000,4000))
    w.Post(Goto(msdn))
    w.Post(Sleep(1005,2000))
    w.Post(Goto(bing))
    w.Post(Sleep(2000,3000))
    w.Post(Goto(duckduckgo))
    w.Post(Sleep(1000,2000))
    w.Post(Goto(yahoo))
    w.Post(Sleep(400,600))
    w.Post(Goto(google))
    w.Post(work.Done)

let accountant () =
    MailboxProcessor.Start(fun inbox ->
        let rec loop nums =   
            async { let! msg = inbox.Receive()   
                    match msg with   
                    | report.Die -> return ()
                    | Instructions(reply) -> 
                        if List.isEmpty nums then
                            reply.Reply(0)
                            return! loop []
                        else
                            let head = List.head nums
                            reply.Reply(head)
                            return! loop <| List.tail nums
                    | Stats(ms) -> 
                        printfn "done in: %i" ms
                        return! loop nums }   
        loop [1 .. 50])

let manager (accountant : MailboxProcessor<report>) =
    MailboxProcessor.Start(fun inbox ->
        let rec loop (workers : worker list) (busyWorkers : worker list) =   
            async { let! msg = inbox.Receive()   
                    match msg with   
                    | manage.Die -> return ()
                    | manage.Go ->
                        let worker = List.head workers
                        doWork worker.worker
                        return! loop (List.tail workers) ([worker] @ busyWorkers)
                    | manage.Enlist(worker) -> 
                        let workers = [worker] @ workers
                        return! loop workers busyWorkers
                    | manage.Done(id) -> 
                        let! numberOfNeededWorkers = accountant.PostAndAsyncReply(Instructions) 
                        printfn "adding %i workers" numberOfNeededWorkers                        
                        let worker = busyWorkers |> List.find (fun w -> w.id = id)
                        let workers = [worker] @ workers
                        let aboutToBeBusy = workers |> Seq.take numberOfNeededWorkers |> List.ofSeq                        

                        aboutToBeBusy |> List.iter (fun w -> doWork w.worker)
                        let busyWorkers = aboutToBeBusy @ busyWorkers
                        let workers = 
                            workers
                            |> Seq.skip numberOfNeededWorkers
                            |> List.ofSeq
                        return! loop workers busyWorkers }
        loop [] [])

let worker (id : int) (accountant : MailboxProcessor<report>) (manager : MailboxProcessor<manage>) =   
    MailboxProcessor.Start(fun inbox ->
        let rec loop ms =   
            async { let! msg = inbox.Receive()   
                    match msg with   
                    | work.Die -> return ()
                    | Sleep(from, too) ->
                        let milliseconds = random.Next(from, too)
                        do! Async.Sleep(milliseconds)
                        return! loop ms
                    | Goto(func) ->
                        return! loop <| func () + ms 
                    | work.Done ->
                        accountant.Post(Stats(ms))
                        manager.Post(Done(id))
                        return! loop 0 }
        loop 0)  

let accnt = accountant ()
let mgr = manager accnt

let workers =
    [ 1 .. 5000 ]
    |> List.map (fun id -> { id = id; worker = worker id accnt mgr })

workers |> List.iter (fun w -> mgr.Post(Enlist(w)))  

mgr.Post(Go)

System.Console.ReadKey()

workers |> List.iter (fun w -> w.worker.Post(work.Die))
accnt.Post(report.Die)
mgr.Post(manage.Die)

System.Console.ReadKey()