This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System | |
| let dispose x = (x :> IDisposable).Dispose() | |
| module Workflow = | |
| /// Represents what we will tell the Twilio phone system to do | |
| type PhoneCommand = | |
| /// Connect the caller to a given phone queue | |
| | ConnectToQueue of queueName:string | |
| /// Say the message, and then hangup | |
| | Hangup of msg:string | |
| /// Say the message, then record the caller's message | |
| | TakeMessage of msg:string | |
| /// Say the message, then wait for a user to input a given number of key presses | |
| | WaitForKeypresses of msg:string * numberDigits:int | |
| /// What our workflow returns | |
| type CallHandlingProgram = | |
| | Complete of result:PhoneCommand | |
| | InProgress of result:PhoneCommand * nextStep: (string -> CallHandlingProgram) | |
| /// Use internally for any step where we need to wait for a string | |
| type Internal = NeedKey of PhoneCommand | |
| type CallBuilder() = | |
| // No zero - we must return something | |
| member this.Return(a:PhoneCommand) = Complete a | |
| member this.ReturnFrom(a) = a | |
| member this.Bind(NeedKey(x),f) = InProgress(x, fun x -> f(x) ) | |
| let call = new CallBuilder() | |
| let waitForKeypress msg num = WaitForKeypresses(msg,num) |> NeedKey | |
| module Example = | |
| open Workflow | |
| let listQueuesAndWaitForResponse() = | |
| // We make this recursive so we can try a number of times before bugging out | |
| let rec handleQueues retries = call { | |
| let! keyPress = waitForKeypress "Please press 1 to discuss naughty lists, press 2 to discuss a reindeer malfunction, press 3 for any other enquires" 1 | |
| match keyPress with | |
| | "1" -> return ConnectToQueue "Naughty children" | |
| | "2" -> return ConnectToQueue "Naughty raindeer" | |
| | "3" -> return ConnectToQueue "Account enquires" | |
| | _ -> match retries with | |
| | i when i >= 3 -> return Hangup "Sorry, key not recognised" | |
| | _ -> return! handleQueues (retries+1) | |
| } | |
| handleQueues 0 | |
| let takeCall fromNumber toNumber (now:System.DateTime) = | |
| call { | |
| // 1. If the call is on Christmas Eve or later, leave a message saying we are busy | |
| if now.DayOfYear >= 358 then // 358 is the 24th of December | |
| return Hangup "I'm sorry, we are now shut for the rest of year, happy holidays !" | |
| else | |
| // 2. If the call is out of hours, request a message is left and email it to ourselves | |
| // Elves are 9 to 5 workers | |
| if now.Hour <= 8 || now.Hour >= 17 then | |
| return TakeMessage "I'm sorry, we are closed for the day, please leave a message and we'll get back to you asap" | |
| else | |
| // 3. Offer to talk to elves, or take a mesasge | |
| let! keyPress = waitForKeypress "Please press 1 to talk to one of our elves, or 2 to leave us a message" 1 | |
| match keyPress with | |
| | "1" -> return! listQueuesAndWaitForResponse() | |
| | "2" -> return TakeMessage "Please leave your message after the beep" | |
| | _ -> return Hangup "Happy christmas!" | |
| } | |
| module CallHandling = | |
| type CallDetails = { NumberFrom:string; NumberTo:String; CallAt: DateTime } | |
| with static member Example = { NumberFrom = "0800 123456"; NumberTo = "01-DIAL-SANTA"; CallAt = DateTime(2000,01,01) } | |
| type CallResponse = | |
| | CompletedResponse of Workflow.PhoneCommand | |
| | IntermediateResponse of Workflow.PhoneCommand | |
| type internal CallHandlerMessages = | |
| | CallStarted of AsyncReplyChannel<CallResponse> | |
| | DigitsProvided of string * AsyncReplyChannel<CallResponse> | |
| | PersistToStorage | |
| type internal CallHandlerState = { | |
| CurrentProgram: (string -> Workflow.CallHandlingProgram) option | |
| Digits: string list | |
| } with static member NotStarted = { CurrentProgram = None; Digits = [] } | |
| type CallHandler(callDetails: CallDetails, persistAfter: TimeSpan) = | |
| let getProgram() = Example.takeCall callDetails.NumberFrom callDetails.NumberTo callDetails.CallAt | |
| let stepProgram reply state program = | |
| match program with | |
| | Workflow.Complete(resp) -> | |
| CompletedResponse(resp) |> reply | |
| state | |
| | Workflow.InProgress(resp,next) -> | |
| IntermediateResponse(resp) |> reply | |
| { state with CurrentProgram = Some next } | |
| let resurrectViaReplay digitHistory = | |
| let replayError _ = Workflow.Complete (Workflow.Hangup "Failed to replay history") | |
| let state = CallHandlerState.NotStarted | |
| let rec stepDigits keyPresses program = | |
| match keyPresses with | |
| | [] -> program | |
| | key::other -> match (stepProgram ignore state (program key)).CurrentProgram with | |
| | None -> replayError | |
| | Some s -> stepDigits other s | |
| let nextStep = match (stepProgram ignore state <| getProgram()).CurrentProgram with | |
| | None -> replayError | |
| | Some p -> p | |
| nextStep |> stepDigits (List.rev digitHistory) | |
| let agent = MailboxProcessor<_>.Start( fun inbox -> | |
| let rec messageLoop (state: CallHandlerState) = async { | |
| let! message = inbox.TryReceive(int persistAfter.TotalMilliseconds) | |
| let newState = | |
| match message with | |
| | Some (CallStarted(caller)) -> | |
| stepProgram caller.Reply state <| getProgram() | |
| | Some (DigitsProvided(digits,caller)) -> | |
| let program = match state.CurrentProgram with | |
| | Some program -> program | |
| | None -> resurrectViaReplay state.Digits | |
| let state' = stepProgram caller.Reply state <| program(digits) | |
| { state' with Digits = digits :: state'.Digits } // store for later replay if needed | |
| | Some PersistToStorage | None -> | |
| // production version: persist state.Digits to secure storage | |
| { state with CurrentProgram = None } | |
| return! messageLoop newState } | |
| messageLoop CallHandlerState.NotStarted ) | |
| member x.StartSync() = agent.PostAndReply( CallStarted ) | |
| member x.StepSync(digits) = agent.PostAndReply( fun caller -> DigitsProvided(digits,caller) ) | |
| member internal x.DirectPost(msg) = agent.Post(msg) // For use by the switchboard to post directly to the agent | |
| interface IDisposable with member __.Dispose() = dispose agent | |
| module SwitchBoard = | |
| /// The protocol definiton for interacting with the switch board agent | |
| type private SwitchBoardProtocol<'Id,'Handler when 'Id: comparison and 'Handler :> IDisposable> = | |
| | StoreHandler of id:'Id * handler:'Handler | |
| | FindHandler of id:'Id * reply: AsyncReplyChannel<'Handler option> | |
| | RemoveHandler of id:'Id // This is also responsible for disposing the object | |
| | RequestOfHandler of id:'Id * toRun:( Result<'Handler,string> -> unit ) | |
| /// Object responsible for finding and routing calls to handler by id | |
| /// This is essentially a thread safe Map of handlers which handles disposal | |
| type Switchboard<'Id,'Handler when 'Id: comparison and 'Handler :> IDisposable>() = | |
| let agent = MailboxProcessor<_>.Start( fun inbox -> | |
| let rec messageLoop (state: Map<'Id,'Handler>) = async { | |
| let! message = inbox.Receive() | |
| let newState = match message with | |
| | StoreHandler(id, handler) -> | |
| state.Add(id,handler) | |
| | RemoveHandler(id) -> match state.TryFind(id) with | |
| | None -> state | |
| | Some handler -> | |
| dispose handler | |
| state.Remove(id) | |
| | FindHandler(id, channel) -> | |
| state.TryFind(id) |> channel.Reply | |
| state | |
| | RequestOfHandler(id,f) -> match state.TryFind(id) with | |
| | None -> | |
| Error("Cannot find callId") |> f | |
| state | |
| | Some h -> | |
| Ok(h) |> f | |
| state | |
| return! messageLoop newState | |
| } | |
| messageLoop Map.empty // Kick off the message loop with no open calls | |
| ) | |
| interface IDisposable with member x.Dispose() = dispose agent | |
| member x.StoreHandler(id,handler) = StoreHandler(id,handler) |> agent.Post | |
| member x.FindHandler(id) = agent.PostAndReply( fun channel -> FindHandler(id,channel) ) // TODO: move to Async | |
| member x.RemoveHandler(id) = RemoveHandler(id) |> agent.Post | |
| member x.RequestOfHandler(id, getF) = agent.PostAndReply(fun channel -> RequestOfHandler(id, getF channel )) | |
| module HttpEndpoint = | |
| open CallHandling | |
| open SwitchBoard | |
| type HttpHandler(autoStoreTimeout) = | |
| let switchBoard = new Switchboard<_,_>() | |
| interface IDisposable with member x.Dispose() = dispose switchBoard | |
| member x.StartCall(callId:string, numberFrom, numberTo,callAt) = | |
| // create new object, get first response. | |
| let handler = new CallHandler( { NumberFrom = numberFrom; NumberTo = numberTo; CallAt = callAt }, autoStoreTimeout) | |
| match handler.StartSync() with | |
| | CompletedResponse details as resp -> | |
| resp // If complete we are done, note: we return the the resp to aid testing, in real life we would return details | |
| | IntermediateResponse details as resp -> | |
| do switchBoard.StoreHandler(callId,handler) // We are not done, so store the handler for next time | |
| resp | |
| member x.StepCall(callId,digits) = | |
| let handler = switchBoard.FindHandler(callId) | |
| match handler with | |
| | None -> Workflow.Hangup "Unknown call" |> CompletedResponse | |
| | Some handler -> | |
| match handler.StepSync(digits) with | |
| | IntermediateResponse details as resp -> resp | |
| | CompletedResponse details as resp -> | |
| // We are done so remove handler | |
| do switchBoard.RemoveHandler(callId) | |
| do (handler :> IDisposable).Dispose() | |
| resp | |
| member x.StepCallForwarded(callId,digits) = | |
| // Rather than lookup the handler then call it, just ask the switchboard to pass the message straight through | |
| let stepResult = switchBoard.RequestOfHandler(callId, fun channel -> | |
| function | |
| | Ok (handler:CallHandler) -> handler.DirectPost( CallHandlerMessages.DigitsProvided(digits,channel) ) | |
| | Error err -> channel.Reply(CallResponse.CompletedResponse (Workflow.Hangup err))) | |
| match stepResult with | |
| | IntermediateResponse details as resp -> resp | |
| | CompletedResponse details as resp -> | |
| // We are done so remove handler | |
| do switchBoard.RemoveHandler(callId) | |
| resp | |
| module Testing = | |
| open CallHandling | |
| open Workflow | |
| let private runTestScenarios simulateCall name = | |
| let (=?) a b = | |
| if a <> b then failwithf "%A does not equal %A" a b; | |
| simulateCall (DateTime(2017,12,24)) [] =? | |
| [ Hangup "I'm sorry, we are now shut for the rest of year, happy holidays !"] | |
| simulateCall (DateTime(2017,12,22,17,0,0)) [ ] =? | |
| [ TakeMessage "I'm sorry, we are closed for the day, please leave a message and we'll get back to you asap"] | |
| simulateCall (DateTime(2017,12,22,12,0,0)) [ "2" ] =? | |
| [ WaitForKeypresses("Please press 1 to talk to one of our elves, or 2 to leave us a message", 1) | |
| TakeMessage "Please leave your message after the beep"] | |
| simulateCall (DateTime(2017,12,22,12,0,0)) [ "1"; "4"; "4"; "2" ] =? | |
| [ WaitForKeypresses("Please press 1 to talk to one of our elves, or 2 to leave us a message", 1) | |
| WaitForKeypresses("Please press 1 to discuss naughty lists, press 2 to discuss a reindeer malfunction, press 3 for any other enquires",1) | |
| WaitForKeypresses("Please press 1 to discuss naughty lists, press 2 to discuss a reindeer malfunction, press 3 for any other enquires",1) | |
| WaitForKeypresses("Please press 1 to discuss naughty lists, press 2 to discuss a reindeer malfunction, press 3 for any other enquires",1) | |
| ConnectToQueue "Naughty raindeer"] | |
| printfn "%s - all passed" name | |
| let private defaultAutoStoreTime = TimeSpan.FromSeconds(30.) | |
| let testCallAgent() = | |
| let runCallViaAgent dt listOfKeyPresses = | |
| use call = new CallHandler({ CallDetails.Example with CallAt = dt }, defaultAutoStoreTime) | |
| let rec runIt listOfKeyPresses = function | |
| | CompletedResponse r -> [r] | |
| | IntermediateResponse r -> match listOfKeyPresses with | |
| | [] -> failwith "Run out of input keys" | |
| | keysPressed::futureKeys -> r :: runIt futureKeys (call.StepSync keysPressed) | |
| call.StartSync() |> runIt listOfKeyPresses | |
| do runTestScenarios runCallViaAgent "CallHandler direct" | |
| let testHttp() = | |
| let runCallViaHTTP dt listOfKeyPresses = | |
| use http = new HttpEndpoint.HttpHandler(defaultAutoStoreTime) | |
| let details = { CallDetails.Example with CallAt = dt } | |
| let callId = Guid.NewGuid().ToString() | |
| let rec runIt listOfKeyPresses = function | |
| | CompletedResponse r -> [r] | |
| | IntermediateResponse r -> match listOfKeyPresses with | |
| | [] -> failwith "Run out of input keys" | |
| | keysPressed::futureKeys -> r :: runIt futureKeys (http.StepCall(callId,keysPressed)) | |
| http.StartCall(callId,details.NumberFrom,details.NumberTo,details.CallAt) |> runIt listOfKeyPresses | |
| do runTestScenarios runCallViaHTTP "Via switchboard" | |
| let testHttpForwarded() = | |
| let runCallViaHTTP dt listOfKeyPresses = | |
| use http = new HttpEndpoint.HttpHandler(defaultAutoStoreTime) | |
| let details = { CallDetails.Example with CallAt = dt } | |
| let callId = Guid.NewGuid().ToString() | |
| let rec runIt listOfKeyPresses = function | |
| | CompletedResponse r -> [r] | |
| | IntermediateResponse r -> match listOfKeyPresses with | |
| | [] -> failwith "Run out of input keys" | |
| | keysPressed::futureKeys -> r :: runIt futureKeys (http.StepCallForwarded(callId,keysPressed)) | |
| http.StartCall(callId,details.NumberFrom,details.NumberTo,details.CallAt) |> runIt listOfKeyPresses | |
| do runTestScenarios runCallViaHTTP "Switchboard with forwarding" | |
| let testRewind() = | |
| let runCallViaAgent dt listOfKeyPresses = | |
| use call = new CallHandler({ CallDetails.Example with CallAt = dt }, defaultAutoStoreTime) | |
| let rec runIt listOfKeyPresses = function | |
| | CompletedResponse r -> [r] | |
| | IntermediateResponse r -> match listOfKeyPresses with | |
| | [] -> failwith "Run out of input keys" | |
| | keysPressed::futureKeys -> | |
| call.DirectPost( PersistToStorage ) // Every new call, tell the agent to persist and reforce replay | |
| r :: runIt futureKeys (call.StepSync keysPressed) | |
| call.StartSync() |> runIt listOfKeyPresses | |
| do runTestScenarios runCallViaAgent "CallHandler direct with rewind" | |
| #time | |
| Testing.testCallAgent() | |
| Testing.testHttp() | |
| Testing.testHttpForwarded() | |
| Testing.testRewind() |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment