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).
Proof using.
unfold PB_net. intros.
pb_unfold. repeat (first [break_let | break_match]); repeat find_inversion; auto.
- right. left. intuition. right. eexists. eexists. intuition eauto.
find_rewrite. auto.
- right. left. intuition. right. eexists. eexists. intuition eauto.
find_rewrite. auto.
- right. right. intuition. eexists. eauto.
Qed.
Proof using.
unfold PB_net. intros.
pb_unfold. repeat (first [break_let | break_match]); repeat find_inversion; auto; simpl.
- left. intuition. left. eauto.
- right. left. intuition.
- right. left. intuition. right. eexists. eexists. intuition eauto.
find_rewrite. auto.
- right. left. intuition. right. eexists. eexists. intuition eauto.
find_rewrite. auto.
- right. right. intuition. eauto.
- left. intuition.
Qed.
Instance PB_base_params : BaseParams :=
Build_BaseParams
PB_data
PB_input
PB_output.
Instance PB_multi_params : MultiParams PB_base_params :=
Build_MultiParams
PB_base_params
msg_eq_dec
name_eq_dec
all_nodes_all
NoDup_all_nodes
PB_init
PB_net
PB_input_handler.
Definition inputs_1 (tr : list ((@input base_params) * (@output base_params))) :
list (@input base_params) :=
map (@fst _ _) tr.
Definition inputs_m (tr : list (name * (@input PB_base_params + list (@output PB_base_params)))) :
list (@input base_params) :=
filterMap (fun x => match x with
| (Primary, inl (Request i)) => Some i
| _ => None
end)
tr.
Definition outputs_1 (tr : list ((@input base_params) * (@output base_params))) :
list (@output base_params) :=
map (@snd _ _) tr.
Fixpoint outputs_m (tr : list (name * (@input PB_base_params + list (@output PB_base_params)))) :
list (@output base_params) :=
match tr with
| [] => []
| (Primary, inr l) :: tr' => filterMap (fun x => match x with
| RequestResponse i os => Some os
| _ => None
end) l ++ outputs_m tr'
| _ :: tr' => outputs_m tr'
end.
Fixpoint processInputs (d : @data base_params) (l : list (@input base_params)) :
(@data base_params * list (@output base_params)) :=
match l with
| [] => (d, [])
| i :: l' => let (os, d') := @handler _ one_node_params i d in
let (d'', os') := processInputs d' l' in
(d'', os :: os')
end.
Definition correspond (st : @data base_params) (sigma : name -> @data PB_base_params) tr_1 tr_m :=
let (d, os) := processInputs (state (sigma Primary)) (queue (sigma Primary)) in
outputs_m tr_m ++ os = outputs_1 tr_1 /\
d = st.
Proof using.
destruct tr; auto.
intros. simpl in *. discriminate.
Qed.
Proof using.
unfold inputs_m.
intros.
induction l1; simpl; repeat break_match; subst; simpl in *; auto using f_equal.
Qed.
Proof using.
unfold inputs_m.
intros.
simpl.
repeat break_match; auto; discriminate.
Qed.
Proof using.
intros.
find_apply_lem_hyp PB_net_defn.
intuition.
- destruct dst; subst; intuition.
- subst. right. right.
intuition. break_exists. intuition eauto.
Qed.
Proof using.
intros. induction tr1; simpl.
- auto.
- repeat break_match; subst; auto.
rewrite app_ass. auto using f_equal.
Qed.
Proof using.
unfold correspond.
intros.
rewrite outputs_m_app.
repeat find_rewrite.
rewrite app_nil_r.
auto.
Qed.
Proof using.
destruct h; auto.
Qed.
Proof using.
intros.
apply outputs_m_inr_nil.
Qed.
Proof using.
destruct h; auto.
Qed.
Proof using.
unfold outputs_m.
intros.
break_match; auto; congruence.
Qed.
Hint Extern 4 => congruence : core.

Lemma correspond_preserved_primary_apply_entry :
forall sigma sigma' st tr_1 tr_m tr_m' i l d h,
correspond st sigma tr_1 tr_m ->
handler i (state (sigma h)) = (l, state d) ->
sigma' Primary = d ->
outputs_m tr_m' = [l] ->
h = Primary ->
queue (sigma h) = i :: queue d ->
correspond st sigma' tr_1 (tr_m ++ tr_m').