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