(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export Quorum.
Require Export Process.

Section PBFTheader.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc : @DTimeContext }.

  (* ===============================================================
     Parameters
     =============================================================== *)

  Class PBFTcontext :=
    MkPBFTcontext
      {
        (* maximum number of requests that can be handled at the same time *)
        PBFTmax_in_progress : nat;

        (* This number has to be big enough so that replicas do not stall waiting
         for a checkpoint to become stable *)
        PBFTwater_mark_range : nat; (* this should be SeqNum type *)

        (* usually half of the water-mark range *)
        PBFTcheckpoint_period : nat;

        PBFTdigest : Set;
        PBFTdigestdeq : Deq PBFTdigest;

        PBFTtoken    : Set;
        PBFTtokendeq : Deq PBFTtoken;

        PBFTsending_key   : Set;
        PBFTreceiving_key : Set;

        (* number of faults *)
        F : nat;

        (* ++++++++ Nodes (Replicas & Clients) ++++++++ *)
        num_replicas := (3 * F) + 1;

        (* We have 3F+1 replicas *)
        Rep : Set;
        rep_deq : Deq Rep;
        reps2nat : Rep -> nat_n num_replicas;
        reps_bij : bijective reps2nat;

        num_clients : nat;

        Client : Set;
        client_deq : Deq Client;
        clients2nat : Client -> nat_n num_clients;
        clients_bij : bijective clients2nat;

        (* ++++++++ replicated service ++++++++ *)
        PBFToperation : Set;
        PBFTopdeq : Deq PBFToperation;

        PBFTresult : Set;
        PBFTresdeq : Deq PBFTresult;

        PBFTsm_state : Set;
        PBFTsm_initial_state : PBFTsm_state;
        PBFTsm_update : Client -> PBFTsm_state -> PBFToperation -> PBFTresult * PBFTsm_state;

        PBFTtimer_delay : nat;
      }.

  Context { pbft_context : PBFTcontext }.

  (* ===============================================================
     No trusted component
     =============================================================== *)

  Global Instance PBFT_I_IOTrustedFun : IOTrustedFun := MkIOTrustedFun (fun _ => MkIOTrusted unit unit tt).

  (* ===============================================================
     Nodes
     =============================================================== *)

  Inductive PBFTnode :=
  | PBFTreplica (n : Rep)
  | PBFTclient (n : Client).

  Definition node2rep (n : PBFTnode) : option Rep :=
    match n with
    | PBFTreplica n => Some n
    | _ => None
    end.

  Definition node2client (n : PBFTnode) : option Client :=
    match n with
    |PBFTclient nn => Some nn
    | _ => None
    end.

  Lemma PBFTnodeDeq : Deq PBFTnode.
  Proof.
    introv; destruct x as [r1|c1], y as [r2|c2].
    - destruct (rep_deq r1 r2);[left|right]; subst; auto.
      intro xx; inversion xx; subst; tcsp.
    - right; intro xx; inversion xx; subst; tcsp.
    - right; intro xx; inversion xx; subst; tcsp.
    - destruct (client_deq c1 c2);[left|right]; subst; auto.
      intro xx; inversion xx; subst; tcsp.
  Defined.

  Global Instance PBFT_I_Node : Node := MkNode PBFTnode PBFTnodeDeq.

  (* ===============================================================
     Quorum
     =============================================================== *)

  Lemma PBFTreplica_inj : injective PBFTreplica.
  Proof.
    introv h; ginv; auto.
  Qed.

  Definition node2replica (n : PBFTnode) : option Rep :=
    match n with
    | PBFTreplica r => Some r
    | _ => None
    end.

  Lemma replica2node_cond :
    forall n : Rep, node2replica (PBFTreplica n) = Some n.
  Proof.
    tcsp.
  Qed.

  Lemma node2replica_cond :
    forall (n : Rep) (m : name), node2replica m = Some n -> PBFTreplica n = m.
  Proof.
    introv h; destruct m; simpl in *; ginv; auto.
  Qed.

  Global Instance PBFT_I_Quorum : Quorum_context :=
    MkQuorumContext
      Rep
      num_replicas
      rep_deq
      reps2nat
      reps_bij
      PBFTreplica
      node2replica
      replica2node_cond
      node2replica_cond
      PBFTreplica_inj.

  (* can we have something like this? *)
  Definition rep2node := Rep -> node_type.

  (* ===============================================================
     More about Nodes
     =============================================================== *)

  (* 0 is less than 2*F+1 *)
  Definition nat_n_2Fp1_0 : nat_n num_replicas.
  Proof.
    exists 0.
    apply leb_correct.
    unfold num_replicas.
    omega.
  Defined.

  Definition replica0 : Rep := bij_inv reps_bij nat_n_2Fp1_0.

  (*Eval simpl in (name_dec (PBFTreplica replica0) (PBFTreplica replica0)).*)

  (* We'll return the node as given by our bijection if n < num_nodes,
     otherwise we return a default value (replica0)
   *)
  Definition nat2rep (n : nat) : Rep.
  Proof.
    destruct reps_bij as [f a b].
    destruct (lt_dec n num_replicas) as [d|d].
    - exact (f (mk_nat_n d)). (* here we now that n < num_replicas so we can use our bijection *)
    - exact replica0. (* here num_replicas <= n, so we return a default value: replica0 *)
  Defined.

  Definition reps : list Rep := nodes.
