Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
You can’t perform that action at this time.