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

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. :)