Library mcertikos.security.SecurityBigstep

Require Import Coqlib.
Require Import Equivalence.
Require Import Decidable.
Require Import Observation.
Require Import Behavior.
Require Import Events.


Section BIGSTEP.

  Context `{Obs': Observation}.

  Context {ret state : Type}.
  Variable sem : semantics ret state.

  Variable observe : principalstateobs.

  Class SecBigstepOps {ostate : Type} :=
    {
      principal_ok : principalProp;
      xobserve : principalstateostate;
      active : principalstateProp;
      state_inv : principalstateProp;
      init : principalstateProp
    }.

  Notation obs_eq p s1 s2 := (xobserve p s1 = xobserve p s2).

  Class SecBigstep `{Hsec: SecBigstepOps} :=
    {
      
      observe_obs_eq :
         p, principal_ok p
           s1 s2, obs_eq p s1 s2observe p s1 = observe p s2;

      final_nostep :
         s r, final_state sem s rNostep sem s;

      active_obs_eq :
         p, principal_ok p
           s1 s2, obs_eq p s1 s2 → (active p s1 active p s2);
      active_dec : p s, decidable (active p s);

      
      active_forever :
         p, principal_ok p
           s,
            init p sstate_inv p s
             s' t, Plus sem s t s' active p s';

      initial_state_inv :
         p, principal_ok p
           s, initial_state sem sstate_inv p s;
      state_inv_preserved :
         p, principal_ok p
           s s' t, Step sem s t s'state_inv p sstate_inv p s';

      init_preserved :
         p, principal_ok p
           s s' t, Step sem s t s'state_inv p sinit p sinit p s';

      conf :
         p,
          principal_ok p
           s1 s1' s2 s2' t1 t2,
            init p s1state_inv p s1
            init p s2state_inv p s2
            active p s1Step sem s1 t1 s1'Step sem s2 t2 s2'
            obs_eq p s1 s2obs_eq p s1' s2';

      integ :
         p,
          principal_ok p
           s s' t,
            init p sstate_inv p s
            ¬ active p s¬ active p s'
            Step sem s t s'obs_eq p s s';

       conf_restore :
          p,
           principal_ok p
            s1 s1' s2 s2' t1 t2,
             init p s1state_inv p s1
             init p s2state_inv p s2
             ¬ active p s1active p s1'active p s2'
             Step sem s1 t1 s1'Step sem s2 t2 s2'
             obs_eq p s1 s2obs_eq p s1' s2';

       
       integ_observe :
          p,
           principal_ok p
            s s' t,
             init p sstate_inv p s
             active p s¬ active p s'
             Step sem s t s'observe p s = observe p s'
    }.

  Context `{Hsec: SecBigstepOps}.
  Variable p : principal.

  Inductive sec_step : Globalenvs.Genv.t (funtype sem) (vartype sem) →
                       statetracestateProp :=
  | sec_step_active :
       s s' t,
        init p sstate_inv p sactive p s'
        Step sem s t s'sec_step (globalenv sem) s t s'
  | sec_step_inactive :
       s s' s'' t t',
        init p sstate_inv p s¬ active p s'active p s''
        Step sem s t s'sec_step (globalenv sem) s' t' s''
        sec_step (globalenv sem) s (t ** t') s''.

  Definition sec_sem : semantics _ state :=
    {|
      funtype:= funtype sem;
      vartype:= vartype sem;
      step:= sec_step;
      initial_state:= initial_state sem;
      final_state:= final_state sem;
      globalenv:= globalenv sem
    |}.

End BIGSTEP.

Section SECURE.

  Context {state : Type} `{Hsec': SecBigstep(state:=state)}.
  Variable p : principal.
  Hypothesis p_ok : principal_ok p.

  Notation obs_eq s1 s2 := (xobserve p s1 = xobserve p s2).
  Notation Sec_step := (sec_step sem p (globalenv sem)).
  Notation ssem := (sec_sem sem p).


  Lemma sec_step_final_active :
     s s' t, Sec_step s t s'active p s'.
  Proof.
    intros s s' t Hstep; inv Hstep; auto.
  Qed.

  Lemma state_inv_preserved_star :
     s s' t, Star sem s t s'state_inv p sstate_inv p s'.
  Proof.
    induction 1; auto.
    intros; apply IHstar.
    eapply state_inv_preserved; eauto.
  Qed.

  Lemma init_preserved_star :
     s s' t, Star sem s t s'state_inv p sinit p sinit p s'.
  Proof.
    induction 1; auto.
    intros; apply IHstar.
    eapply state_inv_preserved; eauto.
    eapply init_preserved; eauto.
  Qed.

  Lemma sec_state_inv_preserved :
     s s' t, Sec_step s t s'state_inv p sstate_inv p s'.
  Proof.
    intros s s' t Hstep; induction Hstep; destruct Hsec'; eauto.
  Qed.

  Lemma sec_init_preserved :
     s s' t, Sec_step s t s'state_inv p sinit p sinit p s'.
  Proof.
    intros s s' t Hstep; induction Hstep; destruct Hsec'; eauto.
  Qed.

  Lemma sec_state_inv_preserved_star :
     s s' t, Star ssem s t s'state_inv p sstate_inv p s'.
  Proof.
    intros s s' t Hstar; induction Hstar; auto.
    intros; apply IHHstar; eapply sec_state_inv_preserved; eauto.
  Qed.

  Lemma sec_init_preserved_star :
     s s' t, Star ssem s t s'state_inv p sinit p sinit p s'.
  Proof.
    intros s s' t Hstar; induction Hstar; auto.
    intros Hinv Hinit.
    apply IHHstar.
    eapply sec_state_inv_preserved; eauto.
    eapply sec_init_preserved; eauto.
  Qed.

  Lemma sec_step_conf_restore :
     s1 s1' s2 s2' t1 t2,
      init p s1state_inv p s1
      init p s2state_inv p s2
      ¬ active p s1Sec_step s1 t1 s1'Sec_step s2 t2 s2'
      obs_eq s1 s2obs_eq s1' s2'.
  Proof.
    destruct Hsec'.
    intros s1 s1' s2 s2' t1 t2 Hinit1 Hinv1 Hinit2 Hinv2 Hact Hstep1.
    generalize s2 s2' t2 Hinit2 Hinv2; clear s2 s2' t2 Hinit2 Hinv2.
    induction Hstep1; intros s2 s2' t2 Hinit2 Hinv2 Hstep2 Hobs_eq.
    - induction Hstep2.
      eauto.
      apply IHHstep2; eauto.
      transitivity (xobserve p s0); auto.
      eapply integ; eauto.
      apply active_obs_eq0 in Hobs_eq; intuition.
    - eapply IHHstep1; eauto.
      transitivity (xobserve p s); auto.
      symmetry; eauto.
  Qed.

  Lemma sec_step_conf :
     s1 s1' s2 s2' t1 t2,
      init p s1state_inv p s1
      init p s2state_inv p s2
      active p s1Sec_step s1 t1 s1'Sec_step s2 t2 s2'
      obs_eq s1 s2obs_eq s1' s2'.
  Proof.
    destruct Hsec'.
    intros s1 s1' s2 s2' t1 t2 Hinit1 Hinv1 Hinit2 Hinv2 Hact Hstep1 Hstep2 Hobs_eq.
    inv Hstep1; inv Hstep2.
    - eauto.
    - assert (Hcon: obs_eq s1' s') by eauto.
      apply active_obs_eq0 in Hcon; intuition.
    - assert (Hcon: obs_eq s' s2') by eauto.
      apply active_obs_eq0 in Hcon; intuition.
    - refine (sec_step_conf_restore _ _ _ _ _ _ _ _ _ _ _ H4 H10 _); eauto.
  Qed.

  Definition secure (s1 : state) : Prop :=
     s2,
      init p s2state_inv p s2obs_eq s1 s2
       n s1' s2' t1 t2,
        StarN ssem n s1 t1 s1'StarN ssem n s2 t2 s2'obs_eq s1' s2'.

  Lemma security_after_init_stepn :
     n s1 s1' s2 s2' t1 t2,
      init p s1state_inv p s1
      init p s2state_inv p s2
      StarN ssem n s1 t1 s1'StarN ssem n s2 t2 s2'
      obs_eq s1 s2obs_eq s1' s2'.
  Proof.
    induction n; intros s1 s1' s2 s2' t1 t2 Hinit1 Hinv1 Hinit2 Hinv2 Hstep1 Hstep2 Hobs_eq.
    inv Hstep1; inv Hstep2; assumption.
    inv Hstep1; inv Hstep2.
    refine (IHn _ _ _ _ _ _ _ _ _ _ H1 H3 _); eauto.
    eapply sec_init_preserved; eauto.
    eapply sec_state_inv_preserved; eauto.
    eapply sec_init_preserved; eauto.
    eapply sec_state_inv_preserved; eauto.
    destruct (active_dec _ _ p s1).
    eapply sec_step_conf; [| | | | | eauto..]; auto.
    eapply sec_step_conf_restore; [| | | | | eauto..]; auto.
  Qed.

  Theorem security_after_init :
     s,
      init p sstate_inv p ssecure s.
  Proof.
    unfold secure; intros; eapply security_after_init_stepn; [| | eauto..]; auto.
  Qed.

  Lemma sec_final_nostep :
     s r,
      final_state ssem s rNostep ssem s.
  Proof.
    simpl; intros s r Hfin.
    intros t s' Hstep; inv Hstep.
    contradiction (final_nostep sem _ _ _ Hfin _ _ H2).
    contradiction (final_nostep sem _ _ _ Hfin _ _ H3).
  Qed.

  Lemma sec_step_inv :
     s t s',
      Plus sem s t s'
      init p sstate_inv p sactive p s'
       s'' t', Step ssem s t' s''.
  Proof.
    apply (Smallstep.plus_ind2
             (fun s1 t s2init p s1state_inv p s1active p s2
                              s'' t', Step ssem s1 t' s'')).
    intros s1 t s2 Hstep Hinit Hinv Hact; s2, t.
    simpl; econstructor; eauto.
    intros s1 t1 s2 t2 s3 t Hstep Hplus IH Ht Hinit Hinv Hact; subst.
    destruct (IH (init_preserved _ _ _ p_ok _ _ _ Hstep Hinv Hinit)
                 (state_inv_preserved _ _ _ p_ok _ _ _ Hstep Hinv) Hact) as [s2' [t' Hstep']].
    destruct (active_dec _ _ p s2).
     s2, t1; simpl; econstructor; eauto.
    inv Hstep'.
     s2', (t1 ** t').
    simpl; eapply sec_step_inactive; eauto.
    econstructor; eauto.
     s2', (t1 ** t ** t'0).
    simpl; eapply sec_step_inactive; [| | | |eauto|..]; auto.
    eapply sec_step_inactive; eauto.
  Qed.

  Lemma sec_safe :
     s,
      init p sstate_inv p s
       s' t, Step ssem s t s'.
  Proof.
    intros s ? ?; destruct (active_forever _ _ _ p_ok s) as [s' [t [Hplus Hact]]]; auto.
    intros; eapply sec_step_inv; eauto.
  Qed.

  Lemma sec_not_final :
     s r,
      init p sstate_inv p s
      ¬ final_state ssem s r.
  Proof.
    intros s r Hinit Hinv Hfin.
    destruct (sec_safe _ Hinit Hinv) as [s' [t Hstep]].
    eapply sec_final_nostep; eauto.
  Qed.

End SECURE.

Section BEHAVIORAL.


  Local Open Scope nat_scope.

  Context {state : Type} `{Hsec': SecBigstep(state:=state)}.
  Context `{Obs': @Observation Obs}.
  Variable p : principal.
  Hypothesis p_ok : principal_ok p.
  Context `{Hbeh: !Behavioral sem (observe p)}.

  Notation Sec_step := (sec_step sem p (globalenv sem)).

  Lemma sec_step_obs_leq :
     t s s',
      Sec_step s t s'
      obs_leq (observe p s) (observe p s').
  Proof.
    induction 1.
    eapply obs_monotonic; eauto.
    eapply obs_leq_trans; eauto.
    eapply obs_monotonic; eauto.
  Qed.

  Lemma sec_step_obs_measure :
     t s s',
      Sec_step s t s'
      obs_measure (observe p s') S (obs_measure (observe p s)).
  Proof.
    induction 1.
    eapply obs_monotonic_measure; eauto.
    destruct (active_dec _ _ p s).
    - erewrite (integ_observe _ _ _ p_ok s s'); eauto.
    - erewrite (observe_obs_eq _ _ _ p_ok s s'); eauto.
      eapply integ; eauto.
  Qed.

  Instance secure_behavioral : Behavioral (sec_sem sem p) (observe p).
  Proof.
    constructor.
    - apply sec_step_obs_leq.
    - apply sec_step_obs_measure.
  Qed.

End BEHAVIORAL.

Section SIM.


  Context {state : Type} `{Hsec': SecBigstep(state:=state)}.

  Variable p : principal.
  Hypothesis p_ok : principal_ok p.

  Notation ssem := (sec_sem sem p).
  Notation observep := (observe p).

  Definition secure_sim : simulation ssem sem observep observep.
  Proof.
    apply Simulation with (sim_index:= unit) (sim_order:= fun _ _False)
                          (sim_match_states:= fun _ s1 s2s1 = s2).
    - constructor; intuition.
    - intros; subst; auto.
    - intros; subst; auto.
    - intros s1 t s1' Hstep ? s2 ?; subst; induction Hstep.
      + tt, s'; split; auto.
        left; econstructor; eauto.
        constructor.
        rewrite E0_right; auto.
      + destruct IHHstep as [? [s''' [[Hplus | [? Hcon]] ?]]]; try inv Hcon; subst.
         tt, s'''; split; auto.
        left; econstructor; eauto.
        eapply Smallstep.plus_star; eauto.
  Defined.

End SIM.

Section BISIM.


  Context {state : Type} `{Hsec': SecBigstep(state:=state)}.
  Context `{Obs': @Observation Obs}.
  Variable p : principal.
  Hypothesis p_ok : principal_ok p.
  Context `{Hbeh: !Behavioral sem (observe p)}.

  Notation obs_eq s1 s2 := (xobserve p s1 = xobserve p s2).
  Notation ssem := (sec_sem sem p).
  Notation observep := (observe p).

  Definition obs_eq_bisim : bisimulation ssem ssem observep observep.
  Proof.
    apply Bisimulation with (bisim_index:= unit)
                            (bisim_order:= fun _ _False)
                            (bisim_match_states:= fun _ s1 s2init p s1 state_inv p s1
                                                                 init p s2 state_inv p s2
                                                                 obs_eq s1 s2).
    - constructor; intuition.
    - intros; eapply observe_obs_eq; eauto; intuition.
    - intros; split; intro Hcon; apply sec_not_final in Hcon; intuition.
    - intros s1 t s1' Hstep1 ? s2 [Hinit1 [Hinv1 [Hinit2 [Hinv2 Hobs_eq]]]].
      destruct (sec_safe p p_ok s2) as [s2' [t' Hstep2]]; auto.
       tt, t', s2'; split.
      left; eapply Smallstep.plus_one; eauto.
      repeat split.
      eapply sec_init_preserved; [| eapply Hstep1 | eauto..]; auto.
      eapply sec_state_inv_preserved; [| eapply Hstep1 | eauto..]; auto.
      eapply sec_init_preserved; [| eapply Hstep2 | eauto..]; auto.
      eapply sec_state_inv_preserved; [| eapply Hstep2 | eauto..]; auto.
      destruct (active_dec _ _ p s1).
      eapply sec_step_conf; [| | | | | | eapply Hstep1 | eapply Hstep2 |..]; eauto.
      eapply sec_step_conf_restore; [| | | | | | eapply Hstep1 | eapply Hstep2 |..]; eauto.
    - intros s2 t s2' Hstep2 ? s1 [Hinit1 [Hinv1 [Hinit2 [Hinv2 Hobs_eq]]]].
      destruct (sec_safe p p_ok s1) as [s1' [t' Hstep1]]; auto.
       tt, t', s1'; split.
      left; eapply Smallstep.plus_one; eauto.
      repeat split.
      eapply sec_init_preserved; [| eapply Hstep1 | eauto..]; auto.
      eapply sec_state_inv_preserved; [| eapply Hstep1 | eauto..]; auto.
      eapply sec_init_preserved; [| eapply Hstep2 | eauto..]; auto.
      eapply sec_state_inv_preserved; [| eapply Hstep2 | eauto..]; auto.
      destruct (active_dec _ _ p s2); symmetry.
      eapply sec_step_conf; [| | | | | | eapply Hstep2 | eapply Hstep1 |..]; eauto.
      eapply sec_step_conf_restore; [| | | | | | eapply Hstep2 | eapply Hstep1 |..]; eauto.
  Defined.


  Theorem obs_eq_beh_eq :
     s1 s2,
      init p s1state_inv p s1
      init p s2state_inv p s2obs_eq s1 s2
      state_beh_eq ssem ssem observep observep s1 s2.
  Proof.
    intros s1 s2 Hinit1 Hinv1 Hinit2 Hinv2 Hobs_eq.
    eapply bisim_beh_eq with (i:= tt) (bisim:= obs_eq_bisim); eauto; simpl; intuition.
    apply secure_behavioral; auto.
    apply secure_behavioral; auto.
  Qed.

End BISIM.