(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

Require Import Omega Relations Multiset SetoidList.

(** This file is deprecated, use [Permutation.v] instead.

    Indeed, this file defines a notion of permutation based on
    multisets (there exists a permutation between two lists iff every
    elements have the same multiplicity in the two lists) which
    requires a more complex apparatus (the equipment of the domain
    with a decidable equality) than [Permutation] in [Permutation.v].

    The relation between the two relations are in lemma
    [permutation_Permutation].

    File [PermutEq] concerns Leibniz equality : it shows in particular
    that [List.Permutation] and [permutation] are equivalent in this context.
*)

Set Implicit Arguments.

Local Notation "[ ]" := nil.
Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..).

Section Permut.

(** * From lists to multisets *)

Variable A : Type.
Variable eqA : relation A.
Hypothesis eqA_equiv : Equivalence eqA.
Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.

Let emptyBag := EmptyBag A.
Let singletonBag := SingletonBag _ eqA_dec.

(** contents of a list *)

Fixpoint list_contents (l:list A) : multiset A :=
  match l with
  | [] => emptyBag
  | a :: l => munion (singletonBag a) (list_contents l)
  end.

Lemma list_contents_app :
  forall l m:list A,
    meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
Proof.
  simple induction l; simpl in |- *; auto with datatypes.
  intros.
  apply meq_trans with
    (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
    auto with datatypes.
Qed.

(** * [permutation]: definition and basic properties *)

Definition permutation (l m:list A) := meq (list_contents l) (list_contents m).

Lemma permut_refl : forall l:list A, permutation l l.
Proof.
  unfold permutation in |- *; auto with datatypes.
Qed.

Lemma permut_sym :
  forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1.
Proof.
  unfold permutation, meq; intros; apply sym_eq; trivial.
Qed.

Lemma permut_trans :
  forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
Proof.
  unfold permutation in |- *; intros.
  apply meq_trans with (list_contents m); auto with datatypes.
Qed.

Lemma permut_cons_eq :
  forall l m:list A,
    permutation l m -> forall a a', eqA a a' -> permutation (a :: l) (a' :: m).
Proof.
  unfold permutation; simpl; intros.
  apply meq_trans with (munion (singletonBag a') (list_contents l)).
  apply meq_left, meq_singleton; auto.
  auto with datatypes.
Qed.

Lemma permut_cons :
  forall l m:list A,
    permutation l m -> forall a:A, permutation (a :: l) (a :: m).
Proof.
  unfold permutation; simpl; auto with datatypes.
Qed.

Lemma permut_app :
  forall l l' m m':list A,
    permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
Proof.
  unfold permutation in |- *; intros.
  apply meq_trans with (munion (list_contents l) (list_contents m));
    auto using permut_cons, list_contents_app with datatypes.
  apply meq_trans with (munion (list_contents l') (list_contents m'));
    auto using permut_cons, list_contents_app with datatypes.
  apply meq_trans with (munion (list_contents l') (list_contents m));
    auto using permut_cons, list_contents_app with datatypes.
Qed.

Lemma permut_add_inside_eq :
  forall a a' l1 l2 l3 l4, eqA a a' ->
    permutation (l1 ++ l2) (l3 ++ l4) ->
    permutation (l1 ++ a :: l2) (l3 ++ a' :: l4).
Proof.
  unfold permutation, meq in *; intros.
  specialize H0 with a0.
  repeat rewrite list_contents_app in *; simpl in *.
  destruct (eqA_dec a a0) as [Ha|Ha]; rewrite H in Ha;
    decide (eqA_dec a' a0) with Ha; simpl; auto with arith.
  do 2 rewrite <- plus_n_Sm; f_equal; auto.
Qed.

Lemma permut_add_inside :
  forall a l1 l2 l3 l4,
    permutation (l1 ++ l2) (l3 ++ l4) ->
    permutation (l1 ++ a :: l2) (l3 ++ a :: l4).
Proof.
  unfold permutation, meq in *; intros.
  generalize (H a0); clear H.
  do 4 rewrite list_contents_app.
  simpl.
  destruct (eqA_dec a a0); simpl; auto with arith.
  do 2 rewrite <- plus_n_Sm; f_equal; auto.
Qed.

Lemma permut_add_cons_inside_eq :
  forall a a' l l1 l2, eqA a a' ->
    permutation l (l1 ++ l2) ->
    permutation (a :: l) (l1 ++ a' :: l2).
Proof.
  intros;
  replace (a :: l) with ([] ++ a :: l); trivial;
    apply permut_add_inside_eq; trivial.
Qed.

Lemma permut_add_cons_inside :
  forall a l l1 l2,
    permutation l (l1 ++ l2) ->
    permutation (a :: l) (l1 ++ a :: l2).
Proof.
  intros;
    replace (a :: l) with ([] ++ a :: l); trivial;
	apply permut_add_inside; trivial.
Qed.

Lemma permut_middle :
  forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m).
Proof.
  intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl.
Qed.

Lemma permut_sym_app :
  forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1).
Proof.
  intros l1 l2;
    unfold permutation, meq;
	intro a; do 2 rewrite list_contents_app; simpl;
	  auto with arith.
Qed.

Lemma permut_rev :
  forall l, permutation l (rev l).
Proof.
  induction l.
  simpl; trivial using permut_refl.
  simpl.
  apply permut_add_cons_inside.
  rewrite <- app_nil_end. trivial.
Qed.

(** * Some inversion results. *)
Lemma permut_conv_inv :
  forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2.
Proof.
  intros e l1 l2; unfold permutation, meq; simpl; intros H a;
    generalize (H a); apply plus_reg_l.
Qed.

Lemma permut_app_inv1 :
  forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2.
Proof.
  intros l l1 l2; unfold permutation, meq; simpl;
    intros H a; generalize (H a); clear H.
  do 2 rewrite list_contents_app.
  simpl.
  intros; apply plus_reg_l with (multiplicity (list_contents l) a).
  rewrite plus_comm; rewrite H; rewrite plus_comm.
  trivial.
Qed.

(** we can use [multiplicity] to define [InA] and [NoDupA]. *)

Fact if_eqA_then : forall a a' (B:Type)(b b':B),
 eqA a a' -> (if eqA_dec a a' then b else b') = b.
Proof.
  intros. destruct eqA_dec as [_|NEQ]; auto.
  contradict NEQ; auto.
Qed.

Lemma permut_app_inv2 :
  forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2.
Proof.
  intros l l1 l2; unfold permutation, meq; simpl;
    intros H a; generalize (H a); clear H.
  do 2 rewrite list_contents_app.
  simpl.
  intros; apply plus_reg_l with (multiplicity (list_contents l) a).
  trivial.
Qed.

Lemma permut_remove_hd_eq :
  forall l l1 l2 a b, eqA a b ->
    permutation (a :: l) (l1 ++ b :: l2) -> permutation l (l1 ++ l2).
Proof.
  unfold permutation, meq; simpl; intros l l1 l2 a b Heq H a0.
  specialize H with a0.
  rewrite list_contents_app in *; simpl in *.
  apply plus_reg_l with (if eqA_dec a a0 then 1 else 0).
  rewrite H; clear H.
  symmetry; rewrite plus_comm, <- ! plus_assoc; f_equal.
  rewrite plus_comm.
  destruct (eqA_dec a a0) as [Ha|Ha]; rewrite Heq in Ha;
    decide (eqA_dec b a0) with Ha; reflexivity.
Qed.

Lemma permut_remove_hd :
  forall l l1 l2 a,
    permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2).
Proof.
  eauto using permut_remove_hd_eq, Equivalence_Reflexive.
Qed.

Fact if_eqA_else : forall a a' (B:Type)(b b':B),
 ~eqA a a' -> (if eqA_dec a a' then b else b') = b'.
Proof.
  intros. decide (eqA_dec a a') with H; auto.
Qed.

Fact if_eqA_refl : forall a (B:Type)(b b':B),
 (if eqA_dec a a then b else b') = b.
Proof.
  intros; apply (decide_left (eqA_dec a a)); auto with *.
Qed.

(** PL: Inutilisable dans un rewrite sans un change prealable. *)

Global Instance if_eqA (B:Type)(b b':B) :
 Proper (eqA==>eqA==>@eq _) (fun x y => if eqA_dec x y then b else b').
Proof.
 intros x x' Hxx' y y' Hyy'.
 intros; destruct (eqA_dec x y) as [H|H];
  destruct (eqA_dec x' y') as [H'|H']; auto.
 contradict H'; transitivity x; auto with *; transitivity y; auto with *.
 contradict H; transitivity x'; auto with *; transitivity y'; auto with *.
Qed.

Fact if_eqA_rewrite_l : forall a1 a1' a2 (B:Type)(b b':B),
 eqA a1 a1' -> (if eqA_dec a1 a2 then b else b') =
               (if eqA_dec a1' a2 then b else b').
Proof.
 intros; destruct (eqA_dec a1 a2) as [A1|A1];
  destruct (eqA_dec a1' a2) as [A1'|A1']; auto.
 contradict A1'; transitivity a1; eauto with *.
 contradict A1; transitivity a1'; eauto with *.
Qed.

Fact if_eqA_rewrite_r : forall a1 a2 a2' (B:Type)(b b':B),
 eqA a2 a2' -> (if eqA_dec a1 a2 then b else b') =
               (if eqA_dec a1 a2' then b else b').
Proof.
 intros; destruct (eqA_dec a1 a2) as [A2|A2];
  destruct (eqA_dec a1 a2') as [A2'|A2']; auto.
 contradict A2'; transitivity a2; eauto with *.
 contradict A2; transitivity a2'; eauto with *.
Qed.

Global Instance multiplicity_eqA (l:list A) :
 Proper (eqA==>@eq _) (multiplicity (list_contents l)).
Proof.
  intros x x' Hxx'.
  induction l as [|y l Hl]; simpl; auto.
  rewrite (@if_eqA_rewrite_r y x x'); auto.
Qed.

Lemma multiplicity_InA :
  forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a.
Proof.
  induction l.
  simpl.
  split; inversion 1.
  simpl.
  intros a'; split; intros H. inversion_clear H.
  apply (decide_left (eqA_dec a a')); auto with *.
  destruct (eqA_dec a a'); auto with *. simpl; rewrite <- IHl; auto.
  destruct (eqA_dec a a'); auto with *. right. rewrite IHl; auto.
Qed.

Lemma multiplicity_InA_O :
  forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0.
Proof.
  intros l a; rewrite multiplicity_InA;
    destruct (multiplicity (list_contents l) a); auto with arith.
  destruct 1; auto with arith.
Qed.

Lemma multiplicity_InA_S :
  forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1.
Proof.
  intros l a; rewrite multiplicity_InA; auto with arith.
Qed.

Lemma multiplicity_NoDupA : forall l,
  NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1).
Proof.
  induction l.
  simpl.
  split; auto with arith.
  split; simpl.
  inversion_clear 1.
  rewrite IHl in H1.
  intros; destruct (eqA_dec a a0) as [EQ|NEQ]; simpl; auto with *.
  rewrite <- EQ.
  rewrite multiplicity_InA_O; auto.
  intros; constructor.
  rewrite multiplicity_InA.
  specialize (H a).
  rewrite if_eqA_refl in H.
  clear IHl; omega.
  rewrite IHl; intros.
  specialize (H a0); auto with *.
  destruct (eqA_dec a a0); simpl; auto with *.
Qed.

(** Permutation is compatible with InA. *)
Lemma permut_InA_InA :
  forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2.
Proof.
  intros l1 l2 e.
  do 2 rewrite multiplicity_InA.
  unfold permutation, meq.
  intros H;rewrite H; auto.
Qed.

Lemma permut_cons_InA :
  forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2.
Proof.
  intros; apply (permut_InA_InA (e:=e) H); auto with *.
Qed.

(** Permutation of an empty list. *)
Lemma permut_nil :
  forall l, permutation l [] -> l = [].
Proof.
  intro l; destruct l as [ | e l ]; trivial.
  assert (InA eqA e (e::l)) by (auto with *).
  intro Abs; generalize (permut_InA_InA Abs H).
  inversion 1.
Qed.

(** Permutation for short lists. *)

Lemma permut_length_1:
  forall a b, permutation [a] [b] -> eqA a b.
Proof.
  intros a b; unfold permutation, meq.
  intro P; specialize (P b); simpl in *.
  rewrite if_eqA_refl in *.
  destruct (eqA_dec a b); simpl; auto; discriminate.
Qed.

Lemma permut_length_2 :
  forall a1 b1 a2 b2, permutation [a1; b1] [a2; b2] ->
    (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1).
Proof.
  intros a1 b1 a2 b2 P.
  assert (H:=permut_cons_InA P).
  inversion_clear H.
  left; split; auto.
  apply permut_length_1.
  red; red; intros.
  specialize (P a). simpl in *.
  rewrite (@if_eqA_rewrite_l a1 a2 a) in P by auto.
  (** Bug omega: le "set" suivant ne devrait pas etre necessaire *)
  set (u:= if eqA_dec a2 a then 1 else 0) in *; omega.
  right.
  inversion_clear H0; [|inversion H].
  split; auto.
  apply permut_length_1.
  red; red; intros.
  specialize (P a); simpl in *.
  rewrite (@if_eqA_rewrite_l a1 b2 a) in P by auto.
  (** Bug omega: idem *)
  set (u:= if eqA_dec b2 a then 1 else 0) in *; omega.
Qed.

(** Permutation is compatible with length. *)
Lemma permut_length :
  forall l1 l2, permutation l1 l2 -> length l1 = length l2.
Proof.
  induction l1; intros l2 H.
  rewrite (permut_nil (permut_sym H)); auto.
  assert (H0:=permut_cons_InA H).
  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
  subst l2.
  rewrite app_length.
  simpl; rewrite <- plus_n_Sm; f_equal.
  rewrite <- app_length.
  apply IHl1.
  apply permut_remove_hd with b.
  apply permut_trans with (a::l1); auto.
  revert H1; unfold permutation, meq; simpl.
  intros; f_equal; auto.
  rewrite (@if_eqA_rewrite_l a b a0); auto.
Qed.

Lemma NoDupA_equivlistA_permut :
  forall l l', NoDupA eqA l -> NoDupA eqA l' ->
    equivlistA eqA l l' -> permutation l l'.
Proof.
  intros.
  red; unfold meq; intros.
  rewrite multiplicity_NoDupA in H, H0.
  generalize (H a) (H0 a) (H1 a); clear H H0 H1.
  do 2 rewrite multiplicity_InA.
  destruct 3; omega.
Qed.

End Permut.

Section Permut_map.

Variables A B : Type.

Variable eqA : relation A.
Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
Hypothesis eqA_equiv : Equivalence eqA.

Variable eqB : B->B->Prop.
Hypothesis eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }.
Hypothesis eqB_trans : Transitive eqB.

(** Permutation is compatible with map. *)

Lemma permut_map :
  forall f,
    (Proper (eqA==>eqB) f) ->
    forall l1 l2, permutation _ eqA_dec l1 l2 ->
      permutation _ eqB_dec (map f l1) (map f l2).
Proof.
  intros f; induction l1.
  intros l2 P; rewrite (permut_nil eqA_equiv (permut_sym P)); apply permut_refl.
  intros l2 P.
  simpl.
  assert (H0:=permut_cons_InA eqA_equiv P).
  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
  subst l2.
  rewrite map_app.
  simpl.
  apply permut_trans with (f b :: map f l1).
  revert H1; unfold permutation, meq; simpl.
  intros; f_equal; auto.
  destruct (eqB_dec (f b) a0) as [H2|H2];
    destruct (eqB_dec (f a) a0) as [H3|H3]; auto.
  destruct H3; transitivity (f b); auto with *.
  destruct H2; transitivity (f a); auto with *.
  apply permut_add_cons_inside.
  rewrite <- map_app.
  apply IHl1; auto.
  apply permut_remove_hd with b; trivial.
  apply permut_trans with (a::l1); auto.
  revert H1; unfold permutation, meq; simpl.
  intros; f_equal; auto.
  rewrite (@if_eqA_rewrite_l _ _ eqA_equiv eqA_dec a b a0); auto.
Qed.

End Permut_map.

Require Import Permutation.

Section Permut_permut.

Variable A : Type.

Variable eqA : relation A.
Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
Hypothesis eqA_equiv : Equivalence eqA.

Lemma Permutation_impl_permutation : forall l l',
  Permutation l l' -> permutation _ eqA_dec l l'.
Proof.
  induction 1.
    apply permut_refl.
    apply permut_cons; auto using Equivalence_Reflexive.
    change (x :: y :: l) with ([x] ++ y :: l);
      apply permut_add_cons_inside; simpl;
      apply permut_cons_eq; auto using Equivalence_Reflexive, permut_refl.
    apply permut_trans with l'; trivial.
Qed.

Lemma permut_eqA : forall l l', Forall2 eqA l l' -> permutation _ eqA_dec l l'.
Proof.
  induction 1.
    apply permut_refl.
    apply permut_cons_eq; trivial.
Qed.

Lemma permutation_Permutation : forall l l',
  permutation _ eqA_dec l l' <->
  exists l'', Permutation l l'' /\ Forall2 eqA l'' l'.
Proof.
  split; intro H.
  (* -> *)
  induction l in l', H |- *.
    exists []; apply permut_sym, permut_nil in H as ->; auto using Forall2.
    pose proof H as H'.
    apply permut_cons_InA, InA_split in H
      as (l1 & y & l2 & Heq & ->); trivial.
    apply permut_remove_hd_eq, IHl in H'
      as (l'' & IHP & IHA); clear IHl; trivial.
    apply Forall2_app_inv_r in IHA as (l1'' & l2'' & Hl1 & Hl2 & ->).
    exists (l1'' ++ a :: l2''); split.
      apply Permutation_cons_app; trivial.
      apply Forall2_app, Forall2_cons; trivial.
  (* <- *)
  destruct H as (l'' & H & Heq).
  apply permut_trans with l''.
    apply Permutation_impl_permutation; trivial.
    apply permut_eqA; trivial.
Qed.

End Permut_permut.

(* begin hide *)
(** For compatibilty *)
Notation permut_right := permut_cons (only parsing).
Notation permut_tran := permut_trans (only parsing).
(* end hide *)


(* Andrew W. Appel and Stephen Yi-Hsien Lin,
    May 2013, October 2013, March 2014 *)

Require Recdef.
Require Import Integers.
(* Add LoadPath "~/Desktop/Code/research/vst/compcert/lib". *)
Require Import Coqlib.
Require Import Coq.Strings.String.
Require Import Coq.Strings.Ascii.
Require Import List.

Require Import pure_lemmas.

(* THIS BLOCK OF STUFF is not needed to define SHA256,
  but is useful for reasoning about it *)
Definition LBLOCKz : Z := 16. (* length of a block, in 32-bit integers *)
Definition WORD : Z := 4.  (* length of a word, in bytes *)
Definition CBLOCKz : Z := (LBLOCKz * WORD)%Z. (* length of a block, in characters *)
Definition hilo hi lo := (Int.unsigned hi * Int.modulus + Int.unsigned lo)%Z.
Definition isbyteZ (i: Z) := (0 <= i < 256)%Z.
Definition big_endian_integer (contents: Z -> int) : int :=
  Int.or (Int.shl (contents 0) (Int.repr 24))
  (Int.or (Int.shl (contents 1) (Int.repr 16))
   (Int.or (Int.shl (contents 2) (Int.repr 8))
      (contents 3))).
(* END OF "THIS BLOCK OF STUFF" *)

Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y []) ..).

Lemma skipn_length:
  forall {A} n (al: list A),
    (length al >= n)%nat ->
    (length (skipn n al) = length al - n)%nat.
Proof.
 induction n; destruct al; simpl; intros; auto.
 apply IHn. omega.
Qed.

Lemma skipn_length_short:
  forall {A} n (al: list A),
    (length al < n)%nat ->
    (length (skipn n al) = 0)%nat.
Proof.
 induction n; destruct al; simpl; intros; auto.
 omega.
 apply IHn. omega.
Qed.

(* PREPROCESSING: CONVERTING STRINGS TO PADDED MESSAGE BLOCKS *)

(*converting a string to a list of Z *)
Fixpoint str_to_Z (str : string) : list Z :=
  match str with
    |EmptyString => nil
    |String c s => Z.of_N (N_of_ascii c) :: str_to_Z s
    end.

(*combining four Z into a Integer*)
Definition Z_to_Int (a b c d : Z) : Int.int :=
  Int.or (Int.or (Int.or (Int.shl (Int.repr a) (Int.repr 24)) (Int.shl (Int.repr b) (Int.repr 16)))
            (Int.shl (Int.repr c) (Int.repr 8))) (Int.repr d).

Fixpoint Zlist_to_intlist (nl: list Z) : list int :=
  match nl with
  | h1::h2::h3::h4::t => Z_to_Int h1 h2 h3 h4 :: Zlist_to_intlist t
  | _ => nil
  end.

Definition generate_and_pad msg :=
  let n := Zlength msg in
   Zlist_to_intlist (msg ++ [128%Z]
                ++ list_repeat (Z.to_nat (-(n + 9) mod 64)) 0)
           ++ [Int.repr (n * 8 / Int.modulus), Int.repr (n * 8)].

(* ------------------------------------ LEMMAS *)

(* Lemma 1: M = Prefix(Pad(M)) *)
(* see end *)

(* ------- *)

(* Lemma 2: |M1| = |M2| -> |Pad(M1)| = |Pad(M2)| *)

(* ------- *)

(* Lemma 3: |M1| =/= |M2| -> last block of Pad(M1) =/= last block of Pad(M2) *)

(* ------------------------------------------- *)

(*ROUND FUNCTION*)

(*hardcoding the constants, first 32 bits of the fractional parts of the cube roots of the first 64 prime numbers*)
Definition K256 := map Int.repr
  [1116352408 , 1899447441, 3049323471, 3921009573,
   961987163   , 1508970993, 2453635748, 2870763221,
   3624381080, 310598401  , 607225278  , 1426881987,
   1925078388, 2162078206, 2614888103, 3248222580,
   3835390401, 4022224774, 264347078  , 604807628,
   770255983  , 1249150122, 1555081692, 1996064986,
   2554220882, 2821834349, 2952996808, 3210313671,
   3336571891, 3584528711, 113926993  , 338241895,
   666307205  , 773529912  , 1294757372, 1396182291,
   1695183700, 1986661051, 2177026350, 2456956037,
   2730485921, 2820302411, 3259730800, 3345764771,
   3516065817, 3600352804, 4094571909, 275423344,
   430227734  , 506948616  , 659060556  , 883997877,
   958139571  , 1322822218, 1537002063, 1747873779,
   1955562222, 2024104815, 2227730452, 2361852424,
   2428436474, 2756734187, 3204031479, 3329325298].

(*functions used for round function*)
Definition Ch (x y z : int) : int :=
  Int.xor (Int.and x y) (Int.and (Int.not x) z).

Definition Maj (x y z : int) : int :=
  Int.xor (Int.xor (Int.and x z) (Int.and y z) ) (Int.and x y).

Definition Rotr b x := Int.ror x (Int.repr b).
Definition Shr b x := Int.shru x (Int.repr b).

Definition Sigma_0 (x : int) : int :=
          Int.xor (Int.xor (Rotr 2 x) (Rotr 13 x)) (Rotr 22 x).
Definition Sigma_1 (x : int) : int :=
          Int.xor (Int.xor (Rotr 6 x) (Rotr 11 x)) (Rotr 25 x).
Definition sigma_0 (x : int) : int :=
          Int.xor (Int.xor (Rotr 7 x) (Rotr 18 x)) (Shr 3 x).
Definition sigma_1 (x : int) : int :=
          Int.xor (Int.xor (Rotr 17 x) (Rotr 19 x)) (Shr 10 x).

(* word function *)
Function W (M: Z -> int) (t: Z) {measure Z.to_nat t} : int :=
  if zlt t 16
  then M t
  else  (Int.add (Int.add (sigma_1 (W M (t-2))) (W M (t-7)))
               (Int.add (sigma_0 (W M (t-15))) (W M (t-16)))).
Proof.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
Qed.

(*registers that represent intermediate and final hash values*)
Definition registers := list int.

Fixpoint map2 {A B C: Type} (f: A -> B -> C) (al: list A) (bl: list B) : list C :=
 match al, bl with
  | a::al', b::bl' => f a b :: map2 f al' bl'
  | _, _ => nil
  end.

(*initializing the values of registers, first thirty-two bits of the fractional
    parts of the square roots of the first eight prime numbers*)
Definition init_registers : registers :=
  map Int.repr  [1779033703, 3144134277, 1013904242, 2773480762,
                        1359893119, 2600822924, 528734635, 1541459225].

Definition nthi (il: list int) (t: Z) := nth (Z.to_nat t) il Int.zero.

Definition rnd_function (x : registers) (k : int) (w : int) : registers:=
  match x with
  |  [a, b, c, d, e, f, g, h] =>
     let T1 := Int.add (Int.add (Int.add (Int.add h (Sigma_1 e)) (Ch e f g)) k) w in
     let T2 := Int.add (Sigma_0 a) (Maj a b c) in
       [Int.add T1 T2, a, b, c, Int.add d T1, e, f, g]
  | _ => nil  (* impossible *)
  end.

Function Round  (regs: registers) (M: Z ->int) (t: Z)
        {measure (fun t => Z.to_nat(t+1)) t} : registers :=
 if zlt t 0 then regs
 else rnd_function (Round regs M (t-1)) (nthi K256 t) (W M t).
Proof. intros; apply Z2Nat.inj_lt; omega.
Qed.

Definition hash_block (r: registers) (block: list int) : registers :=
      map2 Int.add r (Round r (nthi block) 63).

Function hash_blocks (r: registers) (msg: list int) {measure length msg} : registers :=
  match msg with
  | nil => r
  | _ => hash_blocks (hash_block r (firstn 16 msg)) (skipn 16 msg)
  end.
Proof. intros.
 destruct (lt_dec (length msg) 16).
 rewrite skipn_length_short. simpl; omega. rewrite <- teq; auto.
 rewrite skipn_length. simpl; omega. rewrite <- teq; omega.
Qed.

Fixpoint intlist_to_Zlist (l: list int) : list Z :=
 match l with
 | nil => nil
 | i::r =>
     Int.unsigned (Shr 24 i) ::
     Int.unsigned (Int.and (Shr 16 i) (Int.repr 255)) ::
     Int.unsigned (Int.and (Shr 8 i) (Int.repr 255)) ::
     Int.unsigned (Int.and i (Int.repr 255)) ::
     intlist_to_Zlist r
 end.

Definition SHA_256 (str : list Z) : list Z :=
    intlist_to_Zlist (hash_blocks init_registers (generate_and_pad str)).

(* ------------ *)
(* TODO remove *)
Definition generate_and_pad_c msg :=
  let n := Zlength msg in
   Zlist_to_intlist (msg ++ [128%Z]
                ++ list_repeat (Z.to_nat (-(n + 9) mod 64)) 0)
           ++ [Int.repr (n * 8 / Int.modulus), Int.repr (n * 8)].

(* ------------------------------------ LEMMAS *)

(* Lemma 1: M = Prefix(Pad(M)) *)
(* see end *)

Inductive Prefix {X : Type} : list X -> list X -> Prop :=
  | p_nil : forall (l : list X), Prefix [] l
  | p_self : forall (l : list X), Prefix l l
  | p_cons : forall (l1 l2 : list X) (x : X), Prefix l1 l2 -> Prefix (x :: l1) (x :: l2)
  | p_append : forall (l1 l2 : list X) (l3 : list X), Prefix l1 l2 -> Prefix l1 (l2 ++ l3)
  | p_trans : forall (l1 l2 l3 : list X), Prefix l1 l2 -> Prefix l2 l3 -> Prefix l1 l2.
                               (* might want to prove some of these -- too powerful *)

Inductive InWords : list Z -> Prop :=
  | words_nil : InWords []
  | words_word : forall (a b c d : Z) (msg : list Z),
                   InWords msg -> InWords (a :: b :: c :: d :: msg).

Lemma split_Zlist_to_intlist : forall (l1 : list Z) (l2 : list Z),
   InWords l1 -> Zlist_to_intlist (l1 ++ l2) = Zlist_to_intlist l1 ++ Zlist_to_intlist l2.
Proof.
  intros l1 l2 E.                 (* careful *)
  induction E.
  (* case none *)
    reflexivity.
  (* case cons 4 *)
    simpl.
    rewrite -> IHE.
    reflexivity.
Qed.

Check NPeano.divide.
Print NPeano.divide.
Check list_repeat.
Print list_repeat.

Lemma fstpad_len :
  forall (msg : list Z),
    Datatypes.length (msg ++ [128]
                 ++ list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0)
= (Datatypes.length msg + (S (Z.to_nat (- (Zlength msg + 9) mod 64))))%nat.
Proof.
  intros msg.
  simpl.
  SearchAbout length.
  rewrite -> app_length.
  simpl.
  SearchAbout list_repeat.
  rewrite -> length_list_repeat.
  reflexivity.
Qed.

(* Originally from Lemma 2: *)

Print NPeano.div.

Lemma total_pad_len_Zlist : forall (msg : list Z),
     length
       (msg ++ [128] ++ list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0)
     = (
         (NPeano.div (Z.to_nat (Zlength msg) + 8) 4%nat + 14%nat)
          * Z.to_nat WORD
     )%nat.
Proof.
  intros msg.
  repeat rewrite -> fstpad_len.
  replace (S (Z.to_nat (- (Zlength msg + 9) mod 64)))
    with (1 + (Z.to_nat (- (Zlength msg + 9) mod 64)))%nat by omega.

  (* simpl. *)

(* Similar to prev for lemma 1 *)

Admitted.

Print NPeano.divide.
SearchAbout NPeano.divide.

Lemma InWords_len4 : forall (l : list Z),
                       NPeano.divide (Z.to_nat WORD) (length l) -> InWords l.
Proof.
  intros l [x H].
  revert l H.
  induction x.
  intros l H. simpl in H.
  destruct l.
    apply words_nil.
    simpl in H. inversion H.
  intros l H.
  destruct l as [ | a [ | b [ | c [ | d ? ]]]].
    inversion H.
    inversion H.
    inversion H.
    inversion H.
    specialize (IHx l).
      apply words_word.
      apply IHx.
      simpl in H. inversion H.
      simpl. apply H1.
Qed.

Lemma pad_inwords :
  forall (msg : list Z),
    InWords (msg ++ [128]
                 ++ list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0).
Proof.
  intros msg.
  apply InWords_len4.
  pose proof total_pad_len_Zlist.
  specialize (H msg).
  unfold NPeano.divide.
  exists (16 * Z.to_nat (- (Zlength msg + 9) mod 64) - 2)%nat.
  apply H.
Qed.

Definition fulllen (len : Z) :=
  len + 1%Z + (- (len + 9) mod 64).

Eval compute in fulllen 0.      (* 56 / 4 = 14 32-bit ints;
                                   56 + 8 = 64 bytes;
                                   64 / 4 = 16 32-bit ints;
                                   16 * 32 = 512 bits; 512 / 256 = 2 blocks of length 256 *)
Eval compute in fulllen 1.      (* 56 / 4 = 14 *)
Eval compute in fulllen 2.      (* 56 / 4 = 14 *)
Eval compute in fulllen 55.      (* 56 / 4 = 14 *)
Eval compute in fulllen 56.      (* 120 / 4 = 30 *)
Eval compute in fulllen 119.     (* 120 *)
Eval compute in fulllen 120.    (* 184 *)
Eval compute in fulllen 121.
Eval compute in fulllen 200.    (* 248 + 8 = 256 *)

Eval compute in (-1) mod 5.
(* SearchAbout modulo. *)
(* SearchAbout mod. *)

(* Think about it -- what is the goal of this padding function? *)

(* - (n + 9) mod 64 = -n - 9 mod 64 = -n + 55 mod 64 = (64 - n) + 55 mod 64, where n >= 0
or it's (-n -8 -1) mod 64 = (64m - n - 1 - 8) mod 64
honestly it might be easier to add the +8 in...
*)

(* n + 1 + (- (n + 9)) + 64m, m minimum S.T. entire thing is a multiple of... something
n + 1 + (-n - 9) + 64m
-8 + 64m, such that -8 + 64m > 0? not right, but kind of makes sense
(multiple of 64 minus 8 for length)

 *)

(*
WTS: (n + 1 + (- (n + 9) mod 64)) = 0 (mod 4)
(we have no assumptions about n)

Why mod 64?

We want the entire length to be a multiple of 512 bits = 64 bytes (64 Zs)
k bytes 0, k such that the length is 448 bits = 56 bytes (56 Zs) **mod 64 (bytes)**

This is SHA-256. msg of length 1 byte (1 Z) -> pad1 to 56 byte
-> add length, pad2 to 64 byte
-> divide by 4 (4 byte per 32-bit int) = 16 32-bit integers
 *)

Definition pad (msg : list Z) : list Z :=
  let n := Zlength msg in
  msg ++ [128%Z]
      ++ list_repeat (Z.to_nat (-(n + 9) mod 64)) 0
      ++ intlist_to_Zlist ([Int.repr (n * 8 / Int.modulus), Int.repr (n * 8)]).

Definition generate_and_pad' (msg : list Z) : list int :=
  Zlist_to_intlist (pad msg).

(* C-c C-l *)
SearchAbout Zlist_to_intlist.

Lemma app_left : forall (a b c d : list Z),
   a ++ b ++ c ++ d = (a ++ b ++ c) ++ d.
(* a ++ (b ++ (c ++ d)) = (a ++ (b ++ c)) ++ d *)
Proof.
   intros a b c d.
   (* forall (A : Type) (l m n : list A), l ++ m ++ n = (l ++ m) ++ n *)
   assert (b ++ (c ++ d) = (b ++ c) ++ d) as assert1.
     rewrite -> app_assoc. reflexivity.
   rewrite -> assert1.
   rewrite -> app_assoc.
   reflexivity.
Qed.

Theorem pad_compose_equal : forall (msg : list Z),
                              generate_and_pad' msg = generate_and_pad msg.
Proof.
  intros msg.
  unfold generate_and_pad'.
  unfold pad.
  unfold generate_and_pad.
  (* need il => ZIL (IZL il), and
     ZIL a ++ Zil b = ZIL (a ++ b) (with length a being a multiple of 4)
   *)
  pose proof pad_inwords as pad_inwords.
  specialize (pad_inwords msg).
  rewrite -> app_left.
  induction pad_inwords.
  (* case none *)
    assert (forall l : list Z, [] ++ l = l) as Happend. reflexivity.
    specialize (Happend (intlist_to_Zlist
        [Int.repr (Zlength msg * 8 / Int.modulus),
        Int.repr (Zlength msg * 8)])).
    rewrite -> Happend.
    rewrite -> intlist_to_Zlist_to_intlist.
    reflexivity.
  (* case a :: b :: c :: d :: msg0 *)
    Opaque intlist_to_Zlist.
    simpl.
    apply f_equal.
    apply IHpad_inwords.
Qed.

(* Proof easy with pad definition *)
Theorem prefix : forall (msg : list Z),
                   Prefix msg (pad msg).
Proof.
  intros msg.
  unfold pad.
  apply p_append.
  apply p_self.
Qed.

(* ------------------------------------------------ *)

(* Lemma 2: |M1| = |M2| -> |Pad(M1)| = |Pad(M2)| *)

(* TODO: this lemma is not used *)
Lemma zlength_intlist_zlist' :
  forall (msg1 : list Z) (msg2 : list Z) (pad : list Z),
    Zlength msg1 = Zlength msg2 ->
    Zlength (Zlist_to_intlist (msg1 ++ pad)) =
    Zlength (Zlist_to_intlist (msg2 ++ pad)).
Proof.
  intros msg1 msg2 pad Hlen.

Admitted.

Print NPeano.divide.
Print NPeano.div.
Check NPeano.div.

(* Alternatively, could use my equivalent gap function,
or the proof about first part *)
(* see length_Zlist_to_intlist in pure_lemmas *)

(* Lemma fstpad_len :
  forall (msg : list Z),
    Datatypes.length (msg ++ [128]
                 ++ list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0)
= (Datatypes.length msg + (S (Z.to_nat (- (Zlength msg + 9) mod 64))))%nat. *)

Lemma total_pad_len_intlist : forall (msg : list Z),
      length (generate_and_pad msg) = 7%nat. (* n + 2 *)
(* TODO *)
(* Something as a function of Zlength msg? or something independent
(0 mod 512)?  *)
Proof.
  intros msg.
  unfold generate_and_pad.
  rewrite -> app_length.
  simpl.
  assert (Datatypes.length
      (Zlist_to_intlist
         (msg ++
          128%Z :: list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0%Z))
      = 5%nat) as assert_fstlen.
    apply length_Zlist_to_intlist.
    apply total_pad_len_Zlist.
  rewrite -> assert_fstlen.
  reflexivity.
Qed.

(* length (
(Zlist_to_intlist
        (msg ++
         [128] ++ list_repeat (Z.to_nat (- (Zlength msg + 9) mod 64)) 0) ) *)

Theorem length_equal_pad_length : forall (msg1 : list Z) (msg2 : list Z),
     Zlength msg1  = Zlength msg2 ->
     Zlength (generate_and_pad msg1) = Zlength (generate_and_pad msg2).
Proof.
  intros m1 m2 H.
  SearchAbout Zlength.
  repeat rewrite -> Zlength_correct.
  repeat rewrite -> total_pad_len_intlist.
  reflexivity.
Qed.


Require Import list_examples.

Definition sum_code :=
  Dup 0::If (Dup 0::Load::Swap::Plus1++Load
           ::Call "sum"::Binop Zplus::nil) nil
  ::Ret::nil.

Definition sum := fold_right Zplus 0.
Inductive sum_spec : Spec cfg :=
  sum_claim : forall H l, fun_claim sum_spec
  "sum" sum_code
    1 (fun p => asP H (rep_list l p))
    1 (fun n => constraint (n = sum l) :* litP H).

Lemma sum_proof : sound stack_step sum_spec.
Proof. list_solver. Qed.


From Coq Require Import PArith.
Require Import ExtLib.Data.Map.FMapPositive.
Require Import ExtLib.Data.Eq.
Require Import ExtLib.Tactics.Injection.
From Coq Require Import PArith.

Fixpoint pmap_lookup' (ts : pmap Type) (p : positive) : option Type :=
  match p with
    | xH => pmap_here ts
    | xI p => pmap_lookup' (pmap_right ts) p
    | xO p => pmap_lookup' (pmap_left ts) p
  end.

Record OneOf (ts : pmap Type) : Type := mkOneOf
{ index : positive
; value : match pmap_lookup' ts index with
            | None => Empty_set
            | Some T => T
          end
}.

Definition Into {ts} {T : Type} (n : positive) (pf : pmap_lookup' ts n = Some T)
: T -> OneOf ts :=
  match pf in _ = X return match X with
                           | Some T => T
                           | None => Empty_set
                           end -> OneOf ts
  with
  | eq_refl => @mkOneOf ts n
  end.

Fixpoint asNth' {ts : pmap Type} (p p' : positive)
: match pmap_lookup' ts p' with
    | None => Empty_set
    | Some T => T
  end -> option (match pmap_lookup' ts p with
                   | None => Empty_set
                   | Some T => T
                 end) :=
  match p as p , p' as p'
        return match pmap_lookup' ts p' with
                 | None => Empty_set
                 | Some T => T
               end -> option (match pmap_lookup' ts p with
                                | None => Empty_set
                                | Some T => T
                              end)
  with
    | xH , xH => Some
    | xI p , xI p' => asNth' p p'
    | xO p , xO p' => asNth' p p'
    | _ , _ => fun _ => None
  end.

Definition asNth {ts : pmap Type} (p : positive) (oe : OneOf ts)
: option (match pmap_lookup' ts p with
            | None => Empty_set
            | Some T => T
          end) :=
  @asNth' ts p oe.(index ts) oe.(value ts).

Definition OutOf {ts} {T : Type} (n : positive)
           (pf : pmap_lookup' ts n = Some T)
: OneOf ts -> option T :=
  match pf in _ = X return OneOf ts -> option match X with
                                              | None => Empty_set:Type
                                              | Some T => T
                                              end
  with
  | eq_refl => @asNth ts n
  end.

Lemma asNth'_get_lookup : forall p ts v, asNth' (ts:=ts) p p v = Some v.
Proof.
  induction p; simpl; intros; auto.
Qed.

Theorem Outof_Into : forall ts T p pf v,
    @OutOf ts T p pf (@Into ts T p pf v) = Some v.
Proof using.
  unfold OutOf, Into.
  intros.
  repeat rewrite (eq_Arr_eq pf).
  repeat rewrite (eq_Const_eq pf).
  repeat rewrite (eq_Const_eq (eq_sym pf)).
  unfold asNth. simpl.
  rewrite asNth'_get_lookup.
  { generalize dependent (pmap_lookup' ts p).
    intros. subst. reflexivity. }
Qed.

Theorem asNth_eq
: forall ts p oe v,
    @asNth ts p oe = Some v ->
    oe = {| index := p ; value := v |}.
Proof.
  unfold asNth.
  destruct oe; simpl.
  revert value0. revert index0. revert ts.
  induction p; destruct index0; simpl; intros;
  solve [ congruence | eapply IHp in H; inversion H; clear H IHp; subst; auto ].
Qed.

Section elim.
  Context {T : Type}.
  Variable F : T -> Type.

  Fixpoint pmap_elim (R : Type) (ts : pmap T) : Type :=
    match ts with
      | Empty => R
      | Branch None l r => pmap_elim (pmap_elim R r) l
      | Branch (Some x) l r => F x -> pmap_elim (pmap_elim R r) l
    end.
End elim.

Fixpoint pmap_lookup'_Empty (p : positive) : pmap_lookup' Empty p = None :=
  match p with
    | xH => eq_refl
    | xO p => pmap_lookup'_Empty p
    | xI p => pmap_lookup'_Empty p
  end.

Definition OneOf_Empty (f : OneOf Empty) : False.
Proof.
  destruct f. rewrite pmap_lookup'_Empty in *.
  intuition congruence.
Defined.

Lemma pmap_lookup'_eq p m : pmap_lookup p m = pmap_lookup' m p.
Proof.
  generalize dependent m. induction p; intuition.
  simpl. destruct m. simpl. rewrite pmap_lookup'_Empty. reflexivity.
  simpl in *. apply IHp.
  simpl in *. destruct m. simpl. rewrite pmap_lookup'_Empty. reflexivity.
  simpl. apply IHp.
Defined.

Global Instance Injective_OneOf m i1 i2 v1 v2
: Injective (@eq (OneOf m)
                 {| index := i1 ; value := v1 |}
                 {| index := i2 ; value := v2 |}) :=
{ result := exists pf : i2 = i1,
    v1 = match pf in _ = T return match pmap_lookup' m T with
                                  | None => Empty_set
                                  | Some T => T
                                  end with
         | eq_refl => v2
         end
; injection :=
    fun H =>
      match H in _ = h
            return exists pf : index _ h = i1 ,
          v1 = match
            pf in (_ = T)
            return
            match pmap_lookup' m T with
            | Some T0 => T0
            | None => Empty_set
            end
          with
          | eq_refl => value _ h
          end
      with
      | eq_refl => @ex_intro _ _ eq_refl eq_refl
      end
}.