(* LINEAR-TIME FUNCTIONAL VERSION OF SHA256 *)
Function zeros (n : Z) {measure Z.to_nat n} : list Int.int :=
 if Z.gtb n 0 then Int.zero :: zeros (n-1) else nil.Definition padlen (n: Z) : list Int.int :=
    let p := n/4+3 (* number of words with trailing 128-byte,
                                                      up to 3 zero bytes, and 2 length words *)
    in let q := (p+15)/16*16 - p   (* number of zero-pad words *)
      in zeros q ++ [Int.repr (n * 8 / Int.modulus); Int.repr (n * 8)].Fixpoint generate_and_pad' (n: list byte) len : list Int.int :=
  match n with
  | nil => bytes_to_Int (Byte.repr 128) Byte.zero Byte.zero Byte.zero :: padlen len
  | [h1]=> bytes_to_Int h1 (Byte.repr 128) Byte.zero Byte.zero :: padlen (len+1)
  | [h1; h2] => bytes_to_Int h1 h2 (Byte.repr 128) Byte.zero :: padlen (len+2)
  | [h1; h2; h3] => bytes_to_Int h1 h2 h3 (Byte.repr 128) :: padlen (len+3)
  | h1::h2::h3::h4::t => bytes_to_Int h1 h2 h3 h4 :: generate_and_pad' t (len+4)
  end.Definition generate_and_pad_alt (n: list byte) : list Int.int :=
   generate_and_pad' n 0.Definition Wnext (msg : list int) : int :=
 match msg with
 | x1::x2::x3::x4::x5::x6::x7::x8::x9::x10::x11::x12::x13::x14::x15::x16::_ =>
   (Int.add (Int.add (sigma_1 x2) x7) (Int.add (sigma_0 x15) x16))
 | _ => Int.zero  (* impossible *)
 end.(*generating 64 words for the given message block imput*)
Fixpoint generate_word (msg : list int) (n : nat) {struct n}: list int :=
  match n with
  |O   => msg
  |S n' => generate_word (Wnext msg :: msg) n'
  end.(* for some reason the Arguments...simpl-never
   command does not do the job *)

(*execute round function for 64 rounds*)
Fixpoint rnd_64 (x: registers) (k w : list int) : registers :=
  match k, w with
  | k1::k', w1::w' => rnd_64 (rnd_function x k1 w1) k' w'
  | _ , _ => x
  end.(* blows up otherwise *)

Definition process_block (r: registers) (block: list int) : registers :=
       (map2 Int.add r (rnd_64 r K256 (rev(generate_word block 48)))).Fixpoint grab_and_process_block (n: nat) (r: registers) (firstrev msg: list int) : registers * list int :=
 match n, msg with
  | O, _ => (process_block r firstrev, msg)
  | S n', m1::msg' => grab_and_process_block n' r (m1::firstrev) msg'
  | _, nil => (r,nil) (* impossible *)
 end.(*iterate through all the message blocks; this could have been done with just a Fixpoint
  if we incorporated grab_and_process_block into process_msg, but I wanted to
  modularize a bit more. *)
Function process_msg  (r: registers) (msg : list int) {measure length msg}  : registers :=
 match msg with
 | nil => r
 | _ => let (r', msg') := grab_and_process_block 16 r nil msg
             in process_msg r' msg'
 end.Definition SHA_256' (str : list byte) : list byte :=
    intlist_to_bytelist (process_msg init_registers (generate_and_pad_alt str)).(*EXAMPLES*)

Fixpoint bytelist_eq (al bl: list byte) : bool :=
 match al, bl with
 | nil, nil => true
 | a::al', b::bl' => Byte.eq a b && bytelist_eq al' bl'
 | _, _ => false
  end.Definition hexdigit(a: Z) : Z :=
 if Z.leb 48 a && Z.ltb a 58 then Z.sub a 48
 else if Z.leb 65 a && Z.ltb a 71 then Z.sub a 55
 else if Z.leb 97 a && Z.ltb a 103 then Z.sub a 87
 else 0%Z.Fixpoint hexstring_to_bytelist (s: String.string): list byte  :=
 match s with
 | String.String a (String.String b r) => Byte.repr ((hexdigit (Z.of_N (Ascii.N_of_ascii a)) * 16
                                         + hexdigit (Z.of_N (Ascii.N_of_ascii b))))
                                          :: hexstring_to_bytelist r
 | _ => nil
 end.Definition check m h :=
  bytelist_eq (SHA_256' (str_to_bytes m)) (hexstring_to_bytelist h) = true.(*This input message is 344 bits long, which would have one message block after padding*)
Goal  check   "The quick brown fox jumps over the lazy dog"
  "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592".(*This input message would have four message blocks after padding*)
Goal check "The Secure Hash Algorithm is a family of cryptographic hash functions published by the National Institute of Standards and Technology (NIST) as a U.S. Federal Information Processing Standard (FIPS)"
 "27c3971526f07a22decc4dc01340c6c4b972ba6d31b74fb1fbb2edf2bce5fea6".

(* Specifications: *)
Lemma length_rnd_64: forall r k w, length r = 8 -> length (rnd_64 r k w) = 8.
Lemma length_rnd_64_inv: forall r k w, length (rnd_64 r k w) = 8 -> length r = 8.
Lemma length_process_block: forall r b, length r = 8 -> length (process_block r b) = 8.
Lemma length_map2_add_rnd_64: forall regs w, length regs = 8 -> length (map2 Int.add regs (rnd_64 regs K256 w)) = 8.
Lemma grab_and_process_block_length: forall n r firstr msg r' m', length r = 8 -> length msg >= n -> grab_and_process_block n r firstr msg = (r',m') -> length r' = 8.
Lemma length_process_msg: forall b, length (process_msg init_registers b) = 8.
Lemma process_msg_eq2: forall regs hashed b, length b = 16 -> process_msg regs (b++hashed) = process_msg (process_block regs (rev b)) hashed.
Lemma rnd_64_S: forall regs i b k w, nth_error K256 i = Some k -> nth_error b i = Some w -> rnd_64 regs K256 (firstn (S i) b) = rnd_function (rnd_64 regs K256 (firstn i b)) k w.
Lemma Zlength_zeros: forall n, (n>=0)%Z -> Zlength (zeros n) = n.
Lemma length_zeros: forall n:Z, length (zeros n) = Z.to_nat n.
Lemma Zlength_padlen: forall n, n>=0 -> Zlength (padlen n) = roundup (n/4+3) 16 - n/4 - 1.
Lemma zeros_app: forall n m, (n >= 0 -> m >=0 -> zeros n ++ zeros m = zeros (n+m))%Z.
Lemma zeros_Zsucc: forall n, n >= 0 -> zeros (Z.succ n) = Int.repr 0 :: zeros n.
Lemma intlist_to_bytelist_zeros: forall n:Z, intlist_to_bytelist (zeros n) = map Byte.repr (map Int.unsigned (zeros (4*n)%Z)).