How to deal with rollbacks when using the Either monad ("railway-oriented programming")

Question

I am using F# and Chessie to compose a sequence of tasks (with side effects) that can succeed or fail.

If anything fails, I want to stop executing the remaining tasks and rollback those that have already succeeded.

Unfortunately once I hit the 'failure' path there is no longer a way to retrieve the results of the successful tasks so I can roll them back.

Is there a functional programming "pattern" that deals with this scenario?

Example:

let refuel =
  async {
    printfn "1 executed"
    // Fill missile with fuel
    return Result<string,string>.Succeed "1"
  }  |> AR

let enterLaunchCodes =
  async {
    printfn "2 executed"
    // 
    return Result<string,string>.FailWith "2"
  }  |> AR

let fireMissile =
  async {
    printfn "3 executed"
    return Result<string,string>.Succeed "3"
  } |> AR

let launchSequence =
  asyncTrial {
    let! a = refuel
    let! b = enterLaunchCodes
    let! c = fireMissile
    return a,b,c
  }

let result = launchSequence
    |> Chessie.ErrorHandling.AsyncExtensions.Async.ofAsyncResult
    |> Async.RunSynchronously

// Result is a failure... how do I know the results of the successful operations here so I can roll them back?

printfn "Result: %A" result

Answer 1

As people have pointed out in the comments, there are a couple of options that can be used to solve this.

One way is to use compensating transactions.

In this approach, the Success case contains a list of "undo" functions. Every step that can be undone adds a function to this list. When any step fails, each undo function in the list is executed (in reverse order).

There are more sophisticated ways to do this of course (e.g storing the undo functions persistently in case of crashes, or this kind of thing).

Here's some code that demonstrates this approach:

/// ROP design with compensating transactions    
module RopWithUndo =

    type Undo = unit -> unit

    type Result<'success> =
        | Success of 'success * Undo list
        | Failure of string

    let bind f x =
        match x with
        | Failure e -> Failure e 
        | Success (s1,undoList1) ->
            match f s1 with
            | Failure e ->
                // undo everything in reverse order 
                undoList1 |> List.rev |> List.iter (fun undo -> undo())
                // return the error
                Failure e 
            | Success (s2,undoList2) ->
                // concatenate the undo lists
                Success (s2, undoList1 @ undoList2)

/// Example
module LaunchWithUndo =

    open RopWithUndo

    let undo_refuel() =
        printfn "undoing refuel"

    let refuel ok =
        if ok then
            printfn "doing refuel"
            Success ("refuel", [undo_refuel])
        else 
            Failure "refuel failed"

    let undo_enterLaunchCodes() =
        printfn "undoing enterLaunchCodes"

    let enterLaunchCodes ok refuelInfo =
        if ok then
            printfn "doing enterLaunchCodes"
            Success ("enterLaunchCodes", [undo_enterLaunchCodes])
        else 
            Failure "enterLaunchCodes failed"

    let fireMissile ok launchCodesInfo =
        if ok then
            printfn "doing fireMissile "
            Success ("fireMissile ", [])
        else 
            Failure "fireMissile failed"

    // test with failure at refuel
    refuel false
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    (*
    val it : Result<string> = Failure "refuel failed"
    *)

    // test with failure at enterLaunchCodes
    refuel true
    |> bind (enterLaunchCodes false)
    |> bind (fireMissile true)
    (*
    doing refuel
    undoing refuel
    val it : Result<string> = Failure "enterLaunchCodes failed"
    *)

    // test with failure at fireMissile
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile false)
    (*
    doing refuel
    doing enterLaunchCodes
    undoing enterLaunchCodes
    undoing refuel
    val it : Result<string> = Failure "fireMissile failed"
    *)

    // test with no failure 
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    (*
    doing refuel
    doing enterLaunchCodes
    doing fireMissile 
    val it : Result<string> =
      Success ("fireMissile ",[..functions..])
    *)

If the results of each cannot be undone, a second option is not to do irreversible things in each step at all, but to delay the irreversible bits until all steps are OK.

In this approach, the Success case contains a list of "execute" functions. Every step that succeeds adds a function to this list. At the very end, the entire list of functions is executed.

The downside is that once committed, all the functions are run (although you could also chain those monadically too!)

This is basically a very crude version of the interpreter pattern.

Here's some code that demonstrates this approach:

/// ROP design with delayed executions
module RopWithExec =

    type Execute = unit -> unit

    type Result<'success> =
        | Success of 'success * Execute list
        | Failure of string

    let bind f x =
        match x with
        | Failure e -> Failure e 
        | Success (s1,execList1) ->
            match f s1 with
            | Failure e ->
                // return the error
                Failure e 
            | Success (s2,execList2) ->
                // concatenate the exec lists
                Success (s2, execList1 @ execList2)

    let execute x =
        match x with
        | Failure e -> 
            Failure e 
        | Success (s,execList) ->
            execList |> List.iter (fun exec -> exec())
            Success (s,[])

/// Example
module LaunchWithExec =

    open RopWithExec

    let exec_refuel() =
        printfn "refuel"

    let refuel ok =
        if ok then
            printfn "checking if refuelling can be done"
            Success ("refuel", [exec_refuel])
        else 
            Failure "refuel failed"

    let exec_enterLaunchCodes() =
        printfn "entering launch codes"

    let enterLaunchCodes ok refuelInfo =
        if ok then
            printfn "checking if launch codes can be entered"
            Success ("enterLaunchCodes", [exec_enterLaunchCodes])
        else 
            Failure "enterLaunchCodes failed"

    let exec_fireMissile() =
        printfn "firing missile"

    let fireMissile ok launchCodesInfo =
        if ok then
            printfn "checking if missile can be fired"
            Success ("fireMissile ", [exec_fireMissile])
        else 
            Failure "fireMissile failed"

    // test with failure at refuel
    refuel false
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    |> execute
    (*
    val it : Result<string> = Failure "refuel failed"
    *)

    // test with failure at enterLaunchCodes
    refuel true
    |> bind (enterLaunchCodes false)
    |> bind (fireMissile true)
    |> execute
    (*
    checking if refuelling can be done
    val it : Result<string> = Failure "enterLaunchCodes failed"
    *)

    // test with failure at fireMissile
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile false)
    |> execute
    (*
    checking if refuelling can be done
    checking if launch codes can be entered
    val it : Result<string> = Failure "fireMissile failed"
    *)

    // test with no failure 
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    |> execute
    (*
    checking if refuelling can be done
    checking if launch codes can be entered
    checking if missile can be fired
    refuel
    entering launch codes
    firing missile
    val it : Result<string> = Success ("fireMissile ",[])
    *)

You get the idea, I hope. I'm sure there are other approaches as well -- these are two that are obvious and simple. :)