Section PrimaryBackup.
Context {base_params : BaseParams}.
Context {one_node_params : OneNodeParams base_params}.
Context {pb_params : PrimaryBackupParams base_params}.
Inductive name := Primary | Backup.
Proof using.
decide equality.
Qed.
Inductive msg :=
| BackItUp : input -> msg
| Ack : msg.
Proof using pb_params.
decide equality.
apply input_eq_dec.
Qed.
Inductive PB_input :=
| Request : input -> PB_input
| Read : PB_input.
Inductive PB_output :=
| RequestResponse : input -> output -> PB_output
| ReadResponse : data -> PB_output.
Record PB_data :=
{
queue : list input;
state : data
}.
Definition all_nodes : list name := [Primary; Backup].
Proof using.
unfold all_nodes.
destruct x; intuition.
Qed.
Proof using.
unfold all_nodes.
repeat constructor; intuition. simpl in *. intuition. congruence.
Qed.
Definition PB_init (n : name) :=
Build_PB_data [] init.
Definition set_queue {W O} (l : list input) :=
modify (W := W)(O := O) (fun d => Build_PB_data l (state d)).
Definition set_state {W O} (st : data) :=
modify (W := W)(O := O) (fun d => Build_PB_data (queue d) st).
Ltac pb_unfold := unfold set_queue, set_state in *; monad_unfold.
Definition PB_input_handler (h : name) (i : PB_input) (d : PB_data) :
list PB_output * PB_data * list (name * msg) :=
runGenHandler_ignore d (
match h, i with
| Primary, Request r =>
d <- get ;;
when (null (queue d)) (send (Backup, BackItUp r)) ;;
set_queue (queue d ++ [r])
| _, Read =>
d <- get ;;
write_output (ReadResponse (state d))
| _, _ => nop
end).
Proof using.
unfold PB_input_handler. intros.
pb_unfold.
repeat break_match; repeat find_inversion; intuition eauto.
rewrite app_nil_r. simpl. find_apply_lem_hyp null_sound. find_rewrite.
simpl. left. intuition. eexists. eauto.
Qed.
Definition PB_net (dst src : name) (m : msg) : PB_data ->
list PB_output * PB_data * list (name * msg) :=
fun x => runGenHandler_ignore x (
match dst, m with
| Primary, Ack => d <- get ;;
match queue d with
| [] => nop
| x :: xs => match xs with
| [] => nop
| y :: ys =>
send (Backup, BackItUp y)
end ;;
let (os, st') := handler x (state d) in
write_output (RequestResponse x os) ;;
set_state st' ;;
set_queue xs
end
| Backup, BackItUp i => d <- get ;;
set_state (snd (handler i (state d))) ;;
send (Primary, Ack)
| _, _ => nop
end).

Lemma PB_net_defn :
forall dst src m d os d' ms,
PB_net dst src m d = (os, d', ms) ->
(os = [] /\ d' = d /\ ms = []) \/
(dst = Primary /\ m = Ack /\ (
(queue d = [] /\ os = [] /\ ms = [] /\ d' = d) \/
(exists h t, queue d = h :: t /\
queue d' = t /\
((t = [] /\ ms = []) \/
(exists y ys,
t = y :: ys /\
ms = [(Backup, BackItUp y)])) /\
let (us, st') := handler h (state d) in
os = [RequestResponse h us] /\
state d' = st'))) \/
(dst = Backup /\ ms = [(Primary, Ack)] /\ queue d' = queue d /\ os = [] /\
(exists i, m = BackItUp i /\
state d' = snd (handler i (state d)))).