(*    mapin
      (seq 0 num_replicas)
      (fun n i => bij_inv reps_bij (mk_nat_n (seq_0_lt i))).*)

  Definition nreps : list name := map PBFTreplica reps.

  Lemma reps_prop : forall (x : Rep), In x reps.
  Proof.
    exact nodes_prop.
  Qed.

  Definition clients : list Client :=
    mapin
      (seq 0 num_clients)
      (fun n i => bij_inv clients_bij (mk_nat_n (seq_0_lt i))).

  Definition nclients : list name := map PBFTclient clients.

  Lemma clients_prop : forall (x : Client), In x clients.
  Proof.
    introv.
    unfold clients.
    apply in_mapin.

    remember (clients2nat x) as nx.
    destruct nx as [nx condnx].

    pose proof (leb_complete _ _ condnx) as c.

    assert (In nx (seq O num_clients)) as i.
    { apply in_seq; omega. }

    exists nx i; simpl.

    unfold mk_nat_n.
    unfold bij_inv.
    destruct clients_bij.
    pose proof (bij_id1 x) as h.
    rewrite <- Heqnx in h; subst; simpl.

    f_equal; f_equal.
    apply UIP_dec; apply bool_dec.
  Qed.

  (*
  (* @Ivana: in case we ave clients coming and leaving, I am not sure if this is going to be convenient *)
  Definition clients : list Client :=
    mapin
      (seq 0 num_clients)
      (fun n i => bij_inv client_bij (mk_nat_n (seq_0_lt i))).

    Definition nclients : list name := map PBFTclient clients.

    Lemma client_prop : forall (x : Client), In x clients.
    Proof.
      introv.
      unfold clients.
      apply in_mapin.

      remember (client2nat x) as nx.
      destruct nx as [nx condnx].

      pose proof (leb_complete _ _ condnx) as c.

      assert (In nx (seq O num_clients)) as i.
      { apply in_seq; omega. }

      exists nx i; simpl.

      unfold mk_nat_n.
      unfold bij_inv.
      destruct client_bij.
      pose proof (bij_id3 x) as h.
      rewrite <- Heqnx in h; subst; simpl.

      f_equal; f_equal.
      apply UIP_dec; apply bool_dec.
    Qed.
   *)

  (* ===============================================================
     Views
     =============================================================== *)

  Inductive View :=
  | view (n : nat).

  Definition view2nat (v : View) : nat :=
    match v with
    | view n => n
    end.
  Coercion view2nat : View >-> nat.

  Definition next_view (v : View): View := view (S v).

  Definition pred_view (v : View): View := view (pred v).

  Lemma ViewDeq : Deq View.
  Proof.
    introv; destruct x, y; prove_dec.
    destruct (deq_nat n n0); prove_dec.
  Defined.

  Definition initial_view := view 0.

  Definition ViewLe (vn1 vn2 : View) : bool :=
    view2nat vn1 <=? view2nat vn2.

  Definition ViewLt (vn1 vn2 : View) : bool :=
    view2nat vn1 <? view2nat vn2.

  Definition max_view (v1 v2 : View) : View :=
    if ViewLe v1 v2 then v2 else v1.

  (* ===============================================================
     Timestamps
     =============================================================== *)

  Inductive Timestamp :=
  | time_stamp (q : nat).
  Coercion time_stamp : nat >-> Timestamp.

  Definition timestamp2nat (t : Timestamp) : nat :=
    match t with
    | time_stamp n => n
    end.
  Coercion timestamp2nat : Timestamp >-> nat.

  Definition timestamp0 := time_stamp 0.

  (* ===============================================================
     Sequence numbers
     =============================================================== *)

  Inductive SeqNum :=
  | seq_num (n : nat).
  Coercion seq_num : nat >-> SeqNum.

  Definition seqnum2nat (s : SeqNum) : nat :=
    match s with
    | seq_num n => n
    end.
  Coercion seqnum2nat : SeqNum >-> nat.

  Definition SeqNumLe (sn1 sn2 : SeqNum) : bool :=
    seqnum2nat sn1 <=? seqnum2nat sn2.

  Definition SeqNumLt (sn1 sn2 : SeqNum) : bool :=
    seqnum2nat sn1 <? seqnum2nat sn2.

  Definition next_seq (n : SeqNum): SeqNum := seq_num (S n).

  Lemma SeqNumDeq : Deq SeqNum.
  Proof.
    introv; destruct x, y; prove_dec.
    destruct (deq_nat n n0); prove_dec.
  Defined.

  Definition initial_sequence_number : SeqNum := seq_num 0.

  Definition min_seq_num (s1 s2 : SeqNum) : SeqNum :=
    if SeqNumLe s1 s2 then s1 else s2.

  Definition max_seq_num (s1 s2 : SeqNum) : SeqNum :=
    if SeqNumLe s1 s2 then s2 else s1.

  (* ===============================================================
     Primary
     =============================================================== *)

  (* @Ivnote: mod is already part of Coq standard library, and it's used as follows: a mod b *)
  (* primary p = v mod R, where v is number of current view and |R| is 2f+1 *)
  Definition PBFTprimary_nat (v : View) : nat := v mod num_replicas. (* here we should return replica, not nat!!!*)

  Definition PBFTprimary (v : View) : Rep := nat2rep (PBFTprimary_nat v).

  Definition is_primary (v : View) (r : Rep) : bool :=
    if rep_deq r (PBFTprimary v) then true else false.

  (* ===============================================================
     Authentication
     =============================================================== *)

  Definition PBFTtokens := list PBFTtoken.

  Global Instance PBFT_I_AuthTok : AuthTok :=
    MkAuthTok
      PBFTtoken
      PBFTtokendeq.

  (* ===============================================================
     Bare messages
     =============================================================== *)

  Inductive Bare_Request : Set :=
  | null_req
  | bare_req
      (o : PBFToperation)
      (t : Timestamp)
      (c : Client).

  Inductive Bare_Reply :=
  | bare_reply
      (v : View)
      (t : Timestamp)
      (c : Client)
      (i : Rep)
      (r : PBFTresult).

  Inductive Bare_Prepare :=
  | bare_prepare
      (v : View)
      (s : SeqNum)
      (d : PBFTdigest)
      (i : Rep).

  Inductive Bare_Commit :=
  | bare_commit
      (v : View)
      (s : SeqNum)
      (d : PBFTdigest)
      (i : Rep).

  Inductive Bare_Checkpoint :=
  | bare_checkpoint
      (v : View) (* see technical report and PhD thesis*)
      (n : SeqNum)
      (d : PBFTdigest)
      (i : Rep).

  (* ===============================================================
     Authenticated messages
     =============================================================== *)

  Inductive Request :=
  | req
      (b : Bare_Request)
      (a : Tokens).  (* [a] authenticate the client *)

  Inductive Reply :=
  | reply
      (b : Bare_Reply)
      (a : Tokens).  (* [a] authenticate the replica *)

  Inductive Prepare :=
  | prepare
      (b : Bare_Prepare)
      (a : Tokens).  (* [a] authenticate the replica (the leader here) *)

  Inductive Commit :=
  | commit
      (b : Bare_Commit)
      (a : Tokens).  (* [a] authenticate the replica *)

  Inductive Checkpoint :=
  | checkpoint
      (b : Bare_Checkpoint)
      (a : Tokens).  (* [a] authenticate the replica *)

  Inductive Debug :=
  | debug
      (r : Rep)
      (s : String.string).

  Inductive CheckReady :=
  | check_ready.

  Inductive CheckStableChkPt :=
  | check_stable_checkpoint.

  Inductive StartTimer :=
  | start_timer
      (r : Bare_Request)
      (v : View).

  Inductive ExpiredTimer :=
  | expired_timer
      (r : Bare_Request)
      (v : View).

  (* ===============================================================
     Messages depending on authenticated messages
     =============================================================== *)

  (* reconsider n, maybe it should have some type *)
  Inductive Bare_Pre_prepare :=
  | bare_pre_prepare
      (v : View)
      (s : SeqNum)
      (d : list Request). (* this is a list because we buffer requests *)

(*  Record Pre_prepare_data :=
    MkPrePrepareData
      {
        ppd_bare : Bare_Pre_prepare;
        ppd_toks : Tokens;  (* [a] authenticate the replica (the leader here) *)
      }.
*)

  Inductive Pre_prepare :=
  | pre_prepare
      (b : Bare_Pre_prepare)
      (a : Tokens).

  Record PreparedInfo :=
    MkPreparedInfo
      {
        prepared_info_pre_prepare : Pre_prepare;
        prepared_info_digest      : PBFTdigest;
        prepared_info_prepares    : list Prepare;
      }.

  Definition CheckpointCert := list Checkpoint.

  Record LastReplyEntry :=
    MkLastReplyEntry
      {
        lre_client    : Client;
        lre_timestamp : Timestamp;    (* initially 0 *)
        lre_reply     : option PBFTresult; (* None is the initial value *)
      }.

  Definition LastReplyState := list LastReplyEntry.

  (* This is meant to be the last stable checkpoint *)
  Record StableChkPt :=
    MkStableChkPt
      {
        si_state : PBFTsm_state;
        si_lastr : LastReplyState;
      }.

  Inductive Bare_ViewChange :=
  | bare_view_change
      (v : View)
      (n : SeqNum)
      (* FIX: technical report has an extra field here: p.24 *)
      (s : StableChkPt)
      (C : CheckpointCert)
      (P : list PreparedInfo)
      (i : Rep).

  Inductive ViewChange :=
  | view_change
      (v : Bare_ViewChange)
      (a : Tokens).

  Definition ViewChangeCert := list ViewChange.

  Inductive Bare_NewView :=
  | bare_new_view
      (v : View)
      (V : ViewChangeCert)
      (* pre-prepare for which we have a request *)
      (OP : list Pre_prepare)
      (* pre-prepare for which we don't have a request *)
      (NP : list Pre_prepare).

  Inductive NewView :=
  | new_view
      (v : Bare_NewView)
      (a : Tokens).

  Record PBFTviewChangeEntry :=
    MkViewChangeEntry
      {
        (* view number of the entry---all the view-change messages in the entry
           are meant to be for this view *)
        vce_view         : View;

        (* view-change message created locally *)
        vce_view_change  : option ViewChange;

        (* list of view change messages received so far *)
        vce_view_changes : list ViewChange;

        (* new-view message sent in response to enough view-change messages *)
        vce_new_view     : option NewView;
      }.

  Inductive CheckBCastNewView :=
  | check_bcast_new_view (i : nat) (* position of the [PBFTviewChangeEntry] to check *).

  (* ===============================================================
     Bare message type
     =============================================================== *)

  Inductive PBFTBare_Msg : Set :=
  | PBFTmsg_bare_request              (r : Bare_Request)
  | PBFTmsg_bare_reply                (r : Bare_Reply)
  | PBFTmsg_bare_pre_prepare          (p : Bare_Pre_prepare)
  | PBFTmsg_bare_prepare              (p : Bare_Prepare)
  | PBFTmsg_bare_commit               (c : Bare_Commit)
  | PBFTmsg_bare_checkpoint           (c : Bare_Checkpoint)

  (* This is to keep on checking whether there are more requests that are
     ready to be executed *)
  | PBFTmsg_bare_check_ready          (t : CheckReady)

  (* This is to check whether it's time to broadcast a new-view message *)
  | PBFTmsg_bare_check_bcast_new_view (e : CheckBCastNewView)

  (* These are sent to the component in charge of handling timers to start a new
     timer in case of a new request *)
  | PBFTmsg_bare_start_timer          (t : StartTimer)

  (* These are received from the component in charge of handling timers when
     timers have expired *)
  | PBFTmsg_bare_expired_timer        (t : ExpiredTimer)

  | PBFTmsg_bare_view_change          (v : Bare_ViewChange)

  | PBFTmsg_bare_new_view             (v : Bare_NewView).

  (* ===============================================================
     Crypto
     =============================================================== *)

  Global Instance PBFT_I_Data : Data := MkData PBFTBare_Msg.

  Global Instance PBFT_I_Key : Key := MkKey PBFTsending_key PBFTreceiving_key.

  Class PBFTauth :=
    MkPBFTauth
      {
        PBFTcreate : data -> sending_keys -> PBFTtokens;
        PBFTverify : data -> name -> receiving_key -> PBFTtoken -> bool
      }.
  Context { pbft_auth : PBFTauth }.

  Global Instance PBFT_I_AuthFun : AuthFun :=
    MkAuthFun
      PBFTcreate
      PBFTverify.

  Class PBFTinitial_keys :=
    MkPBFTinitial_keys {
        initial_keys : key_map;
      }.

  Context { pbft_initial_keys : PBFTinitial_keys }.

  (* Should we create a Coercion for each of following statements??? *)

  (* ============ extract sender ==============*)

  Definition bare_request2sender (r : Bare_Request) : option Client :=
    match r with
    | null_req => None
    | bare_req o t c => Some c
    end.

  Definition request2sender (r : Request) : option Client :=
    match r with
    | req b _ => bare_request2sender b
    end.

  Definition bare_reply2sender (r : Bare_Reply) :  Rep :=
    match r with
    | bare_reply v t c i r => i
    end.

  Definition reply2sender (r : Reply) :  Rep :=
    match r with
    | reply b _ => bare_reply2sender b
    end.

  Definition bare_pre_prepare2sender (p : Bare_Pre_prepare) : Rep :=
    match p with
    | bare_pre_prepare v n d => PBFTprimary v
    end.

(*  Definition pre_prepare_data2sender (p : Pre_prepare_data) : Rep :=
    match p with
    | MkPrePrepareData b _ => bare_pre_prepare2sender b
    end.*)

  Definition pre_prepare2sender (p : Pre_prepare) : Rep :=
    match p with
    | pre_prepare b _ => bare_pre_prepare2sender b
    end.

  Definition bare_prepare2sender (p : Bare_Prepare) : Rep :=
    match p with
    | bare_prepare v n d i => i
    end.

  Definition prepare2sender (p : Prepare) : Rep :=
    match p with
    | prepare b _ => bare_prepare2sender b
    end.

  Definition bare_commit2sender (c : Bare_Commit) : Rep :=
    match c with
    | bare_commit v n d i => i
    end.

  Definition commit2sender (c : Commit) : Rep :=
    match c with
    | commit b _ => bare_commit2sender b
    end.

  Definition bare_checkpoint2sender (c : Bare_Checkpoint) : Rep :=
    match c with
    | bare_checkpoint v n d i => i
    end.

  Definition checkpoint2sender (c : Checkpoint) : Rep :=
    match c with
    | checkpoint b _ => bare_checkpoint2sender b
    end.

  Definition debug2sender (d : Debug) :  Rep :=
    match d with
    | debug s _ => s
    end.

  Definition bare_view_change2sender (v : Bare_ViewChange) :  Rep :=
    match v with
    | bare_view_change v n s C P i => i
    end.

  Definition view_change2sender (v : ViewChange) : Rep :=
    match v with
    | view_change bv _ => bare_view_change2sender bv
    end.

  Definition bare_new_view2sender (b : Bare_NewView) : Rep :=
    match b with
    | bare_new_view v V OP NP => PBFTprimary v
    end.

  Definition new_view2sender (v : NewView) : Rep :=
    match v with
    | new_view b _ => bare_new_view2sender b
    end.

  Definition prepared_info2senders (nfo : PreparedInfo) : list Rep :=
    map prepare2sender (prepared_info_prepares nfo).

  Definition prepared_info2pp_sender (nfo : PreparedInfo) : Rep :=
    pre_prepare2sender (prepared_info_pre_prepare nfo).

  (* ============ extract signature ==============*)

  Definition request2sign (r : Request) : Tokens :=
    match r with
    | req _ a => a
    end.

  Definition reply2sign (r : Reply) : Tokens :=
    match r with
    | reply _ a => a
    end.

(*  Definition pre_prepare_data2sign (p : Pre_prepare_data) : Tokens :=
    match p with
    | MkPrePrepareData _ a => a
    end.*)

  Definition pre_prepare2sign (p : Pre_prepare) : Tokens :=
    match p with
    | pre_prepare _ a => a
    end.

  Definition prepare2sign (p : Prepare) : Tokens :=
    match p with
    | prepare _ a => a
    end.

  Definition commit2sign (c : Commit) : Tokens :=
    match c with
    | commit _ a => a
    end.

  Definition checkpoint2sign (c : Checkpoint) : Tokens :=
    match c with
    | checkpoint _ a => a
    end.

  (* ============  extract sequence number ============== *)

  Definition bare_pre_prepare2seq (p : Bare_Pre_prepare) : SeqNum :=
    match p with
    | bare_pre_prepare v n d => n
    end.

(*  Definition pre_prepare_data2seq (p : Pre_prepare_data) : SeqNum :=
    match p with
    | MkPrePrepareData b _ => bare_pre_prepare2seq b
    end.*)

  Definition pre_prepare2seq (p : Pre_prepare) : SeqNum :=
    match p with
    | pre_prepare b _ => bare_pre_prepare2seq b
    end.

  Definition bare_prepare2seq (p : Bare_Prepare) : SeqNum :=
    match p with
    | bare_prepare v n d i => n
    end.

  Definition prepare2seq (p : Prepare) : SeqNum :=
    match p with
    | prepare b _ => bare_prepare2seq b
    end.

  Definition bare_commit2seq (c : Bare_Commit) : SeqNum :=
    match c with
    | bare_commit v n d i => n
    end.

  Definition commit2seq (c : Commit) : SeqNum :=
    match c with
    | commit b _ => bare_commit2seq b
    end.

  Definition bare_checkpoint2seq (c : Bare_Checkpoint) : SeqNum :=
    match c with
    | bare_checkpoint v n d i => n
    end.

  Definition checkpoint2seq (c : Checkpoint) : SeqNum :=
    match c with
    | checkpoint b _ => bare_checkpoint2seq b
    end.

  Definition bare_view_change2seq (bvc : Bare_ViewChange) : SeqNum :=
    match bvc with
    | bare_view_change v n s C P i => n
    end.

  Definition view_change2seq (vc : ViewChange) : SeqNum :=
    match vc with
    | view_change bvc _ => bare_view_change2seq bvc
    end.

  Definition prepared_info2seq (p : PreparedInfo) : SeqNum :=
    pre_prepare2seq (prepared_info_pre_prepare p).

  (* =========== extract operation =========== *)

  Definition bare_request2operation (r : Bare_Request) : option PBFToperation :=
    match r with
    | null_req => None
    | bare_req o t c => Some o
    end.

  Definition request2operation (r : Request) : option PBFToperation :=
    match r with
    | req b _ => bare_request2operation b
    end.

  (*
  Definition pre_prepare2operation (pp : Pre_prepare) : PBFToperation :=
    match pp with
    | pre_prepare _ _ r => request2operation r
    end.
*)

  (* =========== extract timestamp =========== *)

  Definition bare_request2timestamp (r : Bare_Request) : Timestamp :=
    match r with
    | null_req => timestamp0
    | bare_req o t c => t
    end.

  Definition request2timestamp (r : Request) : Timestamp :=
    match r with
    | req b _ => bare_request2timestamp b
    end.

  Definition bare_reply2timestamp (r : Bare_Reply) :=
    match r with
    | bare_reply v t c i r => t
    end.

  Definition reply2timestamp (r : Reply) :=
    match r with
    | reply b _ => bare_reply2timestamp b
    end.

  (* =========== extract receiver =========== *)

  Definition bare_reply2client (r : Bare_Reply) : Client :=
    match r with
    | bare_reply v t c i r => c
    end.

  Definition reply2client (r : Reply) : Client :=
    match r with
    | reply b _ => bare_reply2client b
    end.

  (* =========== extract result =========== *)

  Definition bare_reply2result (r : Bare_Reply) :=
    match r with
    | bare_reply v t c i r => r
    end.

  Definition reply2result (r : Reply) :=
    match r with
    | reply b _ => bare_reply2result b
    end.

  (* =========== extracts bare message =========== *)

  Definition reply2bare (r : Reply) :  Bare_Reply :=
    match r with
    | reply b _ => b
    end.

  Definition request2bare (r : Request) :  Bare_Request :=
    match r with
    | req b _ => b
    end.

(*  Definition pre_prepare_data2bare (pp : Pre_prepare_data) : Bare_Pre_prepare :=
    match pp with
    | MkPrePrepareData bp _ => bp
    end.*)

  Definition pre_prepare2bare (pp : Pre_prepare) : Bare_Pre_prepare :=
    match pp with
    | pre_prepare bp _ => bp
    end.

  (* FIX: We cannot do these anymore because pre-prepare messages
          contain requests and not digests*)

(*  Definition bare_prepare2bare_pre_prepare (bp : Bare_Prepare) : Bare_Pre_prepare :=
    match bp with
    | bare_prepare v s d _ => bare_pre_prepare v s d
    end.*)

(*  Definition prepare2bare_pre_prepare (p : Prepare) : Bare_Pre_prepare :=
    match p with
    | prepare bp _ => bare_prepare2bare_pre_prepare bp
    end.*)

(*  Definition bare_commit2bare_pre_prepare (bc : Bare_Commit) : Bare_Pre_prepare :=
    match bc with
    | bare_commit v s d _ => bare_pre_prepare v s d
    end.*)

(*  Definition commit2bare_pre_prepare (c : Commit) : Bare_Pre_prepare :=
    match c with
    | commit bc _ => bare_commit2bare_pre_prepare bc
    end.*)

  Definition bare_pre_prepare2bare_prepare
             (bpp : Bare_Pre_prepare)
             (d   : PBFTdigest)
             (r   : Rep) : Bare_Prepare :=
    match bpp with
    | bare_pre_prepare v s _ => bare_prepare v s d r
    end.

(*  Definition pre_prepare_data2bare_prepare (bp : Pre_prepare_data) (r : Rep) : Bare_Prepare :=
    match bp with
    | MkPrePrepareData b _ => bare_pre_prepare2bare_prepare b r
    end.*)

  Definition pre_prepare2bare_prepare
             (p : Pre_prepare)
             (d : PBFTdigest)
             (r : Rep) : Bare_Prepare :=
    match p with
    | pre_prepare b _ => bare_pre_prepare2bare_prepare b d r
    end.

  Definition bare_prepare2bare_commit (slf : Rep) (bp : Bare_Prepare) : Bare_Commit :=
    match bp with
    | bare_prepare v s d i => bare_commit v s d slf
    end.

  Definition prepare2bare_commit (slf : Rep) (p : Prepare) : Bare_Commit :=
    match p with
    | prepare b a => bare_prepare2bare_commit slf b
    end.

  Definition bare_commit2bare_reply
             (bc : Bare_Commit)
             (t : Timestamp)
             (c : Client)
             (r : PBFTresult) : Bare_Reply :=
    match bc with
    | bare_commit v s d i=> bare_reply v t c i r
    end.

  Definition commit2bare_reply
             (c : Commit)
             (t : Timestamp)
             (cl : Client)
             (r : PBFTresult) : Bare_Reply :=
    match c with
    | commit b a => bare_commit2bare_reply b t cl r
    end.

  Definition bare_request2bare_reply
             (br : Bare_Request)
             (v  : View)
             (i  : Rep)
             (r  : PBFTresult) : option Bare_Reply :=
    match br with
    | null_req => None
    | bare_req opr t c => Some (bare_reply v t c i r)
    end.

  Definition request2bare_reply
             (req : Request)
             (v   : View)
             (i   : Rep)
             (r   : PBFTresult) : option Bare_Reply :=
    match req with
    | req b _ => bare_request2bare_reply b v i r
    end.

  Definition bare_request2info (br : Bare_Request) : option (PBFToperation * Timestamp * Client) :=
    match br with
    | null_req => None
    | bare_req opr t c => Some (opr, t, c)
    end.

  Definition request2info (req : Request) : option (PBFToperation * Timestamp * Client) :=
    match req with
    | req b _ => bare_request2info b
    end.

  Definition bare_pre_prepare2bare_commit
             (slf : Rep)
             (b   : Bare_Pre_prepare)
             (d   : PBFTdigest) : Bare_Commit :=
    match b with
    | bare_pre_prepare v s _ => bare_commit v s d slf
    end.

(*  Definition pre_prepare_data2bare_commit (slf : Rep) (pp : Pre_prepare_data) : Bare_Commit :=
    match pp with
    | MkPrePrepareData bpp a => bare_pre_prepare2bare_commit slf bpp
    end.*)

  Definition pre_prepare2bare_commit
             (slf : Rep)
             (pp  : Pre_prepare)
             (d   : PBFTdigest) : Bare_Commit :=
    match pp with
    | pre_prepare b _ => bare_pre_prepare2bare_commit slf b d
    end.

  Definition view_change2bare (vc : ViewChange) : Bare_ViewChange :=
    match vc with
    | view_change v _ => v
    end.

(*  Definition pre_prepare_data2bare_pre_prepare (p : Pre_prepare_data) : Bare_Pre_prepare :=
    match p with
    | MkPrePrepareData b _ => b
    end.*)

  (* =========== extract view ===============*)

  Definition bare_reply2view (r : Bare_Reply) :=
    match r with
    | bare_reply v t c i r => v
    end.

  Definition reply2view (r : Reply) :=
    match r with
    | reply b _ => bare_reply2view b
    end.

  Definition bare_pre_prepare2view (p : Bare_Pre_prepare) :=
    match p with
    | bare_pre_prepare v n d =>  v
    end.

(*  Definition pre_prepare_data2view (p : Pre_prepare_data) :=
    match p with
    | MkPrePrepareData b _ =>  bare_pre_prepare2view b
    end.*)

  Definition pre_prepare2view (p : Pre_prepare) :=
    match p with
    | pre_prepare b _ => bare_pre_prepare2view b
    end.

  Definition bare_prepare2view (p : Bare_Prepare) :=
    match p with
    | bare_prepare v n d i => v
    end.

  Definition prepare2view (p : Prepare) :=
    match p with
    | prepare b _ => bare_prepare2view b
    end.

  Definition bare_commit2view (c : Bare_Commit) :=
    match c with
    | bare_commit v n d i => v
    end.

  Definition commit2view (c : Commit) :=
    match c with
    | commit b _ => bare_commit2view b
    end.

  Definition bare_checkpoint2view (c : Bare_Checkpoint) :=
    match c with
    | bare_checkpoint v n d i => v
    end.

  Definition checkpoint2view (c : Checkpoint) :=
    match c with
    | checkpoint b _ => bare_checkpoint2view b
    end.

  Definition bare_new_view2view (v : Bare_NewView) :=
    match v with
    | bare_new_view v V OP NP => v
    end.

  Definition new_view2view (v : NewView) :=
    match v with
    | new_view b _ => bare_new_view2view b
    end.

  Definition expired_timer2view (e : ExpiredTimer) :=
    match e with
    | expired_timer r v => v
    end.

  Definition bare_view_change2view (bvc : Bare_ViewChange) : View :=
    match bvc with
    | bare_view_change v n s C P i => v
    end.

  Definition view_change2view (vc : ViewChange) : View :=
    bare_view_change2view (view_change2bare vc).

  Definition prepared_info2view (p : PreparedInfo) : View :=
    pre_prepare2view (prepared_info_pre_prepare p).

  Definition start_timer2view (b : StartTimer) : View :=
    match b with
    | start_timer _ v => v
    end.

  (* =========== timer extraction =========== *)

  Definition start_timer2req (b : StartTimer) : Bare_Request :=
    match b with
    | start_timer r _ => r
    end.

  Definition start_timer2expired_timer (b : StartTimer) : ExpiredTimer :=
    match b with
    | start_timer r v => expired_timer r v
    end.

  (* =========== extract prepared info =========== *)

  Definition bare_view_change2prep (bvc : Bare_ViewChange) : list PreparedInfo :=
    match bvc with
    | bare_view_change v n s C P i => P
    end.

  Definition view_change2prep (vc : ViewChange) : list PreparedInfo :=
    bare_view_change2prep (view_change2bare vc).

  (* =========== extract original msg that client send =========== *)

  Definition bare_pre_prepare2requests (p : Bare_Pre_prepare) : list Request :=
    match p with
    | bare_pre_prepare _ _ m => m
    end.

  Definition pre_prepare2requests (p : Pre_prepare) : list Request :=
    match p with
    | pre_prepare bpp _ => bare_pre_prepare2requests bpp
    end.

  Definition prepared_info2requests (p : PreparedInfo) : list Request :=
    pre_prepare2requests (prepared_info_pre_prepare p).

  (* =========== extract digest of msg that client sent ===========*)

(*  Definition bare_pre_prepare2digest (p : Bare_Pre_prepare) : PBFTdigest :=
    match p with
    | bare_pre_prepare v n d => d
    end.*)

(*  Definition pre_prepare_data2digest (p : Pre_prepare_data) : PBFTdigest :=
    match p with
    | MkPrePrepareData b _ => bare_pre_prepare2digest b
    end.*)

(*  Definition pre_prepare2digest (p : Pre_prepare) : PBFTdigest :=
    match p with
    | pre_prepare b _ => pre_prepare_data2digest b
    end.*)

  Definition bare_prepare2digest (p : Bare_Prepare) : PBFTdigest  :=
    match p with
    | bare_prepare v n d i => d
    end.

  Definition prepare2digest (p : Prepare) : PBFTdigest  :=
    match p with
    | prepare b _ => bare_prepare2digest b
    end.

  Definition bare_commit2digest (c : Bare_Commit) : PBFTdigest :=
    match c with
    | bare_commit v n d i => d
    end.

  Definition commit2digest (c : Commit) : PBFTdigest :=
    match c with
    | commit b _ => bare_commit2digest b
    end.

  Definition bare_checkpoint2digest (c : Bare_Checkpoint) : PBFTdigest :=
    match c with
    | bare_checkpoint v n d i => d
    end.

  Definition checkpoint2digest (c : Checkpoint) : PBFTdigest :=
    match c with
    | checkpoint b _ => bare_checkpoint2digest b
    end.

  Definition prepared_info2digest (p : PreparedInfo) : PBFTdigest :=
    prepared_info_digest p.

  (* =========== Msg type =========== *)

  Inductive PBFTmsg :=
  | PBFTrequest              (r : Request)
  | PBFTpre_prepare          (p : Pre_prepare)
  | PBFTprepare              (p : Prepare)
  | PBFTcommit               (c : Commit)
  | PBFTreply                (r : Reply)
  | PBFTcheckpoint           (c : Checkpoint)
  | PBFTcheck_ready          (c : CheckReady)
  | PBFTcheck_stable         (c : CheckStableChkPt)
  | PBFTcheck_bcast_new_view (c : CheckBCastNewView)
  | PBFTstart_timer          (c : StartTimer)
  | PBFTexpired_timer        (t : ExpiredTimer)
  | PBFTview_change          (v : ViewChange)
  | PBFTnew_view             (v : NewView)
  | PBFTdebug                (d : Debug).

  Global Instance PBFT_I_Msg : Msg := MkMsg PBFTmsg.

  Definition PBFTmsg2status (m : PBFTmsg) : msg_status :=
    match m with
    | PBFTrequest              _ => MSG_STATUS_EXTERNAL
    | PBFTpre_prepare          _ => MSG_STATUS_PROTOCOL
    | PBFTprepare              _ => MSG_STATUS_PROTOCOL
    | PBFTcommit               _ => MSG_STATUS_PROTOCOL
    | PBFTcheckpoint           _ => MSG_STATUS_PROTOCOL
    | PBFTreply                _ => MSG_STATUS_PROTOCOL
    | PBFTcheck_ready          _ => MSG_STATUS_INTERNAL
    | PBFTcheck_stable         _ => MSG_STATUS_INTERNAL
    | PBFTcheck_bcast_new_view _ => MSG_STATUS_INTERNAL
    | PBFTstart_timer          _ => MSG_STATUS_INTERNAL
    | PBFTexpired_timer        _ => MSG_STATUS_INTERNAL
    | PBFTview_change          _ => MSG_STATUS_PROTOCOL
    | PBFTnew_view             _ => MSG_STATUS_PROTOCOL
    | PBFTdebug                _ => MSG_STATUS_INTERNAL
    end.

  Global Instance PBFT_I_get_msg_status : MsgStatus := MkMsgStatus PBFTmsg2status.

  (* =========== Receive functions and state machines =========== *)

  Definition receive_request (m : PBFTmsg) : option Request :=
    match m with
    | PBFTrequest r => Some r
    | _ => None
    end.

  Definition PBFTreceiveRequest : StateMachine _ PBFTmsg (option Request) :=
    mkSSM (fun state m _ => (state, receive_request m)) tt.

  Definition receive_pre_prepare (m : PBFTmsg) : option Pre_prepare :=
    match m with
    | PBFTpre_prepare p => Some p
    | _ => None
    end.

  Definition PBFTreceivePre_prepare : StateMachine _ PBFTmsg (option Pre_prepare) :=
    mkSSM (fun state m _ => (state, receive_pre_prepare m)) tt.

  Definition receive_prepare (m : PBFTmsg) : option Prepare :=
    match m with
    | PBFTprepare p => Some p
    | _ => None
    end.

  Definition PBFTreceivePrepare : StateMachine _ PBFTmsg (option Prepare) :=
    mkSSM (fun state m _ => (state, receive_prepare m)) tt.

  Definition receive_commit (m : PBFTmsg) : option Commit :=
    match m with
    | PBFTcommit c => Some c
    | _ => None
    end.

  Definition PBFTreceiveCommit : StateMachine _ PBFTmsg (option Commit) :=
    mkSSM (fun state m _ => (state, receive_commit m)) tt.

  Definition receive_checkpoint (m : PBFTmsg) : option Checkpoint :=
    match m with
    | PBFTcheckpoint c => Some c
    | _ => None
    end.

  Definition PBFTreceiveCheckpoint : StateMachine _ PBFTmsg (option Checkpoint) :=
    mkSSM (fun state m _ => (state, receive_checkpoint m)) tt.

  Definition receive_reply (m : PBFTmsg) : option Reply :=
    match m with
    | PBFTreply r => Some r
    | _ => None
    end.

  Definition PBFTreceiveReply : StateMachine _ PBFTmsg (option Reply) :=
    mkSSM (fun state m _ => (state, receive_reply m)) tt.

  (* ===============================================================
     Authenticated Messages
     =============================================================== *)

  Definition option_client2name (cop : option Client) (n : name) : name :=
    match cop with
    | Some c => PBFTclient c
    | None => n
    end.

  (* we are here extracting the sender of the message *)
  Definition PBFTmsg_auth (n : name) (m : msg) : option name :=
    match m with
    | PBFTrequest              r => Some (option_client2name (request2sender r) n)
    | PBFTpre_prepare          p => Some (PBFTreplica (pre_prepare2sender p))
    | PBFTprepare              p => Some (PBFTreplica (prepare2sender p))
    | PBFTcommit               c => Some (PBFTreplica (commit2sender c))
    | PBFTcheckpoint           c => Some (PBFTreplica (checkpoint2sender c))
    | PBFTreply                r => Some (PBFTreplica (reply2sender r))
    | PBFTcheck_ready          c => Some n (* local message *)
    | PBFTcheck_stable         c => Some n (* local message *)
    | PBFTcheck_bcast_new_view c => Some n (* local message *)
    | PBFTstart_timer          t => Some n (* local message *)
    | PBFTexpired_timer        t => Some n (* local message *)
    | PBFTview_change          v => Some (PBFTreplica (view_change2sender v))
    (* FIX: is the sender of a new-view message always the primary of the previous view?  *)
    | PBFTnew_view             v => Some (PBFTreplica (new_view2sender v))
    | PBFTdebug                d => Some (PBFTreplica (debug2sender d))
    end.

  Definition PBFTdata_auth (n : name) (m : data) : option name :=
    match m with
    | PBFTmsg_bare_request              r => Some (option_client2name (bare_request2sender r) n)
    | PBFTmsg_bare_pre_prepare          p => Some (PBFTreplica (bare_pre_prepare2sender p))
    | PBFTmsg_bare_prepare              p => Some (PBFTreplica (bare_prepare2sender p))
    | PBFTmsg_bare_commit               c => Some (PBFTreplica (bare_commit2sender c))
    | PBFTmsg_bare_checkpoint           c => Some (PBFTreplica (bare_checkpoint2sender c))
    | PBFTmsg_bare_reply                r => Some (PBFTreplica (bare_reply2sender r))
    | PBFTmsg_bare_check_ready          _ => Some n (* local message *)
    | PBFTmsg_bare_check_bcast_new_view _ => Some n (* local message *)
    | PBFTmsg_bare_start_timer          _ => Some n (* local message *)
    | PBFTmsg_bare_expired_timer        _ => Some n (* local message *)
    | PBFTmsg_bare_view_change          v => Some (PBFTreplica (bare_view_change2sender v))
    (* FIX: is the sender of a new-view message always the primary of the previous view?  *)
    | PBFTmsg_bare_new_view             v => Some (PBFTreplica (PBFTprimary ((*pred_view*) (bare_new_view2view v))))
    end.

  Global Instance PBFT_I_DataAuth : DataAuth := MkDataAuth PBFTdata_auth.

  Definition request2auth_data (r : Request) : AuthenticatedData :=
    match r with
    | req b a => MkAuthData (PBFTmsg_bare_request b) a
    end.

  Definition reply2auth_data (r : Reply) : AuthenticatedData :=
    match r with
    | reply b a => MkAuthData (PBFTmsg_bare_reply b) a
    end.

  Definition pre_prepare_data2auth_data_pre (p : Pre_prepare) : AuthenticatedData :=
    match p with
    | pre_prepare b a => MkAuthData (PBFTmsg_bare_pre_prepare b) a
    end.

  Definition pre_prepare2auth_data_req (p : Pre_prepare) : list AuthenticatedData :=
    map request2auth_data (pre_prepare2requests p).

  Definition pre_prepare2auth_data (p : Pre_prepare) : list AuthenticatedData :=
    pre_prepare_data2auth_data_pre p :: pre_prepare2auth_data_req p.
    (*match p with
    | pre_prepare b a => MkAuthData (PBFTmsg_bare_pre_prepare b) a
    end.*)

  Definition prepare2auth_data (p : Prepare) : AuthenticatedData :=
    match p with
    | prepare b a => MkAuthData (PBFTmsg_bare_prepare b) a
    end.

  Definition commit2auth_data (c : Commit) : AuthenticatedData :=
    match c with
    | commit b a => MkAuthData (PBFTmsg_bare_commit b) a
    end.

  Definition checkpoint2auth_data (c : Checkpoint) : AuthenticatedData :=
    match c with
    | checkpoint b a => MkAuthData (PBFTmsg_bare_checkpoint b) a
    end.

  Definition prepares2auth_data (l : list Prepare): list AuthenticatedData :=
    map prepare2auth_data l.

  Definition prepared_info2auth_data (p : PreparedInfo) : list AuthenticatedData :=
    (pre_prepare2auth_data (prepared_info_pre_prepare p))
      ++ (prepares2auth_data (prepared_info_prepares p)).

  Definition prepared_infos2auth_data (P : list PreparedInfo) : list AuthenticatedData :=
    flat_map prepared_info2auth_data P.

  Definition checkpoints2auth_data (l : list Checkpoint) : list AuthenticatedData :=
    map checkpoint2auth_data l.

  Definition view_change2auth_data (v : ViewChange) : list AuthenticatedData :=
    match v with
    | view_change (bare_view_change v n s C P i) a =>
      (MkAuthData (PBFTmsg_bare_view_change (bare_view_change v n s C P i)) a)
        :: checkpoints2auth_data C
        ++ prepared_infos2auth_data P
    end.

  Definition view_changes2auth_data (l : list ViewChange) : list AuthenticatedData :=
    flat_map view_change2auth_data l.

  Definition pre_prepares2auth_data (l : list Pre_prepare) : list AuthenticatedData :=
    flat_map pre_prepare2auth_data l.

  Definition new_view2auth_data (v : NewView) : list AuthenticatedData :=
    match v with
    | new_view (bare_new_view v V OP NP) a =>
      (MkAuthData (PBFTmsg_bare_new_view (bare_new_view v V OP NP)) a)
        :: view_changes2auth_data V
        ++ pre_prepares2auth_data OP
        ++ pre_prepares2auth_data NP
    end.

  Definition PBFTget_contained_auth_data (m : msg) : list AuthenticatedData :=
    match m with
    | PBFTrequest              r => [request2auth_data r]
    | PBFTreply                r => [reply2auth_data r]
    | PBFTpre_prepare          p => pre_prepare2auth_data p
    | PBFTprepare              p => [prepare2auth_data p]
    | PBFTcommit               p => [commit2auth_data p]
    | PBFTcheckpoint           p => [checkpoint2auth_data p]
    | PBFTcheck_ready          _ => [] (* internal message *)
    | PBFTcheck_stable         _ => [] (* internal message *)
    | PBFTcheck_bcast_new_view _ => [] (* internal message *)
    | PBFTstart_timer          _ => [] (* internal message *)
    | PBFTexpired_timer        _ => [] (* internal message *)
    | PBFTview_change          v => view_change2auth_data v
    | PBFTnew_view             v => new_view2auth_data v
    | PBFTdebug                _ => [] (* internal message *)
    end.

  (*
  Definition PBFTauthMsg2Msg (a : AuthenticatedData) : PBFTmsg :=
    match a with
    | MkAuthData d t =>
      match d with
      | PBFTmsg_bare_request r     => PBFTrequest (req r t)
      | PBFTmsg_bare_reply r       => PBFTreply (reply r t)
      | PBFTmsg_bare_pre_prepare p => exists r, PBFTpre_prepare (pre_prepare p t r) (* and digest or r is equal to d*)
      | PBFTmsg_bare_prepare p     => PBFTprepare (prepare p t)
      | PBFTmsg_bare_commit c      => PBFTcommit (commit c t)
      end
    end.
*)

  Global Instance PBFT_I_ContainedAuthData : ContainedAuthData :=
    MkContainedAuthData PBFTget_contained_auth_data.

  (*
  (* ===============================================================
     Assumptions about keys
     =============================================================== *)

  Definition PBFThold_keys (eo : EventOrdering) : Prop :=
    forall (e : Event),
      match loc e with
      | PBFTreplica n => forall m, has_key (keys e) (PBFTreplica m)
      | _ => True
      end.*)

  (* ===============================================================
     Sending functions
     =============================================================== *)

  Definition send_request (r : Request) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTrequest r) n ('0).

  Definition send_reply (r : Reply) : DirectedMsg :=
    MkDMsg (PBFTreply r) [PBFTclient (reply2client r)] ('0).

  Definition send_pre_prepare (p : Pre_prepare) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTpre_prepare p) n ('0).

  Definition send_prepare (p : Prepare) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTprepare p) n ('0).

  Definition send_commit (c : Commit) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTcommit c) n ('0).

  Definition send_checkpoint (c : Checkpoint) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTcheckpoint c) n ('0).

  Definition send_debug (n : Rep) (s : String.string) : DirectedMsg :=
    MkDMsg (PBFTdebug (debug n s)) [PBFTreplica n] ('0).

  Definition send_view_change (v : ViewChange) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTview_change v) n ('0).

  Definition send_new_view (v : NewView) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTnew_view v) n ('0).

  Definition send_check_ready (n : Rep) : DirectedMsg :=
    MkDMsg (PBFTcheck_ready check_ready) [PBFTreplica n] ('0).

  Definition send_check_stable (n : Rep) : DirectedMsg :=
    MkDMsg (PBFTcheck_stable check_stable_checkpoint) [PBFTreplica n] ('0).

  Definition send_check_bcast_new_view (c : CheckBCastNewView) (n : list name) : DirectedMsg :=
    MkDMsg (PBFTcheck_bcast_new_view c) n ('0).

  Definition send_start_timer (t : StartTimer) (n : Rep) : DirectedMsg :=
    MkDMsg (PBFTstart_timer t) [PBFTreplica n] ('PBFTtimer_delay).

  Definition send_expired_timer (t : ExpiredTimer) (n : Rep) : DirectedMsg :=
    MkDMsg (PBFTexpired_timer t) [PBFTreplica n] ('0).

  (* ===============================================================
     Verify functions
     =============================================================== *)

  Definition verify_request (slf : Rep) (km : local_key_map) (r : Request) : bool :=
    match r with
    | req b a =>
      verify_authenticated_data
        (PBFTreplica slf) (*(PBFTclient (request2sender r))*)
        (MkAuthData (PBFTmsg_bare_request b) a)
        km
    end.

  Definition verify_requests (slf : Rep) (km : local_key_map) (rs : list Request) : bool :=
    forallb (verify_request slf km) rs.

(*  Definition verify_pre_prepare_data (slf : Rep) (km : local_key_map) (p : Pre_prepare_data) : bool :=
    match p with
    | MkPrePrepareData b a =>
      verify_authenticated_data
        (PBFTreplica slf) (*(PBFTreplica (bare_pre_prepare2sender b))*)
        (MkAuthData (PBFTmsg_bare_pre_prepare b) a)
        km
    end.*)

  Definition verify_pre_prepare (slf : Rep) (km : local_key_map) (p : Pre_prepare) : bool :=
    verify_list_auth_data (PBFTreplica slf) km (pre_prepare2auth_data p).

  Definition verify_prepare (slf : Rep) (km : local_key_map) (p : Prepare) : bool :=
    verify_authenticated_data
      (PBFTreplica slf)
      (prepare2auth_data p)
      km.

  Definition verify_commit (slf : Rep) (km : local_key_map) (c : Commit) : bool :=
    verify_authenticated_data
      (PBFTreplica slf)
      (commit2auth_data c)
      km.

  Definition verify_checkpoint (slf : Rep) (km : local_key_map) (c : Checkpoint) : bool :=
    verify_authenticated_data
      (PBFTreplica slf)
      (checkpoint2auth_data c)
      km.

  Definition verify_view_change (slf : Rep) (km : local_key_map) (vc : ViewChange) : bool :=
    verify_list_auth_data (PBFTreplica slf) km (view_change2auth_data vc).

  Definition verify_new_view (slf : Rep) (km : local_key_map) (nv : NewView) : bool :=
    verify_list_auth_data (PBFTreplica slf) km (new_view2auth_data nv).

  (* ===============================================================
     Creation of authenticated messages
     =============================================================== *)

  Definition mk_auth_pre_prepare
             (v : View)
             (s : SeqNum)
             (d : list Request)
             (keys : local_key_map) : Pre_prepare :=
    let bpp  := bare_pre_prepare v s d in
    (* we authenticate the unsigned pre-prepare message *)
    let toks := authenticate (PBFTmsg_bare_pre_prepare bpp) keys in
    (* we create an authenticated pre-prepare message *)
    pre_prepare bpp toks.

  Definition mk_auth_new_view
             (v : View)
             (V : ViewChangeCert)
             (OP NP : list Pre_prepare)
             (keys : local_key_map) : NewView :=
    let bnv  := bare_new_view v V OP NP in
    let toks := authenticate (PBFTmsg_bare_new_view bnv) keys in
    new_view bnv toks.

  Definition mk_auth_reply
             (v : View)
             (t : Timestamp)
             (c : Client)
             (i : Rep)
             (r : PBFTresult)
             (keys : local_key_map) : Reply :=
    let brep := bare_reply v t c i r in
    (* we authenticate the unsigned reply message *)
    let toks := authenticate (PBFTmsg_bare_reply brep) keys in
    (* we create an authenticated reply message *)
    reply brep toks.

  Definition mk_auth_checkpoint
             (v : View)
             (n : SeqNum)
             (d : PBFTdigest)
             (i : Rep)
             (keys : local_key_map) : Checkpoint :=
    let bcp    := bare_checkpoint v n d i in
    (* we authenticate the unsigned checkpoint message *)
    let toks   := authenticate (PBFTmsg_bare_checkpoint bcp) keys in
    (* we create an authenticated checkpoint message *)
    checkpoint bcp toks.

  Definition mk_auth_view_change
             (v : View)
             (n : SeqNum)
             (s : StableChkPt)
             (C : CheckpointCert)
             (P : list PreparedInfo)
             (i : Rep)
             (keys : local_key_map) : ViewChange :=
    let bvc  := bare_view_change v n s C P i in
    let toks := authenticate (PBFTmsg_bare_view_change bvc) keys in
    view_change bvc toks.

  Definition prepare2commit (slf : Rep) (keys : local_key_map) (p : Prepare) : Commit :=
    (* we create a commit message *)
    let bc   := prepare2bare_commit slf p in
    (* we authenticate the unsigned commit message *)
    let toks := authenticate (PBFTmsg_bare_commit bc) keys in
    (* we create an authenticated prepare message *)
    commit bc toks.

  Definition pre_prepare2prepare
             (n    : Rep)
             (keys : local_key_map)
             (pp   : Pre_prepare)
             (d    : PBFTdigest) : Prepare :=
    let bp := pre_prepare2bare_prepare pp d n in
    let a  := authenticate (PBFTmsg_bare_prepare bp) keys in
    prepare bp a.

  Definition pre_prepare2commit
             (slf  : Rep)
             (keys : local_key_map)
             (pp   : Pre_prepare)
             (d    : PBFTdigest) : Commit :=
    (* we create a commit message *)
    let bc   := pre_prepare2bare_commit slf pp d in
    (* we authenticate the unsigned commit message *)
    let toks := authenticate (PBFTmsg_bare_commit bc) keys in
    (* we create an authenticated prepare message *)
    commit bc toks.

  Definition mk_auth_null_req (keys : local_key_map) : Request :=
    req null_req (authenticate (PBFTmsg_bare_request null_req) keys).

  (* ===============================================================
     Hashing
     =============================================================== *)

  (* FIX: These should really hash something like a list of bytes,
       but for that we need to convert messages/states to bytes. *)
  Class PBFThash :=
    MkPBFThash
      {
        create_hash_messages : list PBFTmsg -> PBFTdigest;
        verify_hash_messages : list PBFTmsg -> PBFTdigest -> bool;

        create_hash_state_last_reply  : PBFTsm_state -> LastReplyState -> PBFTdigest;
        verify_hash_state_last_reply  : PBFTsm_state -> LastReplyState -> PBFTdigest -> bool;
      }.

  Context { pbft_hash : PBFThash }.

(* (* To bring in later when we actually need it *)
  Class PBFThash_axioms :=
    {
      create_hash_messages_collision_resistant :
        forall msgs1 msgs2,
          create_hash_messages msgs1 = create_hash_messages msgs2
          -> msgs1 = msgs2;

      create_hash_state_last_reply_collision_resistant :
        forall sm1 sm2 last1 last2,
          create_hash_state_last_reply sm1 last1 = create_hash_state_last_reply sm2 last2
          -> sm1 = sm2 /\ last1 = last2
    }.

  Context { pbft_hash_axioms : PBFThash_axioms }.*)

End PBFTheader.


(*! End-to-end correctness theorem !*)
Require Import Koika.CompilerCorrectness.CircuitCorrectness Koika.CompilerCorrectness.LoweringCorrectness.
Require Import Koika.Common Koika.Types Koika.Environments Koika.Logs.
Require Import Koika.Lowering Koika.CircuitGeneration Koika.CircuitOptimization Koika.Compiler.

Section Thm.
  Context {pos_t var_t fn_name_t rule_name_t reg_t ext_fn_t: Type}.
  Context {eq_dec_var_t: EqDec var_t}.

  Context {R: reg_t -> type}.
  Context {Sigma: ext_fn_t -> ExternalSignature}.
  Context {FiniteType_reg_t: FiniteType reg_t}.
  Context {Show_var_t : Show var_t}.
  Context {Show_rule_name_t : Show rule_name_t}.

  Context (r: ContextEnv.(env_t) R).
  Context (sigma: forall f, Sig_denote (Sigma f)).

  Notation CR := (lower_R R).
  Notation CSigma := (lower_Sigma Sigma).

  Notation cr := (lower_r r).
  Notation csigma := (lower_sigma sigma).

  Context (lco: (@local_circuit_optimizer
                   rule_name_t reg_t ext_fn_t
                   CR CSigma
                   (rwdata (rule_name_t := rule_name_t) CR CSigma)
                   (lower_sigma sigma))).

  Section Standalone.
    Context (s: Syntax.scheduler pos_t rule_name_t).
    Context (rules: rule_name_t -> TypedSyntax.rule pos_t var_t fn_name_t R Sigma).
    Context (external: rule_name_t -> bool).

    Theorem compiler_correct:
      let spec_results := TypedSemantics.interp_cycle sigma rules s r in
      let circuits := compile_scheduler lco rules external s in
      forall reg,
        interp_circuit cr csigma (ContextEnv.(getenv) circuits reg) =
        bits_of_value (ContextEnv.(getenv) spec_results reg).
    Proof.
      cbv zeta; intros.
      setoid_rewrite compile_scheduler'_correct.
      - rewrite cycle_lowering_correct.
        unfold lower_r, lower_log; rewrite getenv_map; reflexivity.
      - apply circuit_env_equiv_CReadRegister.
    Qed.
  End Standalone.
End Thm.


Require Import Coq.Lists.List.
Require Import Coq.Strings.Ascii.
Require Char.
Require Import Comparison.
Require Import LString.

Import ListNotations.
Import LString.
Local Open Scope char.

(** Test if the string contains only ASCII characters. *)
Definition is_ascii (s : t) : bool :=
  List.forallb Char.is_ascii s.

(** Test if the string is empty. *)
Definition is_empty (s : t) : bool :=
  match s with
  | [] => true
  | _ :: _ => false
  end.

(** Repeat a string [n] times. *)
Fixpoint repeat (s : t) (n : nat) : t :=
  match n with
  | O => []
  | S n => s ++ repeat s n
  end.

(** Center a string on a line of width [width], with white space paddings. *)
Definition center (s : t) (width : nat) : t :=
  let l := List.length s in
  let l_left := Nat.div2 (width - l) in
  let l_right := (width - l) - l_left in
  repeat [" "] l_left ++ s ++ repeat [" "] l_right.

(** Concatenate the list of strings [l] with the separator [separator]. *)
Fixpoint join (separator : t) (l : list t) : t :=
  match l with
  | [] => []
  | [s] => s
  | s :: l => s ++ separator ++ join separator l
  end.

Fixpoint split_aux (s : t) (c : ascii) (beginning : t) : list t :=
  match s with
  | [] => [List.rev' beginning]
  | c' :: s =>
    if Char.eqb c c' then
      List.rev' beginning :: split_aux s c []
    else
      split_aux s c (c' :: beginning)
  end.

(** Split a string at each occurrence of a given character. *)
Definition split (s : t) (c : ascii) : list t :=
  split_aux s c [].

Fixpoint split_limit_aux (s : t) (c : ascii) (beginning : t) (limit : nat)
  : list t :=
  match limit with
  | O => []
  | S O => [List.rev' beginning ++ s]
  | S limit =>
    match s with
    | [] => [List.rev' beginning]
    | c' :: s =>
      if Char.eqb c c' then
        List.rev' beginning :: split_limit_aux s c [] limit
      else
        split_limit_aux s c (c' :: beginning) (S limit)
    end
  end.

(** Split a string at each occurrence of a given character in a list of up to
    [limit] elements. *)
Definition split_limit (s : t) (c : ascii) (limit : nat) : list t :=
  split_limit_aux s c [] limit.

(** Escape the string to generate correct HTML. *)
Fixpoint escape_html (s : t) : t :=
  match s with
  | [] => []
  | c :: s =>
    match c with
    | "'" => ["&"; "a"; "p"; "o"; "s"; ";"]
    | """" => ["&"; "q"; "u"; "o"; "t"; ";"]
    | "&" => ["&"; "a"; "m"; "p"; ";"]
    | "<" => ["&"; "l"; "t"; ";"]
    | ">" => ["&"; "g"; "t"; ";"]
    | _ => [c]
    end ++ escape_html s
  end.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** Extraction to OCaml of native 63-bit machine integers. *)

From Coq Require Uint63 Sint63 Extraction.

(** Basic data types used by some primitive operators. *)

Extract Inductive bool => bool [ true false ].
Extract Inductive prod => "( * )" [ "" ].
Extract Inductive DoubleType.carry => "MCUint63.carry" [ "MCUint63.C0" "MCUint63.C1" ].

(** Primitive types and operators. *)
Extract Constant Uint63.int => "MCUint63.t".
Extraction Inline Uint63.int.
(* Otherwise, the name conflicts with the primitive OCaml type [int] *)

Extract Constant Uint63.lsl => "MCUint63.l_sl".
Extract Constant Uint63.lsr => "MCUint63.l_sr".
Extract Constant Sint63.asr => "MCUint63.a_sr".
Extract Constant Uint63.land => "MCUint63.l_and".
Extract Constant Uint63.lor => "MCUint63.l_or".
Extract Constant Uint63.lxor => "MCUint63.l_xor".

Extract Constant Uint63.add => "MCUint63.add".
Extract Constant Uint63.sub => "MCUint63.sub".
Extract Constant Uint63.mul => "MCUint63.mul".
Extract Constant Uint63.mulc => "MCUint63.mulc".
Extract Constant Uint63.div => "MCUint63.div".
Extract Constant Uint63.mod => "MCUint63.rem".
Extract Constant Sint63.div => "MCUint63.divs".
Extract Constant Sint63.rem => "MCUint63.rems".

Extract Constant Uint63.eqb => "MCUint63.equal".
Extract Constant Uint63.ltb => "MCUint63.lt".
Extract Constant Uint63.leb => "MCUint63.le".
Extract Constant Sint63.ltb => "MCUint63.lts".
Extract Constant Sint63.leb => "MCUint63.les".

Extract Constant Uint63.addc => "MCUint63.addc".
Extract Constant Uint63.addcarryc => "MCUint63.addcarryc".
Extract Constant Uint63.subc => "MCUint63.subc".
Extract Constant Uint63.subcarryc => "MCUint63.subcarryc".

Extract Constant Uint63.diveucl => "MCUint63.diveucl".
Extract Constant Uint63.diveucl_21 => "MCUint63.div21".
Extract Constant Uint63.addmuldiv => "MCUint63.addmuldiv".

Extract Constant Uint63.compare =>
  "fun x y -> match MCUint63.compare x y with 0 -> Eq | c when c < 0 -> Lt | _ -> Gt".
Extract Constant Sint63.compare =>
  "fun x y -> match MCUint63.compares x y with 0 -> Eq | c when c < 0 -> Lt | _ -> Gt".

Extract Constant Uint63.head0 => "MCUint63.head0".
Extract Constant Uint63.tail0 => "MCUint63.tail0".


(** Experiments on encoding concurrency in Coq. *)
Require Import Arith.
Require Import List.
Require Import Streams.
Require Import String.

Import ListNotations.
Local Open Scope string_scope.

Set Implicit Arguments.

Module Result.
  Inductive t (A B C : Type) : Type :=
  | Val : A -> t A B C
  | Err : B -> t A B C
  | Mon : C -> t A B C.

  Arguments Val [A] [B] [C] _.
  Arguments Err [A] [B] [C] _.
  Arguments Mon [A] [B] [C] _.
End Result.

Import Result.

(** Definition of a computation. *)
Module C.
  Inductive t (S : Type) (E : Type) (A : Type) : Type :=
  | make : (S -> Result.t A E (t S E A) * S) -> t S E A.

  Definition open S E A (x : t S E A) :=
    match x with
    | make x' => x'
    end.
End C.

(** Monadic return. *)
Definition ret {S E A} (x : A) : C.t S E A :=
  C.make (fun s => (Val x, s)).

(** Monadic bind. *)
Fixpoint bind S E A B (x : C.t S E A) (f : A -> C.t S E B) : C.t S E B :=
  C.make (fun s =>
    match C.open x s with
    | (Val x, s) => (Mon (f x), s)
    | (Err e, s) => (Err e, s)
    | (Mon x, s) => (Mon (bind x f), s)
    end).

Notation "'let!' X ':=' A 'in' B" := (bind A (fun X => B))
  (at level 200, X ident, A at level 100, B at level 200).

(** Raw evaluation. *)
Fixpoint eval S E A (x : C.t S E A) (s : S) : (A + E) * S :=
  match C.open x s with
  | (Val x, s) => (inl x, s)
  | (Err e, s) => (inr e, s)
  | (Mon x, s) => eval x s
  end.

(** Augment the state. *)
Fixpoint lift_state S1 S2 E A (x : C.t S1 E A) : @C.t (S1 * S2) E A :=
  C.make (fun (s : S1 * S2) =>
    let (s1, s2) := s in
    match C.open x s1 with
    | (Val x, s1) => (Val x, (s1, s2))
    | (Err e, s1) => (Err e, (s1, s2))
    | (Mon x, s1) => (Mon (lift_state _ x), (s1, s2))
    end).

(** Apply an isomorphism to the state. *)
Fixpoint map_state S1 S2 E A (f : S1 -> S2) (g : S2 -> S1) (x : C.t S1 E A)
  : C.t S2 E A :=
  C.make (fun (s2 : S2) =>
    let s1 := g s2 in
    let (r, s1) := C.open x s1 in
    (match r with
    | Val x => Val x
    | Err e => Err e
    | Mon x => Mon (map_state f g x)
    end, f s1)).

Module Option.
  Definition none A : C.t unit unit A :=
    C.make (fun _ => (Err tt, tt)).
End Option.

Module Error.
  Definition raise E A (e : E) : C.t unit E A :=
    C.make (fun _ => (Err e, tt)).
End Error.

Module Log.
  Definition t := list.

  Definition log A (x : A) : C.t (t A) Empty_set unit :=
    C.make (fun s => (Val tt, x :: s)).
End Log.

Module State.
  Definition read (S : Type) (_ : unit) : C.t S Empty_set S :=
    C.make (fun s => (Val s, s)).

  Definition write (S : Type) (x : S) : C.t S Empty_set unit :=
    C.make (fun _ => (Val tt, x)).
End State.

(** A source of information for a concurrent scheduler. *)
Module Entropy.
  Require Import BinNat.

  Definition t := Stream bool.

  Definition left : t := Streams.const true.

  Definition right : t := Streams.const false.

  Definition inverse (e : t) : t :=
    Streams.map negb e.

  Definition half : t :=
    let cofix aux b :=
      Streams.Cons b (aux (negb b)) in
    aux true.

  CoFixpoint random_naturals (n : N) : Stream N :=
    let n' := N.modulo (137 * n + 187) 256 in
    Streams.Cons n (random_naturals n').

  Definition random (seed : N) : t :=
    Streams.map (fun n => N.even (N.div n 64)) (random_naturals seed).

  Module Test.
    Fixpoint hds A (n : nat) (e : Stream A) : list A :=
      match n with
      | O => []
      | S n => Streams.hd e :: hds n (Streams.tl e)
      end.

    Compute hds 20 (random_naturals 0).
    Compute hds 20 (random 0).
    Compute hds 20 (random 12).
    Compute hds 20 (random 23).
  End Test.
End Entropy.

Module Concurrency.
  (** Executes [x] and [y] concurrently, using a boolean stream as source of entropy. *)
  Fixpoint par S E A B
    (x : C.t (S * Entropy.t) E A) (y : C.t (S * Entropy.t) E B) {struct x}
    : C.t (S * Entropy.t) E (A * B) :=
    let fix par_aux y {struct y} : C.t (S * Entropy.t) E (A * B) :=
      C.make (fun (s : S * Entropy.t) =>
        match s with
        | (s, Streams.Cons b bs) =>
          if b then
            let (r, ss) := C.open x (s, bs) in
            (match r with
            | Val x => Mon (let! y := y in ret (x, y))
            | Err e => Err e
            | Mon x => Mon (par x y)
            end, ss)
          else
            let (r, ss) := C.open y (s, bs) in
            (match r with
            | Val y => Mon (let! x := x in ret (x, y))
            | Err e => Err e
            | Mon y => Mon (par_aux y)
            end, ss)
        end) in
    C.make (fun (s : S * Entropy.t) =>
      match s with
      | (s, Streams.Cons b bs) =>
        if b then
          let (r, ss) := C.open x (s, bs) in
          (match r with
          | Val x => Mon (let! y := y in ret (x, y))
          | Err e => Err e
          | Mon x => Mon (par x y)
          end, ss)
        else
          let (r, ss) := C.open y (s, bs) in
          (match r with
          | Val y => Mon (let! x := x in ret (x, y))
          | Err e => Err e
          | Mon y => Mon (par_aux y)
          end, ss)
      end).

  Definition par_unit S E (x : C.t (S * Entropy.t) E unit) (y : C.t (S * Entropy.t) E unit)
    : C.t (S * Entropy.t) E unit :=
    let! _ := par x y in
    ret tt.

  (** Make [x] atomic. *)
  Fixpoint atomic S E A (x : C.t S E A) : C.t S E A :=
    C.make (fun (s : S) =>
      match C.open x s with
      | (Val _, _) as y | (Err _, _) as y => y
      | (Mon x, s) => C.open (atomic x) s
      end).
End Concurrency.

Module List.
  Fixpoint iter_seq S E A (f : A -> C.t S E unit) (l : list A) : C.t S E unit :=
    match l with
    | [] => ret tt
    | x :: l =>
      let! _ := f x in
      iter_seq f l
    end.

  Fixpoint iter_par S E A (f : A -> C.t (S * Entropy.t) E unit) (l : list A)
    : C.t (S * Entropy.t) E unit :=
    match l with
    | [] => ret tt
    | x :: l => Concurrency.par_unit (f x) (iter_par f l)
    end.
End List.

Module Event.
  Definition t := list.

  Definition loop_seq S E A (f : A -> C.t S E unit) : C.t (S * t A) E unit :=
    C.make (fun (s : S * t A) =>
      let (s, events) := s in
      (Mon (lift_state (t A) (List.iter_seq f events)), (s, []))).

  Definition loop_par S E A (f : A -> C.t (S * Entropy.t) E unit)
    : C.t (S * t A * Entropy.t) E unit :=
    C.make (fun (s : S * t A * Entropy.t) =>
      match s with
      | (s, events, entropy) =>
        let c := List.iter_par f events in
        let c := lift_state (t A) c in
        let c := map_state
          (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
          (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
          c in
        (Mon c, (s, [], entropy))
      end).

  Module Test.
    Definition log_all (_ : unit) : C.t (Log.t nat * t nat * Entropy.t) Empty_set unit :=
      loop_par (fun n =>
        lift_state _ (Log.log n)).

    Definition eval (inputs : list nat) (entropy : Entropy.t) : list nat :=
      match snd (eval (log_all tt) ([], inputs, entropy)) with
      | (output, _, _) => output
      end.

    Compute eval [] Entropy.left.
    Compute eval [1; 2; 3] Entropy.left.
    Compute eval [1; 2; 3] Entropy.right.
  End Test.
End Event.

Module Test.
  Definition eval_seq (x : C.t (list nat) Empty_set unit) : list nat :=
    snd (eval x []).

  Definition eval_par (x : C.t (list nat * Entropy.t) Empty_set unit) (e : Entropy.t) : list nat :=
    fst (snd (eval x ([], e))).

  (** Two threads are printing concurrently two lists of numbers. *)
  Module PrintList.
    Fixpoint print_before (n : nat) : C.t (Log.t nat) Empty_set unit :=
      match n with
      | O => ret tt
      | S n =>
        let! _ := Log.log n in
        print_before n
      end.

    Definition two_prints_seq (n : nat) : C.t (Log.t nat) Empty_set unit :=
      let! _ := print_before n in
      print_before (2 * n).

    Definition print_before_par (n : nat) : C.t (Log.t nat * Entropy.t) Empty_set unit :=
      lift_state (Entropy.t) (print_before n).

    Definition two_prints_par (n : nat) : C.t (Log.t nat * Entropy.t) Empty_set unit :=
      Concurrency.par_unit (print_before_par n) (print_before_par (2 * n)).

    Compute eval_seq (print_before 12).
    Compute eval_seq (two_prints_seq 12).

    Compute eval_par (print_before_par 12) Entropy.half.
    Compute eval_par (two_prints_par 12) Entropy.left.
    Compute eval_par (two_prints_par 12) Entropy.right.
    Compute eval_par (two_prints_par 12) Entropy.half.
    Compute eval_par (two_prints_par 12) (Entropy.random 0).
  End PrintList.

  (** A list of threads are printing a number each. *)
  Module ListOfPrints.
    Definition print_seq_seq (n k : nat) : C.t (Log.t nat) Empty_set unit :=
      List.iter_seq (Log.log (A := nat)) (List.seq n k).

    Definition print_seq_par (n k : nat) : C.t (Log.t nat * Entropy.t) Empty_set unit :=
      List.iter_par (fun n => lift_state _ (Log.log n)) (List.seq n k).

    Compute eval_seq (print_seq_seq 10 20).
    Compute eval_par (print_seq_par 10 20) Entropy.left.
    Compute eval_par (print_seq_par 10 20) Entropy.right.
    Compute eval_par (print_seq_par 10 20) (Entropy.random 12).
  End ListOfPrints.

  (** Simple manager for a list of things to do, with a UI saving data on a server. *)
  Module TodoManager.
    (** Event from the UI. *)
    Module UiInput.
      Inductive t : Set :=
      | Add : string -> t
      | Remove : nat -> t.
    End UiInput.

    (** Message to the UI. *)
    Module UiOutput.
      Inductive t :=
      | Make : list string -> t.
    End UiOutput.

    (** Event from the server. *)
    Module ServerInput.
      Inductive t :=
      | Make : list string -> t.
    End ServerInput.

    (** Message to the server. *)
    Module ServerOutput.
      Inductive t :=
      | Make : list string -> t.
    End ServerOutput.

    Module Model.
      (** The model is a list of tasks. *)
      Inductive t :=
      | Make : list string -> t.

      Definition add (task : string) : C.t Model.t Empty_set unit :=
        Concurrency.atomic (
          let! model := State.read Model.t tt in
          match model with
          | Model.Make tasks => State.write (Model.Make (task :: tasks))
          end).

      Definition remove (id : nat) : C.t Model.t Empty_set unit :=
        Concurrency.atomic (
          let! model := State.read Model.t tt in
          match model with
          | Model.Make tasks => State.write (Model.Make tasks) (* TODO *)
          end).

      Definition get (_ : unit) : C.t Model.t Empty_set Model.t :=
        State.read Model.t tt.

      Definition set (model : t) : C.t Model.t Empty_set unit :=
        State.write model.
    End Model.

    (** Send an update to the UI system. *)
    Definition push_ui (_ : unit) : C.t (Model.t * Log.t UiOutput.t) Empty_set unit :=
      let! model := lift_state (Log.t UiOutput.t) (Model.get tt) in
      match model with
      | Model.Make tasks =>
        map_state
          (fun ss => match ss with (s1, s2) => (s2, s1) end)
          (fun ss => match ss with (s1, s2) => (s2, s1) end)
          (lift_state Model.t (Log.log (UiOutput.Make tasks)))
      end.

    (** Send an update to the server. *)
    Definition push_server (_ : unit) : C.t (Model.t * Log.t ServerOutput.t) Empty_set unit :=
      let! model := lift_state (Log.t ServerOutput.t) (Model.get tt) in
      match model with
      | Model.Make tasks =>
        map_state
          (fun ss => match ss with (s1, s2) => (s2, s1) end)
          (fun ss => match ss with (s1, s2) => (s2, s1) end)
          (lift_state Model.t (Log.log (ServerOutput.Make tasks)))
      end.

    (** Update the UI and the server. *)
    Definition broadcast_model (_ : unit)
      : C.t (Model.t * Log.t UiOutput.t * Log.t ServerOutput.t * Entropy.t) Empty_set unit :=
      let c_ui := lift_state Entropy.t (lift_state (Log.t ServerOutput.t) (push_ui tt)) in
      let c_server := lift_state Entropy.t (map_state
        (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
        (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
        (lift_state (Log.t UiOutput.t) (push_server tt))) in
      Concurrency.par_unit c_ui c_server.

    (** Handle an event from the UI. *)
    Definition handle_ui (event : UiInput.t)
      : C.t (Model.t * Log.t UiOutput.t * Log.t ServerOutput.t * Entropy.t) Empty_set unit :=
      let lift c :=
        lift_state Entropy.t (lift_state (Log.t ServerOutput.t) (lift_state (Log.t UiOutput.t) c)) in
      match event with
      | UiInput.Add task =>
        let! _ := lift (Model.add task) in
        broadcast_model tt
      | UiInput.Remove id =>
        let! _ := lift (Model.remove id) in
        broadcast_model tt
      end.

    Definition eval_handle_ui (inputs : list UiInput.t) (entropy : Entropy.t)
      : list UiOutput.t * list ServerOutput.t :=
      match snd (eval (Event.loop_par handle_ui) (Model.Make [], [], [], inputs, entropy)) with
      | (_, ui_outputs, server_outputs, _, _) => (ui_outputs, server_outputs)
      end.

    Compute eval_handle_ui [] Entropy.left.
    Compute eval_handle_ui [UiInput.Add "task1"; UiInput.Add "task2"] Entropy.left.
    Compute eval_handle_ui [UiInput.Add "task1"; UiInput.Add "task2"] Entropy.right.

    (** Handle an event from the server. *)
    Definition handle_server (event : ServerInput.t)
      : C.t (Model.t * Log.t UiOutput.t) Empty_set unit :=
      match event with
      | ServerInput.Make tasks =>
        let! _ := lift_state (Log.t UiOutput.t) (Model.set (Model.Make tasks)) in
        push_ui tt
      end.

    Definition eval_handle_server (inputs : list ServerInput.t) (entropy : Entropy.t) : list UiOutput.t :=
      let c := Event.loop_par (fun event => lift_state Entropy.t (handle_server event)) in
      match snd (eval c (Model.Make [], [], inputs, entropy)) with
      | (_, outputs, _, _) => outputs
      end.

    Compute eval_handle_server [] Entropy.left.
    Compute eval_handle_server [ServerInput.Make ["task1"]; ServerInput.Make ["task2"]] Entropy.left.
    Compute eval_handle_server [ServerInput.Make ["task1"]; ServerInput.Make ["task2"]] Entropy.right.

    Definition lifted_handle_server (event : ServerInput.t)
      : C.t (Model.t * Log.t UiOutput.t * Log.t ServerOutput.t * Entropy.t) Empty_set unit :=
      lift_state Entropy.t (lift_state (Log.t ServerOutput.t) (handle_server event)).

    Definition State : Type :=
      (Model.t * Log.t UiOutput.t * Log.t ServerOutput.t * Event.t UiInput.t * Event.t ServerInput.t * Entropy.t)%type.

    (** The TODO manager client. *)
    Definition todo (_ : unit) : C.t State Empty_set unit :=
      let c_ui : C.t State Empty_set unit :=
        (* Handle events concurrently. *)
        let c := Event.loop_par handle_ui in
        let c := lift_state (Event.t ServerInput.t) c in
        map_state
          (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
          (fun ss => match ss with (s1, s2, s3) => (s1, s3, s2) end)
          c in
      let c_server : C.t State Empty_set unit :=
        (* Handle events concurrently. *)
        let c := Event.loop_par lifted_handle_server in
        let c := lift_state (Event.t UiInput.t) c in
        map_state
          (fun ss => match ss with (s1, s2, s3, s4) => (s1, s4, s2, s3) end)
          (fun ss => match ss with (s1, s2, s3, s4) => (s1, s3, s4, s2) end)
          c in
      Concurrency.par_unit c_ui c_server.

    Definition eval (ui_inputs : list UiInput.t) (server_inputs : list ServerInput.t) (entropy : Entropy.t)
      : list UiOutput.t * list ServerOutput.t :=
      match snd (eval (todo tt) (Model.Make [], [], [], ui_inputs, server_inputs, entropy)) with
      | (_, ui_outputs, server_outputs, _, _, _) => (ui_outputs, server_outputs)
      end.

    Compute eval [] [] (Entropy.random 12).
    Compute eval [UiInput.Add "task1"] [] (Entropy.random 12).
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"] [] Entropy.left.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"] [] Entropy.right.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"; UiInput.Add "task3"] [] Entropy.left.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"; UiInput.Add "task3"] [] Entropy.right.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"; UiInput.Add "task3"] [] (Entropy.random 10).
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"] [ServerInput.Make ["task3"]] Entropy.left.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"] [ServerInput.Make ["task3"]] Entropy.right.
    Compute eval [UiInput.Add "task1"; UiInput.Add "task2"] [ServerInput.Make ["task3"]] (Entropy.random 10).
  End TodoManager.
End Test.


Set Implicit Arguments.

Require Import ADT.

Module Make (Import E : ADT).

  Require Import AutoSep.

  Require Import Transit.
  Module Import TransitMake := Make E.
  Require Import Semantics.
  Module Import SemanticsMake := Make E.

  Section TopSection.

    Require Import Syntax.
    Require Import GLabel.

    Definition Env := ((glabel -> option W) * (W -> option Callee))%type.

    Require Import SemanticsExpr.

    Definition strengthen_op_ax (spec_op : InternalFuncSpec) spec_ax env_ax :=
      let args := ArgVars spec_op in
      let rvar := RetVar spec_op in
      let s := Body spec_op in
      (forall ins,
         PreCond spec_ax ins ->
         length args = length ins) /\
      (forall v,
         TransitSafe spec_ax (map (sel (fst v)) args) (snd v) ->
         Safe env_ax s v) /\
      forall v v',
        RunsTo env_ax s v v' ->
        TransitSafe spec_ax (map (sel (fst v)) args) (snd v) ->
        TransitTo spec_ax (map (sel (fst v)) args) (snd v) (sel (fst v') rvar) (snd v').

    Definition strengthen (env_op env_ax : Env) :=
      (forall lbl, fst env_op lbl = fst env_ax lbl) /\
      let fs_op := snd env_op in
      let fs_ax := snd env_ax in
      forall w,
        fs_op w = fs_ax w \/
        exists spec_op spec_ax,
          fs_op w = Some (Internal spec_op) /\
          fs_ax w = Some (Foreign spec_ax) /\
          strengthen_op_ax spec_op spec_ax env_ax.

    Hint Unfold RunsTo.
    Hint Constructors Semantics.RunsTo.
    Hint Unfold Safe.
    Hint Constructors Semantics.Safe.

    Require Import GeneralTactics GeneralTactics3.

    Lemma strengthen_runsto : forall env_op s v v', RunsTo env_op s v v' -> forall env_ax, strengthen env_op env_ax -> Safe env_ax s v -> RunsTo env_ax s v v'.
      induction 1; simpl; intros; unfold_all.

      Focus 7.
      (* call internal *)
      generalize H2; intro.
      unfold strengthen, strengthen_op_ax in H2; openhyp.
      destruct (H5 (eval (fst v) f)); clear H5.

      eapply RunsToCallInternal; eauto.
      destruct env_ax; destruct env_op; simpl in *.
      congruence.
      eapply IHRunsTo; eauto.

      destruct env_ax; destruct env_op; simpl in *.
      inv_clear H3; simpl in *.
      rewrite H6 in H.
      rewrite H9 in H; injection H; intros; subst.
      eapply H12.
      eauto.
      rewrite H6 in H.
      rewrite H9 in H; discriminate.

      openhyp.
      destruct env_ax; destruct env_op; simpl in *.
      rewrite H in H5; injection H5; intros; subst.
      eapply IHRunsTo in H4.
      eapply H9 in H4; clear H9.
      simpl in *.
      eapply TransitTo_RunsTo; eauto.
      simpl in *.
      rewrite <- H0.
      eauto.
      simpl.
      eauto.

      simpl in *.
      rewrite H0.
      eapply Safe_TransitSafe.
      instantiate (2 := (_, _)).
      simpl.
      eauto.
      eauto.
      eapply H8.
      simpl.
      rewrite H0.
      eapply Safe_TransitSafe.
      instantiate (2 := (_, _)).
      simpl.
      eauto.
      eauto.

      Focus 7.
      (* call foreign *)
      generalize H6; intro.
      unfold strengthen, strengthen_op_ax in H6; openhyp.
      destruct (H9 (eval (fst v) f)); clear H9.
      eapply RunsToCallForeign; eauto.
      destruct env_ax; destruct env_op; simpl in *.
      congruence.

      openhyp.
      destruct env_ax; destruct env_op; simpl in *.
      rewrite H in H9; discriminate.

      (* skip *)
      eauto.

      (* seq *)
      inv_clear H2.
      econstructor; eauto.
      eapply IHRunsTo1; eauto.
      eapply IHRunsTo2; eauto.
      eapply H7; eapply IHRunsTo1; eauto.

      (* if true *)
      inv_clear H2.
      openhyp.
      eapply RunsToIfTrue; eauto.
      eapply IHRunsTo; eauto.
      rewrite H2 in H; discriminate.

      (* if false *)
      inv_clear H2.
      openhyp.
      rewrite H2 in H; discriminate.
      eapply RunsToIfFalse; eauto.
      eapply IHRunsTo; eauto.

      (* while true *)
      inv_clear H3.
      eapply RunsToWhileTrue; eauto.
      eapply IHRunsTo1; eauto.
      eapply IHRunsTo2; eauto.
      eapply H9; eapply IHRunsTo1; eauto.
      rewrite H7 in H; discriminate.

      (* while false *)
      eauto.

      (* label *)
      econstructor.
      destruct H0.
      rewrite <- H0.
      eauto.

      (* assign *)
      eauto.
    Qed.

    Lemma strengthen_safe : forall env_ax s v, Safe env_ax s v -> forall env_op, strengthen env_op env_ax -> Safe env_op s v.
      intros.
      eapply (Safe_coind (fun s v => Safe env_ax s v)); [ .. | eauto ]; generalize H0; clear; intros.

      Focus 4.
      inversion H; unfold_all; subst; simpl in *.
      (* call internal *)
      generalize H0; intro.
      unfold strengthen, strengthen_op_ax in H0; openhyp.
      destruct (H2 (eval (fst v) f)); clear H2.
      left; descend; eauto.
      destruct env_ax; destruct env_op; simpl in *.
      rewrite H3; eauto.

      openhyp.
      destruct env_ax; destruct env_op; simpl in *.
      destruct v; simpl in *.
      rewrite H4 in H3; discriminate.

      (* call foreign *)
      generalize H0; intro.
      unfold strengthen, strengthen_op_ax in H0; openhyp.
      destruct (H2 (eval (fst v) f)); clear H2.
      right; descend; eauto.
      destruct env_ax; destruct env_op; simpl in *.
      rewrite H3; eauto.

      openhyp.
      destruct env_ax; destruct env_op; simpl in *.
      destruct v; simpl in *.
      rewrite H4 in H3; injection H3; intros; subst.
      left; descend; eauto.
      Focus 2.
      eapply H9; simpl; eauto.
      rewrite H11.
      unfold TransitSafe.
      descend; eauto.
      erewrite H6; eauto.
      eapply f_equal with (f := @length _) in H5.
      repeat rewrite map_length in *.
      eauto.

      (* seq *)
      inversion H; unfold_all; subst.
      descend; eauto.
      eapply H5; eauto.
      eapply strengthen_runsto; eauto.

      (* if *)
      inversion H; unfold_all; subst.
      eauto.

      (* while *)
      unfold_all.
      inversion H; unfold_all; subst.
      left; descend; eauto.
      eapply H6; eauto.
      eapply strengthen_runsto; eauto.

      right; eauto.

      (* label *)
      inversion H; unfold_all; subst.
      destruct H0.
      rewrite H0; eauto.

    Qed.

  End TopSection.

End Make.


Require Import erasure.
Require Import SpecImpliesNonSpec.
Require Import stepWF.
Require Import IndependenceCommon.
Require Import nonspeculativeImpliesSpeculative.

Theorem raw_eraseFull : forall H x N tid ds,
                          raw_heap_lookup x H = Some(sfull COMMIT ds COMMIT tid N) ->
                          raw_heap_lookup x (raw_eraseHeap H) = Some(pfull (eraseTerm N)).
Proof.
  induction H; intros.
  {inv H. }
  {simpl in *. destruct a. destruct (beq_nat x i) eqn:eq.
   {inv H0. simpl. rewrite eq. auto. }
   {apply IHlist in H0. destruct i0. destruct s; eauto. simpl. rewrite eq. eauto.
    destruct s; eauto. destruct s0; simpl; rewrite eq; eauto. }
  }
Qed.

Theorem eraseFull : forall H x N tid ds,
                      heap_lookup x H = Some(sfull COMMIT ds COMMIT tid N) ->
                      heap_lookup x (eraseHeap H) = Some(pfull (eraseTerm N)).
Proof.
  intros. destruct H. simpl in *. eapply raw_eraseFull; eauto.
Qed.

Ltac existTac e := let n := fresh in
                   try(assert(n:exists e', eraseTerm e' = e) by apply eTerm; inv n);
                   try(assert(n:exists e', eraseCtxt e' = e) by apply eCtxt; inv n).

Theorem specErrorParError : forall H T t,
                       step H T t Error ->
                       pstep (eraseHeap H) (erasePool T) (erasePool t) pError.
Proof.
  intros. inv H0. eapply eraseFull in H2. simpl. eapply PPutError.
  erewrite <- decomposeErase in H1; eauto. simpl. auto. eauto.
Qed.

Theorem ParErrorSpecError : forall H T t H' T' t',
                              pstep H T t pError -> specHeap H H' -> speculate T T' ->
                              speculate t t' -> multistep H' (tUnion T' t') None.
Proof.
  intros. inv H0. inv H3. inv H7. copy H4. apply decomposeSpec in H4.
  unfoldTac. eapply specHeapLookupFull in H5; eauto. invertHyp.
  rewrite Union_associative. eapply Spec.smulti_error. eapply ErrorWrite.
  simpl in *. eauto. eauto.
Qed.

Theorem pmulti_trans : forall H T H' T' c,
                         pmultistep H T (Some(H', T')) ->
                         pmultistep H' T' c ->
                         pmultistep H T c.
Proof.
  intros. dependent induction H0; eauto.
  {econstructor. eauto. eauto. }
Qed.

Theorem specErrorParErrorStar : forall H T,
                              wellFormed H T ->
                              multistep H T None ->
                              pmultistep (eraseHeap H) (erasePool T) None.
Proof.
  intros. remember (@None (sHeap * pool)). induction H1; intros.
  {inv Heqo. }
  {subst. copy H1. eapply specImpliesNonSpec in H1; eauto. invertHyp.
   rewrite eraseUnionComm. eapply pmulti_trans. eassumption.
   eapply stepWF in H3; eauto. rewrite <- eraseUnionComm. eapply IHmultistep; eauto. }
  {eapply specErrorParError in H1; eauto. rewrite eraseUnionComm.
   eapply pmulti_error. eauto. }
Qed.

Theorem multi_trans : forall H T H' T' c, multistep H T (Some(H', T')) ->
                                          multistep H' T' c ->
                                          multistep H T c.
Proof.
  intros. remember (Some(H',T')). induction H0.
  {inv Heqo. auto. }
  {subst. econstructor. eauto. eauto. }
  {inv Heqo. }
Qed.

Theorem ParErrorSpecErrorStar : forall H T H' T',
                                  pmultistep H T None -> specHeap H H' -> heapWF H -> PoolWF T ->
                                  speculate T T' -> multistep H' T' None.
Proof.
  intros. genDeps{H'; T'}. dependent induction H0; intros.
  {copy H0. eapply nonspecImpliesSpec in H0; eauto. invertHyp.
   eapply pstepWF in H6; eauto. invertHyp. inv H7. econstructor.
   eauto. eapply multi_trans. eassumption. eapply IHpmultistep; eauto. }
  {apply specUnionComm in H4. invertHyp. eapply ParErrorSpecError in H0; eauto. }
Qed.